packages feed

celtchar-0.1.2.0: app/Main.hs

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

module Main where

import Control.Monad (void)
import Options.Generic
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 =
    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
getOutputHandle Nothing = pure stdout
getOutputHandle (Just target) = openFile target WriteMode

main :: IO ()
main = do
    cmd <- getRecord "celtchar" :: IO Command

    let conf = getRoot cmd
    f <- getNovelStructure $ conf

    case cmd of
      Build _ out -> do
        let inDir = takeDirectory $ root cmd
            outDir = takeDirectory $ maybe "." id 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 _ ->
        case f of Right x ->
                    void $ mapM putStrLn (getDeps x)
                  Left err -> do
                    hPutStrLn stderr err
                    exitFailure