celtchar (empty) → 0.1.0.0

raw patch · 9 files changed

+386/−0 lines, 9 filesdep +basedep +celtchardep +directorysetup-changed

Dependencies added: base, celtchar, directory, file-embed, filepath, hspec, megaparsec, mtl, ogmarkup, optparse-generic, pandoc, raw-strings-qq, shakespeare, text, yaml

Files

LICENSE +21/−0
Setup.hs +2/−0
app/Main.hs +56/−0
celtchar.cabal +59/−0
src/Celtchar/Metadata.hs +29/−0
src/Celtchar/Novel.hs +107/−0
src/Celtchar/Novel/Ogmarkup.hs +47/−0
src/Celtchar/Novel/Structure.hs +64/−0
test/Spec.hs +1/−0

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Thomas Letan++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Options.Generic+import Data.Text (unpack)+import System.IO (stderr, stdout, Handle, IOMode(..), openFile, hClose)+import System.FilePath (takeDirectory, (</>))+import System.Directory (setCurrentDirectory, getCurrentDirectory)+import qualified Data.Text.IO as T+import Data.FileEmbed++import Celtchar.Novel.Structure+import Celtchar.Novel++data Command =+    Command { root   :: FilePath+            , output :: Maybe FilePath+            }+  deriving (Generic, Show)++instance ParseRecord Command++getOutputHandle :: Maybe FilePath -> IO Handle+getOutputHandle Nothing = pure stdout+getOutputHandle (Just target) = openFile target WriteMode++main :: IO ()+main = do+    cmd <- getRecord "celtchar" :: IO Command++    let conf = root cmd+    h <- getOutputHandle $ output 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 f of Just x  -> do res <- stringify (language x) (novelify x)+                            T.hPutStr h res+              Nothing -> T.hPutStrLn stderr "error while parsing"++    hClose h++    -- write the sty file+    setCurrentDirectory rootDir++    T.writeFile (outDir </> "ogma.sty") $(embedStringFile "ogma.sty")

+ celtchar.cabal view

@@ -0,0 +1,59 @@+name:                celtchar+version:             0.1.0.0+synopsis:            A tool to build a novel+description:         Please see README.md+homepage:            https://github.com/ogma-project/celtchar#readme+license:             MIT+license-file:        LICENSE+author:              Thomas Letan+maintainer:          contact@thomasletan.fr+copyright:           2016 Thomas Letan+category:            Text+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Celtchar.Metadata+                     , Celtchar.Novel.Structure+                     , Celtchar.Novel+                     , Celtchar.Novel.Ogmarkup+  build-depends:       base             >= 4.7  && < 5+                     , ogmarkup         >= 3    && < 4+                     , yaml             >= 0.8  && < 0.9+                     , mtl              >= 2.2  && < 2.3+                     , filepath         >= 1.4  && < 1.5+                     , text             >= 1.2  && < 1.3+                     , pandoc           >= 1.19 && < 1.20+                     , shakespeare      >= 2.0  && < 2.1+                     , megaparsec       >= 5.2  && < 5.3+  default-language:    Haskell2010++executable celtchar+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base             >= 4.7    && < 5+                     , optparse-generic >= 1.1    && < 1.2+                     , text             >= 1.2    && < 1.3+                     , file-embed       >= 0.0.10 && < 0.1+                     , filepath         >= 1.4    && < 1.5+                     , directory        >= 1.3    && < 1.4+                     , celtchar+  default-language:    Haskell2010++test-suite celtchar-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base             >= 4.7  && < 5+                     , raw-strings-qq   >= 1.1 && < 1.2+                     , hspec            >= 2.4 && < 2.5+                     , celtchar+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/ogma-project/celtchar

+ src/Celtchar/Metadata.hs view

@@ -0,0 +1,29 @@+{-# LANGUAGE TypeFamilies #-}++module Celtchar.Metadata+  ( parseMetadata+  ) where++import Text.Megaparsec+import Data.String++parseMetadata :: (Stream a, Token a ~ Char, IsString b)+              => String+              -> a+              -> Either (ParseError Char Dec) (Maybe b, b)+parseMetadata = runParser (do+    metadata <- (try metadata) <|> (return Nothing)+    text <- manyTill anyChar eof+    return (metadata, fromString text))++  where+    metadata = do+      space+      some $ char '-'+      char '\n'+      space+      m <- manyTill anyChar (try $ do char '\n'+                                      some $ char '-'+                                      char '\n')+      space+      return $ Just $ fromString m

+ src/Celtchar/Novel.hs view

@@ -0,0 +1,107 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Celtchar.Novel where++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+import           Text.Pandoc.Writers.LaTeX+import           Text.Shakespeare.Text++import           Celtchar.Metadata+import           Celtchar.Novel.Ogmarkup+import           Celtchar.Novel.Structure++type Builder = StateT Text (ReaderT Language IO)++getLanguage :: Builder Language+getLanguage = lift $ ask++append :: Text -> Builder ()+append str = do st <- get+                put (st `mappend` str)++appendLn :: Text -> Builder ()+appendLn str = do append str+                  append "\n"++stringify :: Language -> Builder () -> IO Text+stringify lang builder = runReaderT (execStateT builder "") lang++class Novelify a where+    novelify :: a -> Builder ()++instance (Novelify a) => Novelify [a] where+    novelify (a:r) = do novelify a+                        novelify r+    novelify [] = return ()++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 lang txt+                                                            ".tex" -> txt+                                                            ".md"  -> parseMd f txt+                                                            _      -> verbatim txt+        Left _                -> appendLn $ "error while parsing " `mappend` (fromString path :: Text)+      where+        verbatim txt = [st|\begin{verbatim}+#{txt}+\end{verbatim}|]++instance Novelify Chapter where+    novelify c = do+      appendLn $ [st|\chapter{#{maybe "" id $ chapterTitle c}}|]+      novelify $ documents c++instance Novelify Part where+    novelify p = do+      appendLn $ [st|\part{#{partTitle p}}|]+      novelify $ chapters p++instance Novelify Manuscript where+    novelify (Manuscript m) = do+      append "\\mainmatter\n"+      novelify m++instance Novelify Novel where+    novelify n = do+      appendLn [st|\documentclass[b5paper,12pt]{memoir}+\usepackage[#{show $ language n}]{babel}+\usepackage[T1]{fontenc}+\usepackage[utf8]{inputenc}+\usepackage[urw-garamond]{mathdesign}+\usepackage{ogma}+\sloppy+\title{#{novelTitle n}}+\author{#{author n}}+\begin{document}+\maketitle|]+      novelify $ manuscript n+      append "\\end{document}"++parseMd :: Text+        -> Text+        -> Text+parseMd file txt = case readMarkdown ropts (unpack txt) of Right pdc -> pack $ writeLaTeX wopts pdc+                                                           Left _    -> [st|error while compiling #{file}|]+    where ropts :: ReaderOptions+          ropts = def++          wopts :: WriterOptions+          wopts = def

+ src/Celtchar/Novel/Ogmarkup.hs view

@@ -0,0 +1,47 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Celtchar.Novel.Ogmarkup where++import Text.Ogmarkup+import Data.Text (Text, append)+import Data.String+import Text.Shakespeare.Text++import Celtchar.Novel.Structure (Language(..))++data NovConf = NovConf Language++el :: Text+el = "\n\n"++blk :: Text+    -> Text+blk = (`append` el)++instance GenConf NovConf Text where+    typography (NovConf French) = frenchTypo+    typography (NovConf English) = englishTypo++    printSpace _ None = ""+    printSpace _ Normal = " "+    printSpace _ Nbsp = "~"++    betweenDialogue _ = el++    storyTemplate _ sec = blk [st|\paragraph{} #{sec}|]++    paragraphTemplate _ = blk++    dialogueTemplate _ _ txt = [st|\dialogue{}#{txt}|]+    thoughtTemplate _ _ txt = [st|\thought{}#{txt}|]+    replyTemplate _ txt = [st|\reply{#{txt}}|]++    strongEmphTemplate _ txt = [st|\textbf{#{txt}}|]+    emphTemplate _ txt = [st|\textit{#{txt}}|]++parseDoc :: Language -> Text -> Text+parseDoc lang doc = ogmarkup doc $ NovConf lang

+ src/Celtchar/Novel/Structure.hs view

@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}++module Celtchar.Novel.Structure where++import Data.Yaml+import GHC.Generics++data Language = French | English+  deriving (Generic)++data Document = Document FilePath+  deriving (Generic, Show)++instance FromJSON Document where+    parseJSON v = Document <$> parseJSON v++data Chapter = Chapter { chapterTitle :: Maybe String+                       , documents    :: [Document]+                       }+  deriving (Generic, Show)+instance FromJSON Chapter where+    parseJSON (Object v) = Chapter <$> v .:? "title"+                                   <*> v .: "documents"++data Part = Part { partTitle :: String+                 , chapters  :: [Chapter]+                 }+  deriving (Generic, Show)+instance FromJSON Part where+    parseJSON (Object v) = Part <$> v .: "title"+                                <*> v .: "chapters"++data Manuscript = Manuscript [Part]+  deriving (Generic, Show)++instance FromJSON Manuscript where+    parseJSON v = Manuscript <$> parseJSON v++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"++getNovelStructure :: FilePath -> IO (Maybe Novel)+getNovelStructure = decodeFile

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}