------------------------------------------------------------------------------
-- |
-- Module      : QueueSheet.Template
-- Description : queue sheet template functions
-- Copyright   : Copyright (c) 2020-2022 Travis Cardwell
-- License     : MIT
------------------------------------------------------------------------------

{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module QueueSheet.Template
  ( -- * API
    loadTemplate
  , renderTemplate
  ) where

-- https://hackage.haskell.org/package/base
import Data.Bifunctor (first)
#if !MIN_VERSION_base (4,11,0)
import Data.Monoid ((<>))
#endif
import qualified System.IO as IO

-- https://hackage.haskell.org/package/ginger
import qualified Text.Ginger as Ginger
import Text.Ginger ((~>))

-- https://hackage.haskell.org/package/text
import Data.Text (Text)
import qualified Data.Text.IO as TIO

-- https://hackage.haskell.org/package/transformers
import Control.Monad.Trans.Writer (Writer)

-- (queue-sheet)
import QueueSheet.Types
  ( Date, Item, Name
  , Queue
      ( Queue, queueDate, queueItems, queueName, queueSection, queueTags
      , queueUrl
      )
  , QueueSheet(QueueSheet, qsQueues, qsSections), Section, Tag(Tag), Url
  )

------------------------------------------------------------------------------
-- $QueueCtx

-- | Queue context
data QueueCtx
  = QueueCtx
    { QueueCtx -> Name
name      :: !Name
    , QueueCtx -> Maybe Url
url       :: !(Maybe Url)
    , QueueCtx -> Maybe Date
date      :: !(Maybe Date)
    , QueueCtx -> [Tag]
tags      :: ![Tag]
    , QueueCtx -> Maybe Item
prevItem  :: !(Maybe Item)
    , QueueCtx -> [Item]
nextItems :: ![Item]
    }

instance Ginger.ToGVal m QueueCtx where
  toGVal :: QueueCtx -> GVal m
toGVal QueueCtx{[Item]
[Tag]
Maybe Item
Maybe Date
Maybe Url
Name
nextItems :: [Item]
prevItem :: Maybe Item
tags :: [Tag]
date :: Maybe Date
url :: Maybe Url
name :: Name
nextItems :: QueueCtx -> [Item]
prevItem :: QueueCtx -> Maybe Item
tags :: QueueCtx -> [Tag]
date :: QueueCtx -> Maybe Date
url :: QueueCtx -> Maybe Url
name :: QueueCtx -> Name
..} = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
Ginger.dict ([Pair m] -> GVal m) -> [Pair m] -> GVal m
forall a b. (a -> b) -> a -> b
$
    [ Text
"name"       Text -> Name -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Name
name
    , Text
"url"        Text -> Maybe Url -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Maybe Url
url
    , Text
"date"       Text -> Maybe Date -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Maybe Date
date
    , Text
"prev_item"  Text -> Maybe Item -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Maybe Item
prevItem
    , Text
"next_items" Text -> [Item] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [Item]
nextItems
    ] [Pair m] -> [Pair m] -> [Pair m]
forall a. [a] -> [a] -> [a]
++ [(Text
"tag_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tag) Text -> Bool -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Bool
True | Tag Text
tag <- [Tag]
tags]

-- | Construct a queue context
queueCtx :: Queue -> QueueCtx
queueCtx :: Queue -> QueueCtx
queueCtx Queue{[Tag]
Maybe (Either Item [Item])
Maybe Date
Maybe Url
Section
Name
queueItems :: Maybe (Either Item [Item])
queueTags :: [Tag]
queueSection :: Section
queueDate :: Maybe Date
queueUrl :: Maybe Url
queueName :: Name
queueUrl :: Queue -> Maybe Url
queueTags :: Queue -> [Tag]
queueSection :: Queue -> Section
queueName :: Queue -> Name
queueItems :: Queue -> Maybe (Either Item [Item])
queueDate :: Queue -> Maybe Date
..} = QueueCtx :: Name
-> Maybe Url
-> Maybe Date
-> [Tag]
-> Maybe Item
-> [Item]
-> QueueCtx
QueueCtx
    { name :: Name
name      = Name
queueName
    , url :: Maybe Url
url       = Maybe Url
queueUrl
    , date :: Maybe Date
date      = Maybe Date
queueDate
    , tags :: [Tag]
tags      = [Tag]
queueTags
    , prevItem :: Maybe Item
prevItem  = (Item -> Maybe Item)
-> ([Item] -> Maybe Item) -> Either Item [Item] -> Maybe Item
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Item -> Maybe Item
forall a. a -> Maybe a
Just (Maybe Item -> [Item] -> Maybe Item
forall a b. a -> b -> a
const Maybe Item
forall a. Maybe a
Nothing) (Either Item [Item] -> Maybe Item)
-> Maybe (Either Item [Item]) -> Maybe Item
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Either Item [Item])
queueItems
    , nextItems :: [Item]
nextItems = [Item]
-> (Either Item [Item] -> [Item])
-> Maybe (Either Item [Item])
-> [Item]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Item -> [Item])
-> ([Item] -> [Item]) -> Either Item [Item] -> [Item]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Item] -> Item -> [Item]
forall a b. a -> b -> a
const []) [Item] -> [Item]
forall a. a -> a
id) Maybe (Either Item [Item])
queueItems
    }

------------------------------------------------------------------------------
-- $SectionCtx

-- | Section context
newtype SectionCtx = SectionCtx (Section, [QueueCtx])

instance Ginger.ToGVal m SectionCtx where
  toGVal :: SectionCtx -> GVal m
toGVal (SectionCtx (Section
section, [QueueCtx]
queues)) = [Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
Ginger.dict
    [ Text
"name"   Text -> Section -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Section
section
    , Text
"queues" Text -> [QueueCtx] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [QueueCtx]
queues
    ]

-- | Check if a section context has any queues
sectionCtxHasQueues :: SectionCtx -> Bool
sectionCtxHasQueues :: SectionCtx -> Bool
sectionCtxHasQueues (SectionCtx (Section
_, [])) = Bool
False
sectionCtxHasQueues SectionCtx
_                    = Bool
True

------------------------------------------------------------------------------
-- $Context

-- | Template context
newtype Context = Context [SectionCtx]
  deriving newtype (Ginger.ToGVal m)

-- | Template context constructor
context :: [Section] -> [Queue] -> Context
context :: [Section] -> [Queue] -> Context
context [Section]
sections [Queue]
queues = [SectionCtx] -> Context
Context ([SectionCtx] -> Context) -> [SectionCtx] -> Context
forall a b. (a -> b) -> a -> b
$ (SectionCtx -> Bool) -> [SectionCtx] -> [SectionCtx]
forall a. (a -> Bool) -> [a] -> [a]
filter SectionCtx -> Bool
sectionCtxHasQueues
    [ (Section, [QueueCtx]) -> SectionCtx
SectionCtx
        ( Section
section
        , [ Queue -> QueueCtx
queueCtx Queue
queue
          | Queue
queue <- [Queue]
queues, Queue -> Section
queueSection Queue
queue Section -> Section -> Bool
forall a. Eq a => a -> a -> Bool
== Section
section
          ]
        )
    | Section
section <- [Section]
sections
    ]

-- | Create a Ginger context from a template context
gingerContext
  :: Context
  -> Ginger.GingerContext Ginger.SourcePos (Writer Text) Text
gingerContext :: Context -> GingerContext SourcePos (Writer Text) Text
gingerContext Context
ctx = (Text -> GVal (Run SourcePos (Writer Text) Text))
-> GingerContext SourcePos (Writer Text) Text
forall p.
(Text -> GVal (Run p (Writer Text) Text))
-> GingerContext p (Writer Text) Text
Ginger.makeContextText ((Text -> GVal (Run SourcePos (Writer Text) Text))
 -> GingerContext SourcePos (Writer Text) Text)
-> (Text -> GVal (Run SourcePos (Writer Text) Text))
-> GingerContext SourcePos (Writer Text) Text
forall a b. (a -> b) -> a -> b
$ \case
    Text
"sections" -> Context -> GVal (Run SourcePos (Writer Text) Text)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
Ginger.toGVal Context
ctx
    Text
_          -> Maybe Text -> GVal (Run SourcePos (Writer Text) Text)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
Ginger.toGVal (Maybe Text
forall a. Maybe a
Nothing :: Maybe Text)

------------------------------------------------------------------------------
-- $API

-- | Load a Ginger template
--
-- @since 0.3.0.0
loadTemplate
  :: FilePath
  -> IO (Either String (Ginger.Template Ginger.SourcePos))
loadTemplate :: FilePath -> IO (Either FilePath (Template SourcePos))
loadTemplate FilePath
path = (ParserError -> FilePath)
-> Either ParserError (Template SourcePos)
-> Either FilePath (Template SourcePos)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParserError -> FilePath
formatError (Either ParserError (Template SourcePos)
 -> Either FilePath (Template SourcePos))
-> IO (Either ParserError (Template SourcePos))
-> IO (Either FilePath (Template SourcePos))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserOptions IO
-> FilePath -> IO (Either ParserError (Template SourcePos))
forall (m :: * -> *).
Monad m =>
ParserOptions m
-> FilePath -> m (Either ParserError (Template SourcePos))
Ginger.parseGingerFile' ParserOptions IO
options FilePath
path
  where
    options :: Ginger.ParserOptions IO
    options :: ParserOptions IO
options = ParserOptions :: forall (m :: * -> *).
IncludeResolver m
-> Maybe FilePath
-> Bool
-> Bool
-> Bool
-> Delimiters
-> ParserOptions m
Ginger.ParserOptions
      { poIncludeResolver :: IncludeResolver IO
poIncludeResolver     = (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (IO FilePath -> IO (Maybe FilePath))
-> (FilePath -> IO FilePath) -> IncludeResolver IO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
IO.readFile
      , poSourceName :: Maybe FilePath
poSourceName          = Maybe FilePath
forall a. Maybe a
Nothing
      , poKeepTrailingNewline :: Bool
poKeepTrailingNewline = Bool
False
      , poLStripBlocks :: Bool
poLStripBlocks        = Bool
False
      , poTrimBlocks :: Bool
poTrimBlocks          = Bool
False
      , poDelimiters :: Delimiters
poDelimiters          = Delimiters :: FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> Delimiters
Ginger.Delimiters
          { delimOpenInterpolation :: FilePath
delimOpenInterpolation  = FilePath
"<<"
          , delimCloseInterpolation :: FilePath
delimCloseInterpolation = FilePath
">>"
          , delimOpenTag :: FilePath
delimOpenTag            = FilePath
"<!"
          , delimCloseTag :: FilePath
delimCloseTag           = FilePath
"!>"
          , delimOpenComment :: FilePath
delimOpenComment        = FilePath
"<#"
          , delimCloseComment :: FilePath
delimCloseComment       = FilePath
"#>"
          }
      }

    formatError :: Ginger.ParserError -> String
    formatError :: ParserError -> FilePath
formatError ParserError
err = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ FilePath
"error loading template: "
      , FilePath -> (SourcePos -> FilePath) -> Maybe SourcePos -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
path SourcePos -> FilePath
forall a. Show a => a -> FilePath
show (Maybe SourcePos -> FilePath) -> Maybe SourcePos -> FilePath
forall a b. (a -> b) -> a -> b
$ ParserError -> Maybe SourcePos
Ginger.peSourcePosition ParserError
err
      , FilePath
": "
      , ParserError -> FilePath
Ginger.peErrorMessage ParserError
err
      ]

-- | Render a template using the given context
--
-- @since 0.3.0.0
renderTemplate
  :: FilePath
  -> Ginger.Template Ginger.SourcePos
  -> QueueSheet
  -> IO ()
renderTemplate :: FilePath -> Template SourcePos -> QueueSheet -> IO ()
renderTemplate FilePath
path Template SourcePos
template QueueSheet{[Queue]
[Section]
qsQueues :: [Queue]
qsSections :: [Section]
qsSections :: QueueSheet -> [Section]
qsQueues :: QueueSheet -> [Queue]
..} =
    let ctx :: GingerContext SourcePos (Writer Text) Text
ctx = Context -> GingerContext SourcePos (Writer Text) Text
gingerContext (Context -> GingerContext SourcePos (Writer Text) Text)
-> Context -> GingerContext SourcePos (Writer Text) Text
forall a b. (a -> b) -> a -> b
$ [Section] -> [Queue] -> Context
context [Section]
qsSections [Queue]
qsQueues
    in  FilePath -> Text -> IO ()
TIO.writeFile FilePath
path (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ GingerContext SourcePos (Writer Text) Text
-> Template SourcePos -> Text
forall p h.
(ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p,
 Monoid h) =>
GingerContext p (Writer h) h -> Template p -> h
Ginger.runGinger GingerContext SourcePos (Writer Text) Text
ctx Template SourcePos
template