feature: parameterize the language in the configuration file

app/Main.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"
 

src/Celtchar/Novel.hs

@@ -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}

src/Celtchar/Novel/Ogmarkup.hs

@@ -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 = " "

src/Celtchar/Novel/Structure.hs

@@ -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"