{-# OPTIONS_GHC -fglasgow-exts #-}
module LSystem where

import qualified Data.Map as M
import Control.Monad.Writer
import MonadRandom

type Alphabet    = String
type Axiom       = String
type Productions m = M.Map Char (m String)

type LSystem m = (m Axiom, Productions m)

result :: (Monad m) =>
     Int       -- ^ iterations
  -> LSystem m -- ^ Context-free Lindenmayer System
  -> m String  -- ^ result
result 0 (axioms,_) = axioms
result n (axioms,productions) = result (n-1) (axioms >>= expand productions, productions)

expand :: (Monad m) => Productions m -> String -> m String
expand productions axiom = liftM join $ mapM apply axiom
    where apply c = M.findWithDefault (return [c]) c productions

{-
instance Monoid Rational where
    mempty = 1
    mappend = (*)

newtype WL a = WL { unWL :: (WriterT Rational [] a) } deriving (Functor, Monad, MonadPlus, MonadWriter Rational)
runWL = runWriterT . unWL
-}

test1 :: Maybe String
test1 = result 7 (return "F", M.fromList [('F', Just "F+F-")])

test2 :: [String]
test2 = result 7 (return "F", M.fromList [('F', ["", "F+F", "F-F"])])

{-
test3 = result 3 (return "F", M.fromList [('F', WL $ WriterT [("",1/5), ("F+F",2/5), ("F-F",2/5)])])
-}
-- test3 :: Rand String
test3 = result 3 (return "F", M.fromList [('F', fromList [("",1/5), ("F+F",2/5), ("F-F",2/5)])])