Permalink
Browse files

feature: parameterize the language in the configuration file

  • Loading branch information...
lthms committed Jul 14, 2017
1 parent 689a502 commit 65fbda8159d21d681e4e711a37fa3f05b49e6cdd
Showing with 32 additions and 9 deletions.
  1. +1 −1 app/Main.hs
  2. +10 −5 src/Celtchar/Novel.hs
  3. +5 −2 src/Celtchar/Novel/Ogmarkup.hs
  4. +16 −1 src/Celtchar/Novel/Structure.hs
@@ -34,7 +34,7 @@ main = do
f <- getNovelStructure $ conf
case f of Just x -> do res <- stringify (novelify x)
case f of Just x -> do res <- stringify (language x) (novelify x)
T.hPutStr h res
Nothing -> T.hPutStrLn stderr "error while parsing"
@@ -8,6 +8,7 @@
module Celtchar.Novel where
import Control.Monad.State.Strict
import Control.Monad.Reader
import Data.Default
import Data.String
import Data.Maybe
@@ -24,7 +25,10 @@ import Celtchar.Metadata
import Celtchar.Novel.Ogmarkup
import Celtchar.Novel.Structure
type Builder = StateT Text IO
type Builder = StateT Text (ReaderT Language IO)
getLanguage :: Builder Language
getLanguage = lift $ ask
append :: Text -> Builder ()
append str = do st <- get
@@ -34,8 +38,8 @@ appendLn :: Text -> Builder ()
appendLn str = do append str
append "\n"
stringify :: Builder () -> IO Text
stringify builder = execStateT builder ""
stringify :: Language -> Builder () -> IO Text
stringify lang builder = runReaderT (execStateT builder "") lang
class Novelify a where
novelify :: a -> Builder ()
@@ -47,10 +51,11 @@ instance (Novelify a) => Novelify [a] where
instance Novelify Document where
novelify (Document path) = do
lang <- getLanguage
f <- liftIO $ T.readFile path
case parseMetadata path f of
Right (metadata :: Maybe Text, txt) -> appendLn $ case takeExtension path of
".up" -> parseDoc txt
".up" -> parseDoc lang txt
".tex" -> txt
".md" -> parseMd f txt
_ -> verbatim txt
@@ -78,7 +83,7 @@ instance Novelify Manuscript where
instance Novelify Novel where
novelify n = do
appendLn [st|\documentclass[b5paper,12pt]{memoir}
\usepackage[french]{babel}
\usepackage[#{show $ language n}]{babel}
\usepackage[T1]{fontenc}
\usepackage[utf8]{inputenc}
\usepackage[urw-garamond]{mathdesign}
@@ -11,7 +11,9 @@ import Data.Text (Text, append)
import Data.String
import Text.Shakespeare.Text
data NovConf = NovConf
import Celtchar.Novel.Structure (Language(..))
data NovConf = NovConf Language
el :: Text
el = "\n\n"
@@ -21,7 +23,8 @@ blk :: Text
blk = (`append` el)
instance GenConf NovConf Text where
typography _ = frenchTypo
typography (NovConf French) = frenchTypo
typography (NovConf English) = englishTypo
printSpace _ None = ""
printSpace _ Normal = " "
@@ -8,6 +8,9 @@ module Celtchar.Novel.Structure where
import Data.Yaml
import GHC.Generics
data Language = French | English
deriving (Generic)
data Document = Document FilePath
deriving (Generic, Show)
@@ -36,12 +39,24 @@ data Manuscript = Manuscript [Part]
instance FromJSON Manuscript where
parseJSON v = Manuscript <$> parseJSON v
data Novel = Novel { author :: String
instance FromJSON Language where
parseJSON (String "english") = pure English
parseJSON (String "french") = pure French
parseJSON _ = fail "unknown language"
instance Show Language where
show English = "english"
show French = "french"
data Novel = Novel { author :: String
, language :: Language
, novelTitle :: String
, manuscript :: Manuscript }
deriving (Generic, Show)
instance FromJSON Novel where
parseJSON (Object v) = Novel <$> v .: "author"
<*> v .: "language"
<*> v .: "title"
<*> v .: "manuscript"

0 comments on commit 65fbda8

Please sign in to comment.