module Sol_Exercise_7 where
import Data.Char as Char
import Data.Hashable as Hashable
import qualified Data.HashSet as HashSet -- from unordered-containers package
import qualified Data.List as List
import qualified Data.Vector as Vector -- from vector package
import Test.QuickCheck

{- Library -- nicht veraendern -}

data Tree a =
  Empty |
  Node a (Tree a) (Tree a)
    deriving (Eq, Show)

data Html =
  Text String |
  Block String [Html]

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

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!"]]]

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"]]


{- G1 -}

{- 1. -}

data WildChar =
  RawChar Char |
  AnyChar |
  AnyString |
  AnyCharIn [Char]

data WildPat =
  WildPat [WildChar]

{- 2. -}

stringFromWildChar :: WildChar -> String
stringFromWildChar (RawChar c) = [c]
stringFromWildChar AnyChar = "?"
stringFromWildChar AnyString = "*"
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. -}

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

wildPatFromString :: String -> WildPat
wildPatFromString = WildPat . wildStringFromString

{- 5. -}

prop_stringFromWildPatFromString s =
  stringFromWildPat (wildPatFromString s) == s

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

prop_wildPatFromStringFromWildPat_wrong p =
  wildPatFromString (stringFromWildPat p) == p

metas = "?*[]"

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

isWildPatSafe (WildPat ws) = all isWildCharSafe ws

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

{- 6. -}

matchWildChar :: WildChar -> Char -> Bool
matchWildChar (RawChar c0) c = c0 == c
matchWildChar AnyChar _ = True
matchWildChar (AnyCharIn cs) c = c `elem` cs

matchWildString :: [WildChar] -> String -> Bool
matchWildString [] s = null s
matchWildString (AnyString : ws) [] = matchWildString ws []
matchWildString (AnyString : ws) (c : cs) =
  matchWildString ws (c : cs) || matchWildString (AnyString : ws) cs
matchWildString (_ : _) [] = False
matchWildString (w : ws) (c : cs) = matchWildChar w c && matchWildString ws cs

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

match = matchWildPat . wildPatFromString


{- G2 -}

-- Aus Vorlesung
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
    | x > a = Node a l (insert x r)
    | otherwise = Node a l r

-- Lösung
inorder :: Tree a -> [a]
inorder Empty = []
inorder (Node a l r) = inorder l ++ a : inorder r

inorder' = inorder {- Compile --JB -}

treeSort :: Ord a => [a] -> [a]
treeSort = inorder . foldl (flip insert) Empty


{- G3 -}

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

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


{- H1 -}

prettyHtml :: Int -> Html -> String
prettyHtml indentSize = pretty 0
  where indent depth = replicate (indentSize * depth) ' '
        tag depth s = indent depth ++ "<" ++ s ++ ">\n"
        pretty depth (Text cs) = indent depth ++ concatMap htmlChar cs ++ "\n"
        pretty depth (Block s []) = tag depth (s ++ " /")
        pretty depth (Block s hs) =
          tag depth s ++
          concatMap (pretty (depth + 1)) hs ++
          tag depth ('/' : s)


{- H2 -}

plainDirTree :: Show a => DirTree a -> String
plainDirTree = unlines . format ""
  where
    format s (File x) = [s ++ show x]
    format s (Dir x ds) = (s ++ "/" ++  show x) : concatMap (format (s ++ "  ")) ds

prettyDirTree :: Show a => DirTree a -> String
prettyDirTree = unlines . format True ""
  where
    formatMap s [] = []
    formatMap s [x] = format True s x
    formatMap s (x:xs) = format False s x ++ formatMap s xs

    format _ s (File x) = [s ++ "+-- " ++ show x]
    format last s (Dir x xs) = [s ++ "+-\\ " ++ show x]
        ++ formatMap s' xs
      where s' = s ++ if last then "  " else "| "


{- H3 -}

{- simple version -}

unscrambleWord :: [String] -> String -> String
unscrambleWord vocabs word
  | word `elem` vocabs = word
  | otherwise =
    case List.find (\vocab -> List.sort vocab == List.sort word) vocabs of
      Nothing -> word
      Just vocab -> vocab

unscrambleWords :: [String] -> [String] -> [String]
unscrambleWords = map . unscrambleWord
  

{- optimized version -}

alphabetSize = 26

indexInAlphabet :: Char -> Int
indexInAlphabet c = ord c - ord 'a'

data Trie a =
  X |
  Y (HashSet.HashSet a) (Vector.Vector (Trie a))

instance Show a => Show (Trie a) where
  show X = "X"
  show (Y vals tries) =
    "Y " ++ show vals ++ " " ++ show (Vector.toList tries)

addToTrie :: Eq a => Hashable a => (String, a) -> Trie a -> Trie a
addToTrie p X = addToTrie p (Y HashSet.empty (Vector.replicate alphabetSize X))
addToTrie ([], val) (Y vals tries) = Y (HashSet.insert val vals) tries
addToTrie (c : cs, val) (Y vals tries) =
    Y vals (tries Vector.// [(j, addToTrie (cs, val) (tries Vector.! j))])
  where j = indexInAlphabet c

buildTrie :: Eq a => Hashable a => [(String, a)] -> Trie a
buildTrie = foldl (flip addToTrie) X

lookupInTrie :: Trie a -> String -> HashSet.HashSet a
lookupInTrie X _ = HashSet.empty
lookupInTrie (Y vals _) [] = vals
lookupInTrie (Y _ tries) (c : cs) =
  lookupInTrie (tries Vector.! indexInAlphabet c) cs

unscrambleWord' :: Trie String -> String -> String
unscrambleWord' trie word =
    if HashSet.null words || word `HashSet.member` words then word
    else head (HashSet.toList words)
  where words = lookupInTrie trie (List.sort word)

unscrambleWords' :: [String] -> [String] -> [String]
unscrambleWords' =
  map . unscrambleWord' . buildTrie . map (\word -> (List.sort word, word))

{-WETT-}
{-TTEW-}