Template.hs

-- | Defines document template
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.PDF.Slave.Template(
    TemplateName
  , TemplateInput
  , TemplateBody
  , TemplateBibtex
  , DependencyBody
  , BibTexBody
  , TemplateDependency(..)
  , Template(..)
  , TemplateDependencyFile(..)
  , TemplateFile(..)
  -- * Helpers
  , loadTemplateInMemory
  , storeTemplateInFiles
  ) where

import Control.Monad (mzero)
import Data.ByteString (ByteString)
import Data.Monoid
import Data.Text as T
import Data.Yaml
import Filesystem.Path.CurrentOS (directory)
import GHC.Generics
import Prelude hiding (FilePath)
import Shelly as Sh

import qualified Data.Aeson             as A
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy   as BZ
import qualified Data.Map.Strict        as M
import qualified Data.Text.Encoding     as T

-- | Template unique name
type TemplateName = Text

-- | A template takes simple YAML document as input
type TemplateInput = Value

-- | Template body is text with .htex content
type TemplateBody = Text

-- | Template can define additional bibtex database
type TemplateBibtex = Text

-- | Dependency can be a binary file
type DependencyBody = ByteString

-- | Content of bibtex file
type BibTexBody = Text

-- | Template has different types of dependencies, each type of the dependecy
-- has own affect on rendering pipe.
data TemplateDependency =
  -- | Bibtex file for references to other documents. Need call to bibtex
    BibtexDep BibTexBody
  -- | HTex file that need to be compiled to .tex file
  | TemplateDep Template
  -- | HTex file that need to be compiled to .pdf file
  | TemplatePdfDep Template
  -- | Any other file that doesn't need a compilation (listings, images, etc)
  | OtherDep DependencyBody
  deriving (Generic, Show)

instance FromJSON TemplateDependency where
  parseJSON val@(Object o) = do
    depType <- o .: "type"
    case T.toLower . T.strip $ depType of
      "bibtex"       -> BibtexDep       <$> o .: "body"
      "template"     -> TemplateDep     <$> parseJSON val
      "template_pdf" -> TemplatePdfDep  <$> parseJSON val
      "other"        -> do
        (t :: Text) <- o .: "body"
        either (\e -> fail $ "Cannot decode dependency body (base64): " <> e) (return . OtherDep) $
          B64.decode . T.encodeUtf8 $ t
      _ -> fail $ "Unknown template type " <> unpack depType
  parseJSON _ = mzero

instance ToJSON TemplateDependency where
  toJSON d = case d of
    BibtexDep body -> object [
        "type" .= ("bibtex" :: Text)
      , "body" .= body
      ]
    TemplateDep body -> let
      Object o1 = object [ "type" .= ("template" :: Text) ]
      Object o2 = toJSON body
      in Object (o1 <> o2)
    TemplatePdfDep body -> let
      Object o1 = object [ "type" .= ("template_pdf" :: Text) ]
      Object o2 = toJSON body
      in Object (o1 <> o2)
    OtherDep bs -> object [
        "type" .= ("other" :: Text)
      , "body" .= (T.decodeUtf8 . B64.encode $ bs)
      ]

-- | Description of document template
data Template = Template {
  -- | Template has human readable name
    templateName          :: TemplateName
  -- | Template expects input in YAML format
  , templateInput         :: Maybe TemplateInput
  -- | Template contents
  , templateBody          :: TemplateBody
  -- | Template dependencies (bibtex, listings, other htex files)
  , templateDeps          :: M.Map TemplateName TemplateDependency
  -- | Additional flags for `haskintex`
  , templateHaskintexOpts :: [Text]
  } deriving (Generic, Show)

instance FromJSON Template where
  parseJSON (Object o) = Template
    <$> o .: "name"
    <*> o .:? "input"
    <*> o .: "body"
    <*> o .:? "dependencies" .!= mempty
    <*> o .:? "haskintex-opts" .!= mempty
  parseJSON _ = mzero

instance ToJSON Template where
  toJSON Template{..} = object [
      "name"           .= templateName
    , "input"          .= templateInput
    , "body"           .= templateBody
    , "dependencies"   .= templateDeps
    , "haskintex-opts" .= templateHaskintexOpts
    ]

-- | Same as 'TemplateDependency' but keeps contents in separate files
data TemplateDependencyFile =
  -- | Bibtex file for references to other documents. Need call to bibtex.
  -- Name of dependency is a filename with contents.
    BibtexDepFile
  -- | HTex file that need to be compiled to .tex file
  -- Name of dependency defines a subfolder for the template.
  | TemplateDepFile TemplateFile
  -- | HTex file that need to be compiled to .pdf file
  -- Name of dependency deinfes a subfolder for the template.
  | TemplatePdfDepFile TemplateFile
  -- | Any other file that doesn't need a compilation (listings, images, etc)
  -- Name of dependency is a filename with contents.
  | OtherDepFile
  deriving (Generic, Show)

instance FromJSON FilePath where
  parseJSON (String s) = return $ Sh.fromText s
  parseJSON _ = mzero

instance ToJSON FilePath where
  toJSON = String . Sh.toTextIgnore

instance FromJSON TemplateDependencyFile where
  parseJSON val@(Object o) = do
    depType <- o .: "type"
    case T.toLower . T.strip $ depType of
      "bibtex"       -> pure BibtexDepFile
      "template"     -> TemplateDepFile     <$> parseJSON val
      "template_pdf" -> TemplatePdfDepFile  <$> parseJSON val
      "other"        -> pure OtherDepFile
      _ -> fail $ "Unknown template type " <> unpack depType
  parseJSON _ = mzero

instance ToJSON TemplateDependencyFile where
  toJSON d = case d of
    BibtexDepFile -> object [
        "type" .= ("bibtex" :: Text)
      ]
    TemplateDepFile body -> let
      Object o1 = object [ "type" .= ("template" :: Text) ]
      Object o2 = toJSON body
      in Object (o1 <> o2)
    TemplatePdfDepFile body -> let
      Object o1 = object [ "type" .= ("template_pdf" :: Text) ]
      Object o2 = toJSON body
      in Object (o1 <> o2)
    OtherDepFile -> object [
        "type" .= ("other" :: Text)
      ]

-- | Same as 'Template', but holds info about template content and dependencies
-- in other files.
data TemplateFile = TemplateFile {
  -- | Template has human readable name
    templateFileName      :: TemplateName
  -- | Template expects input in JSON format. The field contains filename of the YAML file.
  , templateFileInput     :: Maybe FilePath
  -- | Template contents filename.
  , templateFileBody      :: FilePath
  -- | Template dependencies (bibtex, listings, other htex files)
  , templateFileDeps      :: M.Map TemplateName TemplateDependencyFile
  -- | Additional flags for `haskintex`
  , templateFileHaskintexOpts :: [Text]
  } deriving (Generic, Show)

instance FromJSON TemplateFile where
  parseJSON (Object o) = TemplateFile
    <$> o .: "name"
    <*> o .:? "input"
    <*> o .: "body"
    <*> o .:? "dependencies" .!= mempty
    <*> o .:? "haskintex-opts" .!= mempty
  parseJSON _ = mzero

instance ToJSON TemplateFile where
  toJSON TemplateFile{..} = object [
      "name"           .= templateFileName
    , "input"          .= templateFileInput
    , "body"           .= templateFileBody
    , "dependencies"   .= templateFileDeps
    , "haskintex-opts" .= templateFileHaskintexOpts
    ]

-- | Load all external references of template into memory
loadTemplateInMemory :: TemplateFile -> Sh (Either String Template)
loadTemplateInMemory TemplateFile{..} = do
  inputCnt <- case templateFileInput of
    Nothing -> return $ Right Nothing
    Just fname -> do
      cnt <- readBinary fname
      return $ fmap Just . A.eitherDecode' . BZ.fromStrict $ cnt
  body <- readfile templateFileBody
  deps <- M.traverseWithKey loadDep templateFileDeps
  return $ Template
    <$> pure templateFileName
    <*> inputCnt
    <*> pure body
    <*> sequence deps
    <*> pure templateFileHaskintexOpts
  where
    loadDep name d = let
      filename = fromText name
      in case d of
        BibtexDepFile -> do
          cnt <- readfile filename
          return . pure $ BibtexDep cnt
        TemplateDepFile body -> do
          tmpl <- chdir filename $ loadTemplateInMemory body
          return $ TemplateDep <$> tmpl
        TemplatePdfDepFile body -> do
          tmpl <- chdir filename $ loadTemplateInMemory body
          return $ TemplatePdfDep <$> tmpl
        OtherDepFile -> do
          cnt <- readBinary filename
          return . pure $ OtherDep cnt

-- | Extract all external references of template into file system
storeTemplateInFiles :: Template -> FilePath -> Sh TemplateFile
storeTemplateInFiles Template{..} folder = do
  mkdir_p folder
  relInputName <- case templateInput of
    Nothing -> return Nothing
    Just input -> do
      let inputName = folder </> (templateName <> "_input") <.> "json"
      writeBinary inputName $ BZ.toStrict $ A.encode input
      fmap Just $ relativeTo folder inputName
  let bodyName = folder </> templateName <.> "htex"
  mkdir_p $ directory bodyName
  writefile bodyName templateBody
  relBodyName <- relativeTo folder bodyName
  deps <- M.traverseWithKey storeDep templateDeps
  return $ TemplateFile {
      templateFileName = templateName
    , templateFileInput = relInputName
    , templateFileBody = relBodyName
    , templateFileDeps = deps
    , templateFileHaskintexOpts = templateHaskintexOpts
    }
  where
    storeDep name d = case d of
      BibtexDep body -> do
        let bodyName = folder </> name
        mkdir_p $ directory bodyName
        writefile bodyName body
        return BibtexDepFile
      TemplateDep template -> do
        let subfolderName = folder </> Sh.fromText name
        mkdir_p subfolderName
        dep <- storeTemplateInFiles template subfolderName
        return $ TemplateDepFile dep
      TemplatePdfDep template -> do
        let subfolderName = folder </> Sh.fromText name
        mkdir_p subfolderName
        dep <- storeTemplateInFiles template subfolderName
        return $ TemplatePdfDepFile dep
      OtherDep body -> do
        let bodyName = folder </> name
        mkdir_p $ directory bodyName
        writeBinary bodyName body
        return OtherDepFile