diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -7,9 +7,11 @@ module Main where import Control.Monad (void) +import qualified Data.ByteString as B import Data.FileEmbed import Data.Maybe (fromMaybe) import qualified Data.Text.IO as T +import Data.Yaml import Options.Generic import System.Directory (getCurrentDirectory, setCurrentDirectory) @@ -27,12 +29,9 @@ } | Deps { root :: FilePath } + | New FilePath deriving (Generic, Show) -getRoot :: Command -> FilePath -getRoot (Build root _) = root -getRoot (Deps root) = root - instance ParseRecord Command getOutputHandle :: Maybe FilePath -> IO Handle @@ -43,11 +42,10 @@ main = do cmd <- getRecord "celtchar" :: IO Command - let conf = getRoot cmd - f <- getNovelStructure conf - case cmd of - Build _ out -> do + Build conf out -> do + f <- getNovelStructure conf + let inDir = takeDirectory $ root cmd outDir = takeDirectory $ fromMaybe "." out rootDir <- getCurrentDirectory @@ -67,9 +65,13 @@ Left err -> do hPutStrLn stderr err exitFailure - Deps _ -> + Deps conf -> do + f <- getNovelStructure conf + case f of Right x -> mapM_ putStrLn (getDeps x) Left err -> do hPutStrLn stderr err exitFailure + New root -> + B.writeFile root (encode defaultNovel) diff --git a/assets/ogma.sty b/assets/ogma.sty --- a/assets/ogma.sty +++ b/assets/ogma.sty @@ -2,7 +2,13 @@ \usepackage{xcolor} \usepackage{afterpage} \usepackage{xspace} +\usepackage{textcomp} +\usepackage{graphicx} +\DeclareOption{french}{\def\beforemark{\,}} +\DeclareOption{english}{\def\beforemark{}} +\ProcessOptions\relax + \newtoggle{thought} \newcommand{\dialogue}{\togglefalse{thought}} @@ -31,3 +37,6 @@ \newpage } \makeatother + +\def\ironymark{\beforemark\reflectbox{?}} +\def\interrobang{\beforemark\textinterrobang} diff --git a/celtchar.cabal b/celtchar.cabal --- a/celtchar.cabal +++ b/celtchar.cabal @@ -1,5 +1,5 @@ name: celtchar -version: 0.1.3.0 +version: 0.1.4.0 synopsis: A tool to build a novel description: celtchar is a tool to build a novel. It is part of the Ogma project and mostly relies on the @@ -9,7 +9,7 @@ license-file: LICENSE author: Thomas Letan maintainer: contact@thomasletan.fr -copyright: 2016 - 2017 Thomas Letan +copyright: 2016 - 2018 Thomas Letan category: Text build-type: Simple extra-source-files: assets/ogma.sty @@ -18,18 +18,19 @@ library hs-source-dirs: src exposed-modules: Celtchar.Metadata - , Celtchar.Novel.Structure , Celtchar.Novel + , Celtchar.Novel.Structure , Celtchar.Novel.Ogmarkup - build-depends: base >= 4.7 && < 5 - , ogmarkup >= 4 && < 5 - , yaml >= 0.8 && < 0.9 - , mtl >= 2.2 && < 2.3 - , filepath >= 1.4 && < 1.5 - , text >= 1.2 && < 1.3 - , pandoc >= 2.0 && < 2.1 - , shakespeare >= 2.0 && < 2.1 - , megaparsec >= 6 && < 7 + build-depends: base >= 4.7 && < 5 + , filepath >= 1.4 && < 1.5 + , megaparsec >= 6 && < 7 + , mtl >= 2.2 && < 2.3 + , ogmarkup >= 5 && < 6 + , pandoc >= 2.0 && < 2.1 + , shakespeare >= 2.0 && < 2.1 + , text >= 1.2 && < 1.3 + , unordered-containers >= 0.2 && < 0.3 + , yaml >= 0.8 && < 0.9 default-language: Haskell2010 executable celtchar @@ -42,6 +43,8 @@ , file-embed >= 0.0.10 && < 0.1 , filepath >= 1.4 && < 1.5 , directory >= 1.3 && < 1.4 + , bytestring + , yaml >= 0.8 && < 0.9 , celtchar default-language: Haskell2010 diff --git a/src/Celtchar/Novel.hs b/src/Celtchar/Novel.hs --- a/src/Celtchar/Novel.hs +++ b/src/Celtchar/Novel.hs @@ -75,9 +75,12 @@ novelify $ chapters p instance Novelify Manuscript where - novelify (Manuscript m) = do + novelify (WithParts p) = do append "\\mainmatter\n" - novelify m + novelify p + novelify (WithChapters c) = do + append "\\mainmatter\n" + novelify c instance Novelify Novel where novelify n = do @@ -85,8 +88,9 @@ \usepackage[#{show $ language n}]{babel} \usepackage[T1]{fontenc} \usepackage[utf8]{inputenc} -\usepackage[urw-garamond]{mathdesign} -\usepackage{ogma} +\usepackage[nf]{coelacanth} +\usepackage{microtype} +\usepackage[#{show $ language n}]{ogma} \sloppy \title{#{novelTitle n}} \author{#{author n}} diff --git a/src/Celtchar/Novel/Ogmarkup.hs b/src/Celtchar/Novel/Ogmarkup.hs --- a/src/Celtchar/Novel/Ogmarkup.hs +++ b/src/Celtchar/Novel/Ogmarkup.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -24,10 +25,41 @@ toTypo :: IsString a => Typography a instance HasTypo French where - toTypo = frenchTypo + toTypo = frenchTypo $ \case + Semicolon -> ";" + Colon -> ":" + Question -> "?" + Exclamation -> "!" + OpenQuote -> "\\og{}" + CloseQuote -> "\\fg{}" + Dash -> "--" + LongDash -> "---" + Comma -> "," + Point -> "." + Hyphen -> "-" + SuspensionPoints -> "…" + Apostrophe -> "’" + Interrobang -> "\\interrobang" + Irony -> "\\ironymark" + instance HasTypo English where - toTypo = englishTypo + toTypo = englishTypo $ \case + Semicolon -> ";" + Colon -> ":" + Question -> "?" + Exclamation -> "!" + OpenQuote -> "``" + CloseQuote -> "''" + Dash -> "--" + LongDash -> "---" + Comma -> "," + Point -> "." + Hyphen -> "-" + SuspensionPoints -> "\\ldots" + Apostrophe -> "’" + Interrobang -> "\\interrobang" + Irony -> "\\ironymark" el :: Text el = "\n\n" @@ -41,7 +73,7 @@ printSpace None = "" printSpace Normal = " " - printSpace Nbsp = "~" + printSpace Nbsp = "" -- we let babel and ogma.sty deal with typography betweenDialogue = el diff --git a/src/Celtchar/Novel/Structure.hs b/src/Celtchar/Novel/Structure.hs --- a/src/Celtchar/Novel/Structure.hs +++ b/src/Celtchar/Novel/Structure.hs @@ -5,7 +5,10 @@ module Celtchar.Novel.Structure where -import Data.Maybe (fromMaybe) +import Control.Applicative ((<|>)) +import Data.HashMap.Strict ((!)) +import Data.Maybe (fromMaybe) +import Data.Text (pack) import Data.Yaml import GHC.Generics @@ -22,8 +25,11 @@ getDeps (Document fp) = [fp] instance FromJSON Document where - parseJSON v = Document <$> parseJSON v + parseJSON v = Document <$> parseJSON v +instance ToJSON Document where + toJSON (Document path) = String (pack path) + data Chapter = Chapter { chapterTitle :: Maybe String , documents :: [Document] } @@ -35,6 +41,10 @@ instance FromJSON Chapter where parseJSON (Object v) = Chapter <$> v .:? "title" <*> v .: "documents" +instance ToJSON Chapter where + toJSON (Chapter title docs) = object [ "title" .= title + , "documents" .= docs + ] data Part = Part { partTitle :: String , chapters :: [Chapter] @@ -45,23 +55,39 @@ parseJSON (Object v) = Part <$> v .: "title" <*> v .: "chapters" +instance ToJSON Part where + toJSON (Part title chaps) = object [ "title" .= title + , "chapters" .= chaps + ] + instance HasDependencies Part where getDeps (Part _ chaps) = chaps >>= getDeps -newtype Manuscript = Manuscript [Part] +data Manuscript = WithParts [Part] + | WithChapters [Chapter] deriving (Generic, Show) instance HasDependencies Manuscript where - getDeps (Manuscript parts) = parts >>= getDeps + getDeps (WithParts parts) = parts >>= getDeps + getDeps (WithChapters chaps) = chaps >>= getDeps instance FromJSON Manuscript where - parseJSON v = Manuscript <$> parseJSON v + parseJSON v = (WithParts <$> parseJSON v) + <|> (WithChapters <$> parseJSON v) +instance ToJSON Manuscript where + toJSON (WithParts p) = toJSON p + toJSON (WithChapters c) = toJSON c + instance FromJSON Language where parseJSON (String "english") = pure English parseJSON (String "french") = pure French parseJSON _ = fail "unknown language" +instance ToJSON Language where + toJSON English = String $ pack "english" + toJSON French = String $ pack "french" + instance Show Language where show English = "english" show French = "french" @@ -91,9 +117,35 @@ <*> v .: "manuscript" <*> v .:? "appendix" +instance ToJSON Novel where + toJSON (Novel author language title front man app) = + object [ "language" .= language + , "author" .= author + , "frontmatter" .= front + , "title" .= title + , "manuscript" .= man + , "appendix" .= app + ] + getNovelStructure :: FilePath -> IO (Either String Novel) getNovelStructure conf = do ec <- decodeFileEither conf case ec of Right novel -> pure . Right $ novel Left ex -> pure . Left $ prettyPrintParseException ex + +defaultNovel :: Novel +defaultNovel = + Novel { novelTitle = "title" + , author = "author" + , language = English + , frontmatter = Just [] + , appendix = Just [] + , manuscript = + WithParts [ Part { partTitle = "part title" + , chapters = [ Chapter { chapterTitle = Just "chapter title" + , documents = [] + }] + } + ] + }