module Exercise_9_Sol where

{- Library DO NOT CHANGE -}

infixl 6 :+:
infixl 7 :*:

data Arith = Literal Integer
           | Var String
           | Arith :+: Arith
           | Arith :*: Arith
  deriving (Show, Eq)

{- End Library -}

{-G9.1-}

-- siehe Form_9_Sol.hs

{-G9.2-}

data Html = Elem String [Html] | Text String

startTag name = "<" ++ name ++ ">"
endTag name = "</" ++ name ++ ">"

htmlShow :: Html -> String
htmlShow (Text s) = s
htmlShow (Elem name es) = startTag name ++ concatMap htmlShow es ++ endTag name


escape :: String -> String
escape = concatMap f
  where
    f x | x == '<' = "&lt;"
        | x == '>' = "&gt;"
        | x == '&' = "&amp;"
        | otherwise = [x]

htmlShow' :: Html -> String
htmlShow' (Text s) = escape s
htmlShow' (Elem name es) = startTag name ++ concatMap htmlShow' es ++ endTag name
  where
    start = "<" ++ name ++ ">"
    end = "</" ++ name ++ ">"


{-H9.2-}

eval :: (String -> Integer) -> Arith -> Integer
eval valuation = go
  where go (Literal n) = n
        go (Var s) = valuation s
        go (a :+: b) = go a + go b
        go (a :*: b) = go a * go b

equivalent :: (String -> Integer) -> Arith -> Arith -> Bool
equivalent valuation a b = eval valuation a == eval valuation b

isSimple :: Arith -> Bool
isSimple (Literal _ :+: Literal _) = False
isSimple (Literal _ :*: Literal _) = False
isSimple (Literal 0 :+: _) = False
isSimple (_ :+: Literal 0) = False
isSimple (Literal 1 :*: _) = False
isSimple (_ :*: Literal 1) = False
isSimple (Literal 0 :*: _) = False
isSimple (_ :*: Literal 0) = False
isSimple (a :+: b) = isSimple a && isSimple b
isSimple (a :*: b) = isSimple a && isSimple b
isSimple (Literal n) = True
isSimple (Var x) = True

prop_isSimplification :: (Arith -> Arith) -> (String -> Integer) -> Arith -> Bool
prop_isSimplification simplify valuation a =
  equivalent valuation a a' &&
  isSimple a'
  where a' = simplify a


{-H9.3-}

-- smartAdd und smartMul sind "smart constructors" -- sie erzeugen einen
-- arithmetischen Ausdruck äquivalent zu :+: bzw. :*:, vereinfachen aber,
-- wenn möglich.
smartAdd :: Arith -> Arith -> Arith
smartAdd (Literal x) (Literal y) = Literal (x + y)  -- constant folding
smartAdd (Literal 0) b = b                          -- Addition ist Monoid
smartAdd a (Literal 0) = a
smartAdd a b = a :+: b

smartMul :: Arith -> Arith -> Arith
smartMul (Literal x) (Literal y) = Literal (x * y)  -- constant folding
smartMul (Literal 1) b = b                          -- Multiplikation ist Monoid
smartMul a (Literal 1) = a
smartMul (Literal 0) b = Literal 0                  -- Multiplikation mit 0
smartMul a (Literal 0) = Literal 0
smartMul a b = a :*: b

-- Für die "smart constructors" gilt: Wenn die beiden Argumente schon
-- vereinfacht sind, ist es auch das Ergebnis. Also erzeugt simplify
-- vollständig vereinfachte Ausdrücke.
simplify :: Arith -> Arith
simplify (a :+: b) = smartAdd (simplify a) (simplify b)
simplify (a :*: b) = smartMul (simplify a) (simplify b)
simplify x = x


{-H9.4-}

f :: Either a b -> Either b a
f (Left  x) = Right x
f (Right x) = Left  x

-- f = either Right Left

g :: (a -> a') -> (b -> b') -> Either a b -> Either a' b'
g f _ (Left  x) = Left  (f x)
g _ f (Right x) = Right (f x)

-- g f1 f2 = either (Left . f1) (Right . f2)

h :: (a -> Either a b) -> a -> b

h f x = case f x of
          Left  x' -> h f x'
          Right y  -> y

-- h f = either (h f) id . f