Crosswalk

Main.purs

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