module Exercise10 where

import Data.List (find, isPrefixOf, nub)
import Data.Maybe (fromMaybe)
import Data.Map as Map (lookup)
import System.IO
import Test.QuickCheck (quickCheck, Property)

import Turtle

-- data type for L-System
data Rule = Char :->: String                -- context-free and deterministic! 
  deriving (Eq,Show)

data LSystem = LSystem {
                  start :: String, 
                  rules :: [Rule]           -- constraint: unique left sides
                  }
  deriving Eq

instance Show LSystem where
  show (LSystem s r) = unlines $ ["Start: " ++ show s, "Rules: "] ++ map show r


apply :: Char -> Turtle -> Turtle
apply 'F' t = move 10 t
apply 'G' t = move 10 t
apply '+' t = turn 90 t
apply '-' t = turn (-90) t
apply '*' t = turn 15 t
apply '~' t = turn (-15) t
apply _ t = sit t

peano :: LSystem 
peano = LSystem "L" ['L' :->: "LFRFL-F-RFLFR+F+LFRFL", 'R' :->: "RFLFR+F+LFRFL-F-RFLFR"]

peano2 :: LSystem
peano2 = LSystem "F" ['F' :->: "F+F-F-F-F+F+F+F-F"]

peano3 :: LSystem
peano3 = LSystem "X" ['X' :->: "XFYFX+F+YFXFY-F-XFYFX", 'Y' :->: "YFXFY-F-XFYFX+F+YFXFY"]

hilbert :: LSystem
hilbert = LSystem "A" ['A' :->: "+BF−AFA−FB+", 'B' :->: "−AF+BFB+FA−"]

-- Use apply to convert movements of turtle to GL lines.
-- Try changing the color to red! 
execute :: LSystem -> Integer -> [Ln]
execute ls n = let (pen, ang, pnt, ln, bps) = lines (black, 0, 0, [],[]) $ expandLSystem ls n in ln
  where
    lines t [] = t 
    lines t (x:xs) = lines (apply x t) xs

-- sample LSystems for (manual) testing
dragoncurve :: LSystem
dragoncurve = LSystem "FX" ['X' :->: "X+++YF+++", 'Y' :->: "---FX---Y"]

kochcurve :: LSystem
kochcurve = LSystem "F" ['F' :->: "F+++F---F---F+++F"]

sierpinski :: LSystem
sierpinski = LSystem "F++++G++++G" ['F' :->: "F++++G----F----G++++F", 'G' :->: "GG"]

baum :: LSystem
baum = LSystem "X" ['X' :->: "F+X-X-F-FX+X", 'F' :->: "FF"]

-- finds the first occurrence of a fitting rule
findRule :: [Rule] -> Char -> Rule 
findRule [] c = c :->: [c]
findRule (r@(cr :->: s):rs) c
  | cr == c = r
  | otherwise = findRule rs c

-- expands the L-System n times
expandLSystem :: LSystem -> Integer -> String
expandLSystem ls 0 = start ls
expandLSystem ls x = expandLSystem ls {start = concatMap helper (start ls)} (x-1)
  where rls = rules ls 
        helper c = let (c' :->: s) = findRule rls c in s

-- updating LSystem via command
update :: LSystem -> IO LSystem
update ls = do ready <- hWaitForInput stdin 1000--idk?
               if not ready then return ls else go
  where go = do input <- getLine 
                let parsed = parseInput input in
                  case parsed of
                  S s -> update ls{start=s}
                  R r -> update ls{rules= nub $ r : map (updateRule r) (rules ls)}
                  Clear -> update ls{start = "", rules=[]}
                  Print -> do putStr $ show ls
                              update ls
                  RuleError -> do putStr "Error parsing rule\n"
                                  update ls
                  Error -> do putStr "Error parsing command\n"
                              update ls

updateRule :: Rule -> Rule -> Rule
updateRule new@(nc :->: _) r@(c :->: _) 
  | nc /= c = r
  | otherwise = new

parseInput :: String -> Command
parseInput ('s':'t':'a':'r':'t':_:s) = S s
parseInput ('r':'u':'l':'e':_:c:s)
    | not (" -> " `isPrefixOf` s) || not (any (/= ' ') ruleRightSide)  = RuleError
    | otherwise = R (c :->: ruleRightSide) --create rule with c and s without " -> "
      where ruleRightSide = drop 4 s
parseInput s 
    | s == "clear" = Clear
    | s == "print" = Print
    | otherwise = Error

{-
--without space, hlint suggests (wrong) change
f1 :: String -> String
f1 s
  | (not $isPrefixOf "test" s) || not (any (/= ' ') (drop 4 s)) = "branch 1"
  | otherwise = "branch 2"

--with space, should do the same as f1, but hlint suggests different change
f2 :: String -> String
f2 s
  | (not $ isPrefixOf "test" s) || not (any (/= ' ') (drop 4 s)) = "branch 1"
  | otherwise = "branch 2"

--hlints suggestion applied to f1 => performs different than f1
f1fix :: String -> String
f1fix s
  | not $isPrefixOf "test" s || not (any (/= ' ') (drop 4 s)) = "branch 1"
  | otherwise = "branch 2"
-}

data Command = S String | R Rule | Clear | Print | RuleError | Error deriving (Eq, Show)
-- add the WETT ... TTEW tags if you want to participate in the wettbewerb!
{-WETT-}
--see Snake.hs main
{-TTEW-}