{-# LANGUAGE DeriveGeneric #-}
module Exercise_7 where
import Data.List hiding (insert)
import Data.Char
import Test.QuickCheck

{- Library DO NOT CHANGE -}
data Tree a =
  Empty |
  Node a (Tree a) (Tree a)
    deriving (Eq, Show)

tree =  (Node 4
         (Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty))
         (Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty)))

insert :: Ord a => a -> Tree a -> Tree a
insert x Empty = Node x Empty Empty
insert x (Node a l r)
        | x < a = Node a (insert x l) r
        | a < x = Node a l (insert x r)
        | otherwise = Node a l r

data Html =
  Text String |
  Block String [Html]

grueezi =
  Block "html"
    [Block "head"
       [Block "author" [Text "der MC"],
        Block "date" [Text "27.11.2012"],
        Block "topsecret" []],
     Block "body"
       [Block "h1" [Text "Gr\252ezi!"],
        Block "p" [Text "\196b\228, genau. Sal\252. Bis sp\246ter!"]]]

kleiner =
  Block "html"
    [Block "a"
        [Text "Hallo"],
     Block "b"
        [Text "du da!"]
    ]

swissLetters :: [(Int, String)]
swissLetters =
  [(196, "Auml"), (214, "Ouml"), (220, "Uuml"),
   (228, "auml"), (246, "ouml"), (252, "uuml")]

data DirTree a =
  File a |
  Dir a [DirTree a]
    deriving (Eq, Show)

exDir :: DirTree String
exDir =
  Dir "" [Dir "usr" [Dir "lib" [File "vim"], Dir "include" [File "string.h"]],
    Dir "bin" $ [File "ls", File "cat"]]
{- End Library -}


{---------------------------------------------------------------------}
{- Aufgabe G7.1 -}

{- 1. -}
data WildChar =
  AnyChar |
  AnyString |
  RawChar Char |
  AnyCharIn [Char]


data WildPat =
  WildPat [WildChar]


{- 2. -}
stringFromWildChar :: WildChar -> String
stringFromWildChar AnyChar        = "?"
stringFromWildChar AnyString      = "*"
stringFromWildChar (RawChar c)    = [c]
stringFromWildChar (AnyCharIn cs) = "[" ++ cs ++ "]"


stringFromWildPat :: WildPat -> String
stringFromWildPat (WildPat ws) = concatMap stringFromWildChar ws


{- 3. -}
instance Show WildChar where
        show = stringFromWildChar

instance Show WildPat where
        show = stringFromWildPat


{- 4. -}
wildCharsFromString :: String -> [WildChar]
wildCharsFromString [] = []
wildCharsFromString (c : cs)
        | c == '?' = AnyChar : ps
        | c == '*' = AnyString : ps
        | c == '[' =
                case dropWhile (/= ']') cs of
                []       -> RawChar '[' : ps
                _ : rest -> AnyCharIn (takeWhile (/= ']') cs) :
                                wildCharsFromString rest
        | otherwise = RawChar c : ps
        where ps = wildCharsFromString cs

wildPatFromString :: String -> WildPat
wildPatFromString cs = WildPat (wildCharsFromString cs)


{- 5. -}
-- WildChar und WildPat QuickCheckkompatibel machen
instance Eq WildChar where
  RawChar c == RawChar c' = c == c'
  AnyChar == AnyChar = True
  AnyString == AnyString = True
  AnyCharIn cs == AnyCharIn cs' = cs == cs'
  _ == _ = False

instance Eq WildPat where
  WildPat p == WildPat p' = p == p'

instance Arbitrary WildChar where
  arbitrary =
    oneof (map return
      (map RawChar "abc?*[]" ++
       [AnyChar, AnyString] ++
       map AnyCharIn ["", "a", "bc", "bbc", "[]", "*?"]))

instance Arbitrary WildPat where
  arbitrary =
    do ws <- arbitrary
       return $ WildPat ws

metas = "?*[]"

isWildCharSafe (RawChar c) = c `notElem` metas
isWildCharSafe (AnyCharIn cs) = all (`notElem` metas) cs
isWildCharSafe _ = True

isWildPatSafe (WildPat ws) = all isWildCharSafe ws

-- Properties

prop_stringFromWildPatFromString s =
  stringFromWildPat (wildPatFromString s) == s

prop_wildPatFromStringFromWildPat p =
  isWildPatSafe p ==> wildPatFromString (stringFromWildPat p) == p


{- 6. -}
{-
G4.4

match [] ys             = null ys
match ('?':ps) (y:ys)   = match ps ys
match ('*':ps) []       = match ps []
match ('*':ps) (y:ys)   = match ps (y:ys) || match ('*':ps) ys
match (p:ps) (y:ys)     = p == y && match ps ys
match ps []             = False
-}

matchWildChars :: [WildChar] -> String -> Bool
matchWildChars [] ys                      = null ys
matchWildChars (AnyChar:ps) (y:ys)        = matchWildChars ps ys
matchWildChars (AnyString:ps) []          = matchWildChars ps []
matchWildChars (AnyString:ps) (y:ys)      = matchWildChars ps (y:ys)
                                             || matchWildChars (AnyString:ps) ys
matchWildChars ((AnyCharIn cs):ps) (y:ys) = elem y cs && matchWildChars ps ys
matchWildChars ((RawChar c):ps) (y:ys)    = c == y && matchWildChars ps ys
matchWildChars ps []                      = False


matchWildPat :: WildPat -> String -> Bool
matchWildPat (WildPat ws) = matchWildChars ws

match ps ms = matchWildPat (wildPatFromString ps) ms



{---------------------------------------------------------------------}
{- Aufgabe G7.2 -}

-- Beispiel für Rekursion über einen binären Suchbaum
smallest :: Ord a => Tree a -> Maybe a
smallest Empty            = Nothing
smallest (Node v Empty _) = Just v
smallest (Node _ l _)     = smallest l

---

listToSortedTree :: Ord a => [a] -> Tree a
--listToSortedTree xs = foldl (\tree x -> insert x tree) Empty xs
listToSortedTree xs = foldl (flip insert) Empty xs


inorder :: Ord a => Tree a -> [a]
inorder Empty        = []
inorder (Node v l r) = inorder l ++ [v] ++ inorder r


treeSort :: Ord a => [a] -> [a]
treeSort = inorder . listToSortedTree

---

-- Properties
-- treeSort sortiert
prop_treeSort_isSorted ps =
        let ts = treeSort ps in ts == sort ts

-- treeSort entfernt keine Elemente
prop_treeSort_isComplete ps =
        eqSet (nub ps) (treeSort ps)
        where
        eqSet xs ys = null (xs \\ ys) && null (ys \\ xs)


{---------------------------------------------------------------------}
{- Aufgabe G7.3 -}

htmlChar :: Char -> String
htmlChar c
        | o < 128 = [c]
        | otherwise = "&" ++ entity ++ ";"
        where
        o = ord c
        entity =
                case lookup o swissLetters of
                        Nothing ->   show o
                        Just name -> name


plainHtml :: Html -> String
plainHtml (Text cs)       = concatMap htmlChar cs
plainHtml (Block name bs) = "<" ++ name ++ ">" ++ concatMap plainHtml bs ++ "</" ++ name ++ ">"



{---------------------------------------------------------------------}
{- Aufgabe H7.1 -}

prettyHtml :: Int -> Html -> String
prettyHtml = undefined



{---------------------------------------------------------------------}
{- Aufgabe H7.2 -}

plainDirTree :: Show a => DirTree a -> String
plainDirTree = undefined


prettyDirTree :: Show a => DirTree a -> String
prettyDirTree = undefined



{---------------------------------------------------------------------}
{- Aufgabe H7.3 -}

{-WETT-}
unscrambleWords :: [String] -> [String] -> [String]
unscrambleWords = undefined
{-TTEW-}