initial
This commit is contained in:
parent
39bb7a694d
commit
54759a8cf7
67
app/Main.hs
Normal file
67
app/Main.hs
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
{-# 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 (/='[')
|
2195
data/dwarf.raw
Normal file
2195
data/dwarf.raw
Normal file
File diff suppressed because it is too large
Load Diff
2202
data/elf.raw
Normal file
2202
data/elf.raw
Normal file
File diff suppressed because it is too large
Load Diff
2202
data/goblin.raw
Normal file
2202
data/goblin.raw
Normal file
File diff suppressed because it is too large
Load Diff
2198
data/human.raw
Normal file
2198
data/human.raw
Normal file
File diff suppressed because it is too large
Load Diff
42
df-actors.cabal
Normal file
42
df-actors.cabal
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
cabal-version: 2.4
|
||||||
|
name: df-actors
|
||||||
|
version: 0.1.0.0
|
||||||
|
|
||||||
|
-- A short (one-line) description of the package.
|
||||||
|
-- synopsis:
|
||||||
|
|
||||||
|
-- A longer description of the package.
|
||||||
|
-- description:
|
||||||
|
|
||||||
|
-- A URL where users can report bugs.
|
||||||
|
-- bug-reports:
|
||||||
|
|
||||||
|
-- The license under which the package is released.
|
||||||
|
-- license:
|
||||||
|
author: Stefan Dresselhaus
|
||||||
|
maintainer: stefan@dresselhaus.cloud
|
||||||
|
|
||||||
|
-- A copyright notice.
|
||||||
|
-- copyright:
|
||||||
|
-- category:
|
||||||
|
extra-source-files:
|
||||||
|
CHANGELOG.md
|
||||||
|
README.md
|
||||||
|
|
||||||
|
executable df-actors
|
||||||
|
main-is: Main.hs
|
||||||
|
|
||||||
|
-- Modules included in this executable, other than Main.
|
||||||
|
-- other-modules:
|
||||||
|
|
||||||
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
|
-- other-extensions:
|
||||||
|
build-depends: base ^>=4.14.3.0
|
||||||
|
, filepath
|
||||||
|
, directory
|
||||||
|
, unordered-containers
|
||||||
|
, containers
|
||||||
|
, text
|
||||||
|
, escape-artist
|
||||||
|
hs-source-dirs: app
|
||||||
|
default-language: Haskell2010
|
Loading…
Reference in New Issue
Block a user