{-# LANGUAGE FlexibleContexts              #-}
{-# LANGUAGE DataKinds                     #-}
{-# LANGUAGE PolyKinds                     #-}
{-# LANGUAGE GADTs                         #-}
{-# LANGUAGE TypeOperators                 #-}
{-# LANGUAGE ScopedTypeVariables           #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Knit.Effect.Html
Description : Polysemy writer effects for creating Lucid/Blaze documents
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

Create a Lucid or Blaze html document (using a Writer to intersperse html and other code) and then use the 'Knit.Haskell.Docs' <https://github.com/isovector/polysemy#readme polysemy> effect
to store that document for processing/output later.
-}
module Knit.Effect.Html
  (
    -- * Lucid

    -- ** Effects
    Lucid
  , LucidDocs

    -- ** Actions
  , lucid

    -- ** Intepretations
  , lucidToNamedText
  , lucidHtml
  , lucidToText
  , newLucidDoc

  -- * Blaze

  -- ** Effects
  , Blaze
  , BlazeDocs

  -- ** Actions
  , blaze

  -- ** Interpretations
  , blazeToNamedText
  , blazeHtml
  , blazeToText
  , newBlazeDoc

    -- * Re-exports
  , DocWithInfo(..)
  )
where

import qualified Polysemy                      as P
import qualified Polysemy.Writer               as P

import qualified Lucid                         as LH
import qualified Text.Blaze.Html               as BH
import qualified Text.Blaze.Html.Renderer.Text as BH
import qualified Data.Text.Lazy                as TL
import qualified Data.Text                     as T

import           Knit.Effect.Docs               ( Docs
                                                , DocWithInfo(..)
                                                , newDoc
                                                , toDocList
                                                )

-- For now, just handle the Html () case since then it's monoidal and we can interpret via writer
--newtype FreerHtml = FreerHtml { unFreer :: H.Html () }

-- | Type-Alias for a single Lucid document writer.
type Lucid = P.Writer (LH.Html ())

-- | Type-Alias for a single Blaze document writer.
type Blaze = P.Writer BH.Html

-- | Add a Lucid html fragment to the current Lucid doc.
lucid :: P.Member Lucid effs => LH.Html () -> P.Sem effs ()
lucid :: Html () -> Sem effs ()
lucid = Html () -> Sem effs ()
forall o (r :: [Effect]).
MemberWithError (Writer o) r =>
o -> Sem r ()
P.tell

-- | Add a Blaze html fragment to the current Blaze doc.
blaze :: P.Member Blaze effs => BH.Html -> P.Sem effs ()
blaze :: Html -> Sem effs ()
blaze = Html -> Sem effs ()
forall o (r :: [Effect]).
MemberWithError (Writer o) r =>
o -> Sem r ()
P.tell

-- | Type-Alias for the 'Knit.Effects.Docs' effect (multi-document Writer), specialized to Lucid docs.
-- To be used in an app that produces multiple html outputs, built up from Lucid bits.
type LucidDocs = Docs T.Text (LH.Html ())

-- | Type-Alias for the 'Knit.Effects.Docs' effect (multi-document Writer) specialized to Blaze docs.
-- To be used in an app that produces multiple html outputs, built up from Blaze bits.
type BlazeDocs = Docs T.Text BH.Html

-- | Take the current Lucid HTML in the writer and add it to the set of named docs with the given name.
-- NB: Only use this function for making sets of documents built exclusively from Lucid.  Otherwise use the more general Pandoc infrastructure in
-- 'Knit.Effects.Pandoc'.
newLucidDoc
  :: P.Member LucidDocs effs
  => T.Text
  -> P.Sem (Lucid ': effs) ()
  -> P.Sem effs ()
newLucidDoc :: Text -> Sem (Lucid : effs) () -> Sem effs ()
newLucidDoc n :: Text
n l :: Sem (Lucid : effs) ()
l = (((Html (), ()) -> Html ())
-> Sem effs (Html (), ()) -> Sem effs (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html (), ()) -> Html ()
forall a b. (a, b) -> a
fst (Sem effs (Html (), ()) -> Sem effs (Html ()))
-> Sem effs (Html (), ()) -> Sem effs (Html ())
forall a b. (a -> b) -> a -> b
$ Sem (Lucid : effs) () -> Sem effs (Html (), ())
forall o (r :: [Effect]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter Sem (Lucid : effs) ()
l) Sem effs (Html ()) -> (Html () -> Sem effs ()) -> Sem effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Html () -> Sem effs ()
forall i a (effs :: [Effect]).
Member (Docs i a) effs =>
i -> a -> Sem effs ()
newDoc Text
n

-- | take the current Blaze HTML in the writer and add it to the set of named docs with the given name
-- NB: Only use this function for making sets of documents built exclusively from Blaze. Otherwise use the more general Pandoc infrastructure in
-- 'Knit.Effects.Pandoc'.
newBlazeDoc
  :: P.Member BlazeDocs effs
  => T.Text
  -> P.Sem (Blaze ': effs) ()
  -> P.Sem effs ()
newBlazeDoc :: Text -> Sem (Blaze : effs) () -> Sem effs ()
newBlazeDoc n :: Text
n l :: Sem (Blaze : effs) ()
l = (((Html, ()) -> Html) -> Sem effs (Html, ()) -> Sem effs Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html, ()) -> Html
forall a b. (a, b) -> a
fst (Sem effs (Html, ()) -> Sem effs Html)
-> Sem effs (Html, ()) -> Sem effs Html
forall a b. (a -> b) -> a -> b
$ Sem (Blaze : effs) () -> Sem effs (Html, ())
forall o (r :: [Effect]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter Sem (Blaze : effs) ()
l) Sem effs Html -> (Html -> Sem effs ()) -> Sem effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Html -> Sem effs ()
forall i a (effs :: [Effect]).
Member (Docs i a) effs =>
i -> a -> Sem effs ()
newDoc Text
n

-- | Interpret the LucidDocs effect (via Writer), producing a list of named Lucid docs, suitable for writing to disk.
lucidToNamedText
  :: P.Sem (LucidDocs ': effs) () -> P.Sem effs [DocWithInfo T.Text TL.Text]
lucidToNamedText :: Sem (LucidDocs : effs) () -> Sem effs [DocWithInfo Text Text]
lucidToNamedText = ([DocWithInfo Text (Html ())] -> [DocWithInfo Text Text])
-> Sem effs [DocWithInfo Text (Html ())]
-> Sem effs [DocWithInfo Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DocWithInfo Text (Html ()) -> DocWithInfo Text Text)
-> [DocWithInfo Text (Html ())] -> [DocWithInfo Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Html () -> Text)
-> DocWithInfo Text (Html ()) -> DocWithInfo Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html () -> Text
forall a. Html a -> Text
LH.renderText)) (Sem effs [DocWithInfo Text (Html ())]
 -> Sem effs [DocWithInfo Text Text])
-> (Sem (LucidDocs : effs) ()
    -> Sem effs [DocWithInfo Text (Html ())])
-> Sem (LucidDocs : effs) ()
-> Sem effs [DocWithInfo Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (LucidDocs : effs) () -> Sem effs [DocWithInfo Text (Html ())]
forall i a (effs :: [Effect]).
Sem (Docs i a : effs) () -> Sem effs [DocWithInfo i a]
toDocList -- monad, list, NamedDoc itself

-- | Interpret the BlazeDocs effect (via Writer), producing a list of named Blaze docs.
blazeToNamedText
  :: P.Sem (BlazeDocs ': effs) () -> P.Sem effs [DocWithInfo T.Text TL.Text]
blazeToNamedText :: Sem (BlazeDocs : effs) () -> Sem effs [DocWithInfo Text Text]
blazeToNamedText = ([DocWithInfo Text Html] -> [DocWithInfo Text Text])
-> Sem effs [DocWithInfo Text Html]
-> Sem effs [DocWithInfo Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DocWithInfo Text Html -> DocWithInfo Text Text)
-> [DocWithInfo Text Html] -> [DocWithInfo Text Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Html -> Text) -> DocWithInfo Text Html -> DocWithInfo Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Text
BH.renderHtml)) (Sem effs [DocWithInfo Text Html]
 -> Sem effs [DocWithInfo Text Text])
-> (Sem (BlazeDocs : effs) () -> Sem effs [DocWithInfo Text Html])
-> Sem (BlazeDocs : effs) ()
-> Sem effs [DocWithInfo Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (BlazeDocs : effs) () -> Sem effs [DocWithInfo Text Html]
forall i a (effs :: [Effect]).
Sem (Docs i a : effs) () -> Sem effs [DocWithInfo i a]
toDocList -- monad, list, NamedDoc itself

-- | Interprest the Lucid effect (via Writer), producing a Lucid @Html ()@ from the currently written doc
lucidHtml :: P.Sem (Lucid ': effs) () -> P.Sem effs (LH.Html ())
lucidHtml :: Sem (Lucid : effs) () -> Sem effs (Html ())
lucidHtml = ((Html (), ()) -> Html ())
-> Sem effs (Html (), ()) -> Sem effs (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html (), ()) -> Html ()
forall a b. (a, b) -> a
fst (Sem effs (Html (), ()) -> Sem effs (Html ()))
-> (Sem (Lucid : effs) () -> Sem effs (Html (), ()))
-> Sem (Lucid : effs) ()
-> Sem effs (Html ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Lucid : effs) () -> Sem effs (Html (), ())
forall o (r :: [Effect]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter

-- | Interpret the Lucid effect (via Writer), producing @Text@ from the currently written doc
lucidToText :: P.Sem (Lucid ': effs) () -> P.Sem effs TL.Text
lucidToText :: Sem (Lucid : effs) () -> Sem effs Text
lucidToText = (Html () -> Text) -> Sem effs (Html ()) -> Sem effs Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html () -> Text
forall a. Html a -> Text
LH.renderText (Sem effs (Html ()) -> Sem effs Text)
-> (Sem (Lucid : effs) () -> Sem effs (Html ()))
-> Sem (Lucid : effs) ()
-> Sem effs Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Lucid : effs) () -> Sem effs (Html ())
forall (effs :: [Effect]).
Sem (Lucid : effs) () -> Sem effs (Html ())
lucidHtml

-- | Interpret the Blaze effect (via Writer), producing a Blaze @Html@ from the currently written doc.
blazeHtml :: P.Sem (Blaze ': effs) () -> P.Sem effs BH.Html
blazeHtml :: Sem (Blaze : effs) () -> Sem effs Html
blazeHtml = ((Html, ()) -> Html) -> Sem effs (Html, ()) -> Sem effs Html
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html, ()) -> Html
forall a b. (a, b) -> a
fst (Sem effs (Html, ()) -> Sem effs Html)
-> (Sem (Blaze : effs) () -> Sem effs (Html, ()))
-> Sem (Blaze : effs) ()
-> Sem effs Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Blaze : effs) () -> Sem effs (Html, ())
forall o (r :: [Effect]) a.
Monoid o =>
Sem (Writer o : r) a -> Sem r (o, a)
P.runWriter

-- | Interpret the Blaze effect (via Writer), producing @Text@ from the currently written doc.
blazeToText :: P.Sem (Blaze ': effs) () -> P.Sem effs TL.Text
blazeToText :: Sem (Blaze : effs) () -> Sem effs Text
blazeToText = (Html -> Text) -> Sem effs Html -> Sem effs Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Text
BH.renderHtml (Sem effs Html -> Sem effs Text)
-> (Sem (Blaze : effs) () -> Sem effs Html)
-> Sem (Blaze : effs) ()
-> Sem effs Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Blaze : effs) () -> Sem effs Html
forall (effs :: [Effect]). Sem (Blaze : effs) () -> Sem effs Html
blazeHtml