{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.PDF.Slave.Template(
TemplateName
, TemplateInput
, TemplateBody
, TemplateBibtex
, DependencyBody
, BibTexBody
, TemplateDependency(..)
, Template(..)
, TemplateDependencyFile(..)
, TemplateFile(..)
, 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
type TemplateName = Text
type TemplateInput = Value
type TemplateBody = Text
type TemplateBibtex = Text
type DependencyBody = ByteString
type BibTexBody = Text
data TemplateDependency =
BibtexDep BibTexBody
| TemplateDep Template
| TemplatePdfDep Template
| 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)
]
data Template = Template {
templateName :: TemplateName
, templateInput :: Maybe TemplateInput
, templateBody :: TemplateBody
, templateDeps :: M.Map TemplateName TemplateDependency
, 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
]
data TemplateDependencyFile =
BibtexDepFile
| TemplateDepFile TemplateFile
| TemplatePdfDepFile TemplateFile
| 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)
]
data TemplateFile = TemplateFile {
templateFileName :: TemplateName
, templateFileInput :: Maybe FilePath
, templateFileBody :: FilePath
, templateFileDeps :: M.Map TemplateName TemplateDependencyFile
, 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
]
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
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