lsystem.hs

data LSystem a b =
  LSystem
    [a]
    (a -> [b])

type LSystem' a =
  LSystem a a

instance Functor (LSystem a) where
  fmap k (LSystem a f) =
    LSystem a (fmap (fmap k) f)

bind ::
  LSystem a b
  -> [b]
bind (LSystem a f) =
  a >>= f

apply ::
  LSystem' a
  -> LSystem' a
apply (LSystem a f) =
  LSystem (a >>= f) f

answer ::
  LSystem a b
  -> [[b]]
answer (LSystem a f) =
  map f a

constant ::
  [a]
  -> [b]
  -> LSystem a b
constant a =
  LSystem a . const

empty ::
  LSystem a b
empty =
  constant [] []

axiom ::
  Functor f =>
  ([a] -> f [a])
  -> LSystem a b
  -> f (LSystem a b)
axiom k (LSystem a f) =
  fmap (\a' -> LSystem a' f) (k a)

axioms ::
  Applicative f =>
  (a -> f a)
  -> LSystem a b
  -> f (LSystem a b)
axioms =
  axiom . traverse

rule ::
  Functor f =>
  ((a -> [b]) -> f (a -> [b]))
  -> LSystem a b
  -> f (LSystem a b)
rule k (LSystem a f) =
  fmap (\f' -> LSystem a f') (k f)