yokutango-leaflet/yokutango2tex.hs

{-# 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