joneshf · August 6, 2018 14:37 · Aug 6, 2018
diff --git a/Main.purs b/Main.purs
@@ -0,0 +1,64 @@
+module Main where
+
+import Prelude
+
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Data.Foldable (class Foldable)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.List (List(Nil, Cons), range)
+import Data.Map (Map, empty, singleton, unionWith)
+import TryPureScript (DOM, render, withConsole)
+
+main :: Eff (console :: CONSOLE, dom :: DOM) Unit
+main = render =<< withConsole do
+  logShow (crosswalk parity (range 1 10))
+
+parity :: Int -> Map Parity Int
+parity x
+  | x `mod` 2 == 0 = singleton Even x
+  | otherwise = singleton Odd x
+
+data Parity
+  = Even
+  | Odd
+
+derive instance eqParity :: Eq Parity
+derive instance genericParity :: Generic Parity _
+derive instance ordParity :: Ord Parity
+
+instance showParity :: Show Parity where
+  show = genericShow
+
+data These a b
+  = This a
+  | That b
+  | These a b
+
+class (Functor f) <= Align f where
+  align :: forall a b. f a -> f b -> f (These a b)
+  nil :: forall a. f a
+
+instance alignMap :: (Ord k) => Align (Map k) where
+  align x y = unionWith go (map This x) (map That y)
+    where
+    go :: forall a b. These a b -> These a b -> These a b
+    go = case _, _ of
+      This a, That b -> These a b
+      x, _ -> x
+  nil = empty
+
+class (Functor f, Foldable f) <= Crosswalk f where
+  crosswalk :: forall a b t. Align t => (a -> t b) -> f a -> t (f b)
+
+instance crossWalkList :: Crosswalk List where
+  crosswalk f = case _ of
+    Nil -> nil
+    Cons x xs -> map go (align (f x) (crosswalk f xs))
+      where
+      go :: forall a. These a (List a) -> List a
+      go = case _ of
+        This x -> pure x
+        That xs -> xs
+        These x xs -> Cons x xs
No results found