68 lines
1.9 KiB
Haskell
68 lines
1.9 KiB
Haskell
{-# 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 [(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 (/='[')
|