{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} module Main where import Control.Monad import Data.Function import Data.Map as M import Data.Maybe import Data.Text (Text) import System.FilePath import System.Directory import Text.EscapeArtist import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.List as L import qualified Debug.Trace as D type Language = Text type Dictionary = Map Text Text main :: IO () main = do dicts <- getLanguageData mainLoop dicts mainLoop :: Map Language Dictionary -> IO () mainLoop d = do putStrLn "Name to look up (q to quit)?" T.getLine >>= \case "q" -> return () name -> do forM_ (keys d) $ \language -> do putEscLn $ Default ("Results in language: "::Text) <> colorLang language language mapM_ (putEscLn . colorLang language) $ search (d!language) name mainLoop d colorLang :: Text -> Text -> Escapable colorLang "dwarf" = FgGreen colorLang "elf" = FgRed colorLang "goblin" = FgYellow colorLang "human" = FgBlue colorLang _ = Default search :: Dictionary -> Text -> [Text] search _ "" = [""] search d name = let prefixes = L.filter (`T.isPrefixOf` name) $ keys d in if L.null prefixes then [" - NO PERFECT MACTH ('"<>name<>"' left over from input)"] else [(d!p) <> s | p <- prefixes, s <- search d (T.drop (T.length p) name)] getLanguageData :: IO (Map Language Dictionary) getLanguageData = do files <- listDirectory "data" dicts <- forM files $ \fn -> case takeExtension fn of ".raw" -> do words <- fmap extractWord . L.filter ("T_WORD" `T.isInfixOf`) . T.lines <$> T.readFile ("data" fn) return $ Just (T.pack $ takeBaseName fn, fromList words) _ -> return Nothing return $ fromList $ catMaybes dicts extractWord :: Text -> (Text, Text) extractWord = (\x -> (T.toLower $ x!!1,x!!2)) . T.splitOn ":" . T.dropEnd 1 . T.dropWhileEnd (/=']') . T.drop 1 . T.dropWhile (/='[')