Huge refactor for the Haskell code.HEADmain

This adds new layout configuration, preparing for actually using the
layouts. This also restructures the code and tries to keep code
interfacing with the foreign structures together and rename them to more
sensible names.

1 files changed, 45 insertions, 0 deletions

diff --git a/src/Wetterhorn/Layout/Combine.hs b/src/Wetterhorn/Layout/Combine.hs
new file mode 100644
index 0000000..983ceb1
--- /dev/null
+++ b/src/Wetterhorn/Layout/Combine.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Wetterhorn.Layout.Combine where
+
+import Data.Typeable
+import Wetterhorn.Constraints
+import Wetterhorn.Core.W
+
+data (|||) a b = Comb LR a b
+  deriving (Typeable, Read, Show)
+
+data Next = Next
+  deriving (Typeable)
+
+data Reset = Reset
+  deriving (Typeable)
+
+(|||) :: a -> b -> (a ||| b)
+a ||| b = Comb L a b
+
+data LR = L | R deriving (Read, Show, Ord, Eq, Enum)
+
+instance (LayoutClass a, LayoutClass b) => LayoutClass (a ||| b) where
+  type C (a ||| b) = C a &&&& C b
+
+  runLayout as (Comb R r l) = do
+    (r', ret) <- runLayout as r
+    return (Comb R r' l, ret)
+  runLayout as (Comb L r l) = do
+    (l', ret) <- runLayout as l
+    return (Comb R r l', ret)
+
+  handleMessage (fromMessage -> Just Next) (Comb L l r) = return (Comb R l r)
+  handleMessage (fromMessage -> Just Reset) (Comb _ l r) = return (Comb L l r)
+  handleMessage mesg (Comb L l r) =
+    Comb L <$> handleMessage mesg l <*> pure r
+  handleMessage mesg (Comb R l r) =
+    Comb L l <$> handleMessage mesg r
+
+  serializeLayout (Comb lr l r) = show (Comb lr (serializeLayout l) (serializeLayout r))
+  readLayout str = Comb lr <$> l <*> r
+    where
+      (Comb lr (readLayout -> l) (readLayout -> r)) = read str
+
+  description (Comb _ l r) = description l ++ " ||| " ++ description r