celtchar-0.1.4.0: app/Main.hs

{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeSynonymInstances #-}

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)
import           System.Exit              (exitFailure)
import           System.FilePath          (takeDirectory, (</>))
import           System.IO                (Handle, IOMode (..), hClose,
                                           hPutStrLn, openFile, stderr, stdout)

import           Celtchar.Novel
import           Celtchar.Novel.Structure

data Command =
    Build { root   :: FilePath
          , output :: Maybe FilePath
          }
  | Deps { root :: FilePath
         }
  | New 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

    case cmd of
      Build conf out -> do
        f <- getNovelStructure conf

        let inDir = takeDirectory $ root cmd
            outDir = takeDirectory $ fromMaybe "." out
        rootDir <- getCurrentDirectory

        -- write the final tex file
        setCurrentDirectory inDir

        case f of Right x  -> do
                    res <- stringify (language x) (novelify x)

                    setCurrentDirectory rootDir
                    h <- getOutputHandle $ output cmd
                    T.hPutStr h res
                    hClose h

                    T.writeFile (outDir </> "ogma.sty") $(embedStringFile "assets/ogma.sty")
                  Left err -> do
                    hPutStrLn stderr err
                    exitFailure
      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)