diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -6,23 +6,30 @@ module Main where +import Control.Monad (void) import Options.Generic -import Data.Text (unpack) -import System.IO (stderr, stdout, Handle, IOMode(..), openFile, hClose) +import System.IO (stderr, stdout, Handle, IOMode(..), openFile, hClose, hPutStrLn) import System.FilePath (takeDirectory, ()) import System.Directory (setCurrentDirectory, getCurrentDirectory) import qualified Data.Text.IO as T import Data.FileEmbed +import System.Exit (exitFailure) import Celtchar.Novel.Structure import Celtchar.Novel data Command = - Command { root :: FilePath - , output :: Maybe FilePath - } + Build { root :: FilePath + , output :: Maybe FilePath + } + | Deps { root :: FilePath + } deriving (Generic, Show) +getRoot :: Command -> FilePath +getRoot (Build root _) = root +getRoot (Deps root) = root + instance ParseRecord Command getOutputHandle :: Maybe FilePath -> IO Handle @@ -33,24 +40,33 @@ main = do cmd <- getRecord "celtchar" :: IO Command - let conf = root cmd - h <- getOutputHandle $ output cmd + let conf = getRoot cmd f <- getNovelStructure $ conf - let inDir = takeDirectory $ root cmd - outDir = takeDirectory $ maybe "." id (output cmd) - rootDir <- getCurrentDirectory - - -- write the final tex file - setCurrentDirectory inDir + case cmd of + Build _ out -> do + let inDir = takeDirectory $ root cmd + outDir = takeDirectory $ maybe "." id out + rootDir <- getCurrentDirectory - case f of Just x -> do res <- stringify (language x) (novelify x) - T.hPutStr h res - Nothing -> T.hPutStrLn stderr "error while parsing" + -- write the final tex file + setCurrentDirectory inDir - hClose h + case f of Right x -> do + res <- stringify (language x) (novelify x) - -- write the sty file - setCurrentDirectory rootDir + setCurrentDirectory rootDir + h <- getOutputHandle $ output cmd + T.hPutStr h res + hClose h - T.writeFile (outDir "ogma.sty") $(embedStringFile "ogma.sty") + T.writeFile (outDir "ogma.sty") $(embedStringFile "assets/ogma.sty") + Left err -> do + hPutStrLn stderr err + exitFailure + Deps _ -> + case f of Right x -> + void $ mapM putStrLn (getDeps x) + Left err -> do + hPutStrLn stderr err + exitFailure diff --git a/assets/ogma.sty b/assets/ogma.sty new file mode 100644 --- /dev/null +++ b/assets/ogma.sty @@ -0,0 +1,33 @@ +\usepackage{etoolbox} +\usepackage{xcolor} +\usepackage{afterpage} +\usepackage{xspace} + +\newtoggle{thought} + +\newcommand{\dialogue}{\togglefalse{thought}} +\newcommand{\thought}{\toggletrue{thought}} +\newcommand{\reply}[1]{% + \iftoggle{thought}{% + \textit{#1}\xspace% + }{% + #1\xspace% + }% +} + +\makeatletter +\def\@maketitle{% + \newpage + \color{white} + \pagecolor{black}\afterpage{\nopagecolor} + \begin{center} + \fontsize{50}{60}\selectfont \textsc{\@title} + \end{center} + \vfill + \begin{center} + \large + \@author + \end{center} + \newpage + } +\makeatother diff --git a/celtchar.cabal b/celtchar.cabal --- a/celtchar.cabal +++ b/celtchar.cabal @@ -1,8 +1,8 @@ name: celtchar -version: 0.1.0.1 +version: 0.1.2.0 synopsis: A tool to build a novel description: Please see README.md -homepage: https://github.com/ogma-project/celtchar#readme +homepage: https://nest.pijul.com/lthms/celtchar license: MIT license-file: LICENSE author: Thomas Letan @@ -10,7 +10,7 @@ copyright: 2016 Thomas Letan category: Text build-type: Simple -extra-source-files: ogma.sty +extra-source-files: assets/ogma.sty cabal-version: >=1.10 library @@ -27,7 +27,7 @@ , text >= 1.2 && < 1.3 , pandoc >= 1.19 && < 1.20 , shakespeare >= 2.0 && < 2.1 - , megaparsec >= 5.2 && < 5.3 + , megaparsec >= 6 && < 7 default-language: Haskell2010 executable celtchar @@ -35,7 +35,7 @@ main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >= 4.7 && < 5 - , optparse-generic >= 1.1 && < 1.2 + , optparse-generic >= 1.1 && < 1.3 , text >= 1.2 && < 1.3 , file-embed >= 0.0.10 && < 0.1 , filepath >= 1.4 && < 1.5 @@ -55,5 +55,5 @@ default-language: Haskell2010 source-repository head - type: git - location: https://github.com/ogma-project/celtchar + type: pijul + location: https://nest.pijul.com/lthms/celtchar diff --git a/ogma.sty b/ogma.sty deleted file mode 100644 --- a/ogma.sty +++ /dev/null @@ -1,33 +0,0 @@ -\usepackage{etoolbox} -\usepackage{xcolor} -\usepackage{afterpage} -\usepackage{xspace} - -\newtoggle{thought} - -\newcommand{\dialogue}{\togglefalse{thought}} -\newcommand{\thought}{\toggletrue{thought}} -\newcommand{\reply}[1]{% - \iftoggle{thought}{% - \textit{#1}\xspace% - }{% - #1\xspace% - }% -} - -\makeatletter -\def\@maketitle{% - \newpage - \color{white} - \pagecolor{black}\afterpage{\nopagecolor} - \begin{center} - \fontsize{50}{60}\selectfont \textsc{\@title} - \end{center} - \vfill - \begin{center} - \large - \@author - \end{center} - \newpage - } -\makeatother diff --git a/src/Celtchar/Metadata.hs b/src/Celtchar/Metadata.hs --- a/src/Celtchar/Metadata.hs +++ b/src/Celtchar/Metadata.hs @@ -5,12 +5,14 @@ ) where import Text.Megaparsec +import Text.Megaparsec.Char import Data.String +import Data.Void (Void) parseMetadata :: (Stream a, Token a ~ Char, IsString b) => String -> a - -> Either (ParseError Char Dec) (Maybe b, b) + -> Either (ParseError Char Void) (Maybe b, b) parseMetadata = runParser (do metadata <- (try metadata) <|> (return Nothing) text <- manyTill anyChar eof diff --git a/src/Celtchar/Novel.hs b/src/Celtchar/Novel.hs --- a/src/Celtchar/Novel.hs +++ b/src/Celtchar/Novel.hs @@ -10,10 +10,8 @@ import Control.Monad.State.Strict import Control.Monad.Reader import Data.String -import Data.Maybe import Data.Text (Text, pack, unpack) import qualified Data.Text.IO as T -import Data.Monoid import System.FilePath import Text.Pandoc.Options import Text.Pandoc.Readers.Markdown @@ -91,9 +89,23 @@ \title{#{novelTitle n}} \author{#{author n}} \begin{document} +\frontmatter \maketitle|] + putFrontmatter $ frontmatter n novelify $ manuscript n + putAppendix $ appendix n append "\\end{document}" + where + putFrontmatter Nothing = + appendLn "% No frontmatter field in configuration file" + putFrontmatter (Just fm) = + novelify fm + + putAppendix Nothing = + appendLn "% No appendix field in configuration file" + putAppendix (Just app) = + novelify app + parseMd :: Text -> Text 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 @@ -7,13 +7,20 @@ import Data.Yaml import GHC.Generics +import Data.Maybe (maybe) +class HasDependencies c where + getDeps :: c -> [FilePath] + data Language = French | English deriving (Generic) data Document = Document FilePath deriving (Generic, Show) +instance HasDependencies Document where + getDeps (Document fp) = [fp] + instance FromJSON Document where parseJSON v = Document <$> parseJSON v @@ -21,6 +28,10 @@ , documents :: [Document] } deriving (Generic, Show) + +instance HasDependencies Chapter where + getDeps (Chapter _ docs) = docs >>= getDeps + instance FromJSON Chapter where parseJSON (Object v) = Chapter <$> v .:? "title" <*> v .: "documents" @@ -29,13 +40,20 @@ , chapters :: [Chapter] } deriving (Generic, Show) + instance FromJSON Part where parseJSON (Object v) = Part <$> v .: "title" <*> v .: "chapters" +instance HasDependencies Part where + getDeps (Part _ chaps) = chaps >>= getDeps + data Manuscript = Manuscript [Part] deriving (Generic, Show) +instance HasDependencies Manuscript where + getDeps (Manuscript parts) = parts >>= getDeps + instance FromJSON Manuscript where parseJSON v = Manuscript <$> parseJSON v @@ -48,17 +66,36 @@ show English = "english" show French = "french" -data Novel = Novel { author :: String - , language :: Language - , novelTitle :: String - , manuscript :: Manuscript } +data Novel = Novel { author :: String + , language :: Language + , novelTitle :: String + , frontmatter :: Maybe [Chapter] + , manuscript :: Manuscript + , appendix :: Maybe [Chapter] + } deriving (Generic, Show) +instance HasDependencies Novel where + getDeps (Novel _ _ _ mfrontmatter man mappendix) = + (frontmatter >>= getDeps) + `mappend` (getDeps man) + `mappend` (appendix >>= getDeps) + where frontmatter = maybe [] id mfrontmatter + appendix = maybe [] id mappendix + instance FromJSON Novel where parseJSON (Object v) = Novel <$> v .: "author" <*> v .: "language" <*> v .: "title" + <*> v .:? "frontmatter" <*> v .: "manuscript" + <*> v .:? "appendix" -getNovelStructure :: FilePath -> IO (Maybe Novel) -getNovelStructure = decodeFile +getNovelStructure :: FilePath -> IO (Either String Novel) +getNovelStructure conf = do + ec <- decodeFileEither conf + case ec of + Right novel -> + pure (Right novel) + Left ex -> do + pure (Left $ prettyPrintParseException ex)