106 lines
3.5 KiB
Haskell
106 lines
3.5 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
import Data.Aeson
|
|
import Data.String (fromString)
|
|
import GHC.Generics
|
|
import System.Directory
|
|
import System.Environment
|
|
import System.FilePath
|
|
import Data.Maybe
|
|
import Data.List (intersperse)
|
|
|
|
import qualified Data.Text.Lazy as T
|
|
import qualified Data.Text.Lazy.IO as T
|
|
import qualified Data.Text.Lazy.Encoding as T
|
|
import qualified Data.ByteString.Lazy as BS
|
|
|
|
data NorwegianWord = NorwegianWord { word :: T.Text
|
|
, hints :: Maybe [T.Text]
|
|
} deriving (Generic, Show)
|
|
|
|
instance FromJSON NorwegianWord
|
|
instance ToJSON NorwegianWord where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
data JapaneseWord = JapaneseWord { word :: T.Text
|
|
, romaji :: Maybe T.Text
|
|
, hints :: Maybe [T.Text]
|
|
} deriving (Generic, Show)
|
|
|
|
instance FromJSON JapaneseWord
|
|
instance ToJSON JapaneseWord where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
data Card = Card { norwegian :: [NorwegianWord]
|
|
, japanese :: [JapaneseWord]
|
|
} deriving (Generic, Show)
|
|
|
|
data WordBlock = WordBlock { title :: T.Text
|
|
, cards :: [Card]
|
|
} deriving (Show)
|
|
|
|
instance FromJSON Card
|
|
instance ToJSON Card where
|
|
toEncoding = genericToEncoding defaultOptions
|
|
|
|
readJsonFile :: FilePath -> IO (Either String WordBlock)
|
|
readJsonFile path = do
|
|
fileContent <- BS.readFile path
|
|
return $ cardsToWordblock <$> eitherDecode fileContent
|
|
where
|
|
formatPath :: FilePath -> T.Text
|
|
formatPath = T.append " "
|
|
. fromMaybe "???"
|
|
. T.stripPrefix "yokutango_"
|
|
. fromString
|
|
. takeBaseName
|
|
|
|
cardsToWordblock cards = WordBlock { title = formatPath path
|
|
, cards = cards
|
|
}
|
|
|
|
|
|
cardToRow :: Card -> T.Text
|
|
cardToRow card = mconcat [ japanesePart card, " $\\longleftrightarrow$ ", norwegianPart card ]
|
|
where
|
|
jpWordToText :: JapaneseWord -> T.Text
|
|
jpWordToText JapaneseWord { word, romaji, hints } =
|
|
case (word, romaji, hints) of
|
|
(w, Just r, _) -> mconcat [ "\\ruby{", w, "}{", r, "}" ]
|
|
(w, Nothing, _) -> w
|
|
|
|
noWordToText :: NorwegianWord -> T.Text
|
|
noWordToText NorwegianWord { word, hints } = word
|
|
|
|
japanesePart (Card { japanese }) = mconcat $ intersperse ("\\\\\n" :: T.Text) $ map jpWordToText japanese
|
|
norwegianPart (Card { norwegian }) = mconcat $ intersperse ("\\\\\n" :: T.Text) $ map noWordToText norwegian
|
|
|
|
|
|
|
|
|
|
wordblockToTable :: WordBlock -> T.Text
|
|
wordblockToTable block = mconcat tablePieces
|
|
where
|
|
rows = map ((\t -> T.append t "\\\\\n") . cardToRow) (cards block)
|
|
tablePieces = [ "\\section*{", title block, "}\n" ] ++ rows ++ ["\\newpage"]
|
|
|
|
main :: IO ()
|
|
main = do
|
|
dir <- head <$> getArgs
|
|
filePaths <- map (\x -> joinPath [dir, x]) <$> listDirectory dir
|
|
wordBlocks :: Either str [WordBlock] <- sequence <$> mapM readJsonFile filePaths
|
|
|
|
let output = case wordBlocks of
|
|
Right blocks -> mconcat $ map wordblockToTable blocks
|
|
Left err -> fromString err
|
|
|
|
BS.putStr $ T.encodeUtf8 $ output
|
|
-- case jsonFiles of
|
|
-- Right cards -> mapM_ print cards
|
|
-- Left err -> putStr err
|