Ch15.purs

module Ch15 where

import Prelude
import Data.Int       (even, odd)
import Data.Foldable  (class Foldable, foldl)
import Data.List      (List(..), (:))
import Data.String    (length)
import Effect         (Effect)
import Effect.Console (log)

----------- Type Classes --------------------------------------------------------------------------------

class Contravariant f where
  cmap :: ∀ a b. (b -> a) -> f a -> f b

infixl 4 cmap as >$<

class Profunctor p where
  dimap :: ∀ a b c d. (b -> a) -> (c -> d) -> p a c -> p b d

------------ Predicate ----------------------------------------------------------------------------------

-- What is the polarity of the polymorphic parameter a ?
-- What kind of functor do we need ?
data Predicate a = Predicate (a -> Boolean)

runPredicate :: ∀ a. Predicate a -> a -> Boolean
runPredicate (Predicate f) a = f a

instance contravariantPredicate :: Contravariant Predicate where
  cmap f (Predicate g) = Predicate $ g <<< f

------------ Moore Machine ------------------------------------------------------------------------------

-- What are the polarities of the polymorphic parameters a and b ?
-- What kind of functor do we need ?
data Moore s a b = Moore s (s -> b) (s -> a -> s)

data OvenState   = Off         | Bake       | Idling
data Heat        = HeatOn      | HeatOff
data InputSignal = BakePressed | OffPressed | TooHot | TooCold

outputFn :: OvenState -> Heat
outputFn Off    = HeatOff
outputFn Bake   = HeatOn
outputFn Idling = HeatOff

transitionFn :: OvenState -> InputSignal -> OvenState
transitionFn Off    BakePressed = Bake
transitionFn Bake   OffPressed  = Off
transitionFn Bake   TooHot      = Idling
transitionFn Idling TooCold     = Bake
transitionFn Idling OffPressed  = Off
transitionFn s      _           = s

instance profunctorMoore :: Profunctor (Moore s) where
  -- dimap :: (b -> a) -> (c -> d) -> p a c -> p b d
  -- dimap :: (b -> a) -> (c -> d) -> Moore s a c                    -> Moore s b d
  -- pseudo = f            g          Moore s (s -> c) (s -> a -> s) -> Moore s (s -> d) (s -> b -> s)
  --          f            g                  h        k
  dimap f g (Moore s0 h k) = Moore s0 (g <<< h) (\s -> (k s) <<< f)

addr :: ∀ a. Semiring a => Moore a a a
addr = Moore zero identity (+)

runFoldL :: ∀ s a b f. Foldable f => Moore s a b -> f a -> b
runFoldL (Moore s0 output transition) = output <<< foldl transition s0

sizer :: Moore Int String String
sizer = dimap length (\n -> "Size is " <> show n) addr

----------- Tests ---------------------------------------------------------------------------------------
test :: Effect Unit
test = do
  log $ show $ runPredicate   (Predicate even) $ 10               -- true
  log $ show $ runPredicate   (Predicate even) $ 11               -- false
  log $ show $ runPredicate   (Predicate odd)  $ 10               -- false
  log $ show $ runPredicate   (Predicate odd)  $ 11               -- true
  log $ show $ runPredicate   (cmap (_ + 1) (Predicate odd)) 10   -- true
  log $ show $ runPredicate   (cmap (_ + 2) (Predicate odd)) 10   -- false
  log $ show $ runPredicate   ((_ + 1) >$<  (Predicate odd)) 10   -- true
  log $ show $ runPredicate   ((_ + 2) >$<  (Predicate odd)) 10   -- false
  log $ show $ runFoldL addr  [1, 2, 3]                           -- 6
  log $ show $ runFoldL addr  (1.0 : 2.0 : 3.0 : Nil)             -- 6.0
  log $ show $ runFoldL sizer [ "This", "is", "the", "test" ]     -- "Size is 13"

spago.dhall

{ name = "my-project"
, dependencies = [ "console", "effect", "foldable-traversable", "integers", "lists", "prelude", "strings", "psci-support" ]
, packages = ./packages.dhall
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
}