gdritter repos adriatic / master src / Element.hs
master

Tree @master (Download .tar.gz)

Element.hs @master

518e423
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

import qualified Data.HashMap.Strict as HM
import           Data.List (intersperse)
import           Data.Text (Text)
import           Data.Yaml
import           Text.LaTeX

class ToTex a where
  toTex :: a -> LaTeX

instance ToTex a => ToTex [a] where
  toTex = mconcat . map toTex

data Skill = Skill
  { skName     :: Text
  , skBasic    :: [Knack]
  , skAdvanced :: [Knack]
  } deriving (Eq,Show)

data Knack = Knack
  { knName :: Text
  , knDescription :: Maybe Text
  } deriving (Eq,Show)

instance FromJSON [Skill] where
  parseJSON (Object os) = mapM getSkill (HM.toList os)
    where getSkill :: (Text, Value) -> Parser Skill
          getSkill (skName, Object os) = do
            basic      <- os .:? "basic"
            advanced   <- os .:? "advanced"
            skBasic    <- maybe (return []) (mapM getKnack) basic
            skAdvanced <- maybe (return []) (mapM getKnack) advanced
            return Skill { .. }
          getSkill (name, Null) = return (Skill name [] [])
          getSkill _ = return (Skill "???" [] [])
          getKnack :: Value -> Parser Knack
          getKnack (String name) = return (Knack name Nothing)
          getKnack (Object os) =
            case HM.toList os of
              [(name, String desc)] -> return (Knack name (Just desc))
              _ -> fail "mal-formatted knack"
          getKnack _ = fail "knack neither string nor object"
  parseJSON _ = fail "skills not object"

instance ToTex Skill where
  toTex Skill { .. } = tabular Nothing [LeftColumn, LeftColumn] table
    where table    = raw skName & contents
          contents =    mconcat (intersperse newline (map go skBasic))
                     <> mconcat (intersperse newline (map go skAdvanced))
          go (Knack name Nothing)     = raw name
          go (Knack name (Just desc)) = raw name <> textit (raw desc)