{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.HTML.FormatString
    ( -- * HeadingFormat Types
      headingFormatId
    , headingFormat

      -- * Section and Paragraph Format
    , sectionFormat
    , paragraphFormat

      -- * IdentifierFormat
    , identifierFormat

      -- * Enum Counter Class Generation
    , enumFormat

      -- * Building Enum Counters into CSS
    , buildCssCounters

      -- * AppendixFormat
    , appendixFormat
    ) where

import Clay (Css)
import Control.Monad.Reader (ReaderT)
import Control.Monad.State (State, gets, modify)
import Data.Text (Text, pack)
import Language.Lsd.AST.Format
import Language.Lsd.AST.Type.Enum (EnumFormat (..), EnumItemFormat (..))
import Language.Lsd.AST.Type.Paragraph (ParagraphFormat (..))
import Language.Lsd.AST.Type.Section (SectionFormat (..))
import Language.Ltml.HTML.CSS.Classes (enumCounter, toCssClasses)
import Language.Ltml.HTML.CSS.CustomClay
    ( Counter
    , counterChar
    , counterCharCapital
    , counterNum
    , stringCounter
    )
import Language.Ltml.HTML.CSS.Util (cssClasses_)
import Language.Ltml.HTML.Common
    ( Delayed
    , EnumStyleMap
    , GlobalState (..)
    , ReaderState (..)
    )
import Language.Ltml.HTML.Util
import Lucid (Html, ToHtml (toHtml), span_)
import Prelude hiding (id)

-- | Builds Heading Html based on given Format and text html
headingFormat :: HeadingFormat False -> Html () -> Html ()
headingFormat :: HeadingFormat 'False -> Html () -> Html ()
headingFormat HeadingFormat 'False
format = HeadingFormat 'False -> Html () -> Html () -> Html ()
forall (permitId :: Bool).
HeadingFormat permitId -> Html () -> Html () -> Html ()
headingFormatId HeadingFormat 'False
format Html ()
forall a. Monoid a => a
mempty

-- | Builds Heading Html based on given Format, id  and text html
headingFormatId :: HeadingFormat permitId -> Html () -> Html () -> Html ()
headingFormatId :: forall (permitId :: Bool).
HeadingFormat permitId -> Html () -> Html () -> Html ()
headingFormatId (HeadingFormat Typography
typography FormatString (HeadingPlaceholderAtom permitId)
formatS) Html ()
idHtml Html ()
textHtml =
    -- \| <span> wrapper which gets all typography css classes
    [Attributes] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ ([Class] -> [Attributes]
cssClasses_ ([Class] -> [Attributes]) -> [Class] -> [Attributes]
forall a b. (a -> b) -> a -> b
$ Typography -> [Class]
forall a. ToCssClasses a => a -> [Class]
toCssClasses Typography
typography) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
        FormatString (HeadingPlaceholderAtom permitId)
-> Html () -> Html () -> Html ()
forall (permitId :: Bool).
FormatString (HeadingPlaceholderAtom permitId)
-> Html () -> Html () -> Html ()
headingFormatString FormatString (HeadingPlaceholderAtom permitId)
formatS Html ()
idHtml Html ()
textHtml
  where
    headingFormatString
        :: FormatString (HeadingPlaceholderAtom permitId) -> Html () -> Html () -> Html ()
    headingFormatString :: forall (permitId :: Bool).
FormatString (HeadingPlaceholderAtom permitId)
-> Html () -> Html () -> Html ()
headingFormatString (FormatString []) Html ()
_ Html ()
_ = Html ()
forall a. Monoid a => a
mempty
    headingFormatString (FormatString (FormatAtom (HeadingPlaceholderAtom permitId)
a : [FormatAtom (HeadingPlaceholderAtom permitId)]
as)) Html ()
id Html ()
text =
        case FormatAtom (HeadingPlaceholderAtom permitId)
a of
            -- \| replaces '\n' with <br>
            StringAtom String
s -> String -> Html ()
convertNewLine String
s
            PlaceholderAtom HeadingPlaceholderAtom permitId
IdentifierPlaceholder -> Html ()
id
            PlaceholderAtom HeadingPlaceholderAtom permitId
HeadingTextPlaceholder -> Html ()
text
            -- No InsertedPlaceholders allowed here
            InsertedPlaceholderAtom HeadingPlaceholderAtom permitId
_ -> Html ()
forall a. Monoid a => a
mempty
            Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> FormatString (HeadingPlaceholderAtom permitId)
-> Html () -> Html () -> Html ()
forall (permitId :: Bool).
FormatString (HeadingPlaceholderAtom permitId)
-> Html () -> Html () -> Html ()
headingFormatString ([FormatAtom (HeadingPlaceholderAtom permitId)]
-> FormatString (HeadingPlaceholderAtom permitId)
forall a. [FormatAtom a] -> FormatString a
FormatString [FormatAtom (HeadingPlaceholderAtom permitId)]
as) Html ()
id Html ()
text

-------------------------------------------------------------------------------

-- | Returns (ID Html, ToC Key Html) for a Section;
--   uses ID Html to build ToC Key Html
sectionFormat :: SectionFormat -> Int -> Int -> (Html (), Html ())
sectionFormat :: SectionFormat -> Int -> Int -> (Html (), Html ())
sectionFormat (SectionFormat IdentifierFormat
idFormat (TocKeyFormat KeyFormat
tocKeyFormat) Bool
_) = IdentifierFormat -> KeyFormat -> Int -> Int -> (Html (), Html ())
idKeyFormat IdentifierFormat
idFormat KeyFormat
tocKeyFormat

-- | Returns (ID Html, ToC Key Html) for a Paragraph;
--   uses ID Html to build Paragraph Key Html
paragraphFormat :: ParagraphFormat -> Int -> Int -> (Html (), Html ())
paragraphFormat :: ParagraphFormat -> Int -> Int -> (Html (), Html ())
paragraphFormat (ParagraphFormat IdentifierFormat
idFormat (ParagraphKeyFormat KeyFormat
paragraphKeyFormat)) = IdentifierFormat -> KeyFormat -> Int -> Int -> (Html (), Html ())
idKeyFormat IdentifierFormat
idFormat KeyFormat
paragraphKeyFormat

-- | Builds key html based on identifier html and returns both
--   as (ID Html, ToC Key Html)
idKeyFormat :: IdentifierFormat -> KeyFormat -> Int -> Int -> (Html (), Html ())
idKeyFormat :: IdentifierFormat -> KeyFormat -> Int -> Int -> (Html (), Html ())
idKeyFormat IdentifierFormat
idFormat KeyFormat
keyFormatS Int
i Int
insertedI =
    let idHtml :: Html ()
idHtml = IdentifierFormat -> Int -> Int -> Html ()
identifierFormat IdentifierFormat
idFormat Int
i Int
insertedI
        keyHtml :: Html ()
keyHtml = KeyFormat -> Html () -> Html ()
keyFormat KeyFormat
keyFormatS Html ()
idHtml
     in (Html ()
idHtml, Html ()
keyHtml)

-------------------------------------------------------------------------------

-- | Builds id Html based on given FormatString and id.
identifierFormat
    :: IdentifierFormat -> Int -> Int -> Html ()
identifierFormat :: IdentifierFormat -> Int -> Int -> Html ()
identifierFormat (FormatString []) Int
_ Int
_ = () -> Html ()
forall a. a -> HtmlT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall a. Monoid a => a
mempty
identifierFormat (FormatString (FormatAtom EnumStyle
a : [FormatAtom EnumStyle]
as)) Int
id Int
insertedId =
    let b :: Html ()
b = case FormatAtom EnumStyle
a of
            -- \| replaces '\n' with <br>
            StringAtom String
s -> String -> Html ()
convertNewLine String
s
            PlaceholderAtom EnumStyle
style -> EnumStyle -> Int -> Html ()
htmlAs EnumStyle
style Int
id
            InsertedPlaceholderAtom EnumStyle
style -> EnumStyle -> Int -> Html ()
htmlAs EnumStyle
style Int
insertedId
        bs :: Html ()
bs = IdentifierFormat -> Int -> Int -> Html ()
identifierFormat ([FormatAtom EnumStyle] -> IdentifierFormat
forall a. [FormatAtom a] -> FormatString a
FormatString [FormatAtom EnumStyle]
as) Int
id Int
insertedId
     in Html ()
b Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> Html ()
bs
  where
    htmlAs :: EnumStyle -> Int -> Html ()
    htmlAs :: EnumStyle -> Int -> Html ()
htmlAs EnumStyle
style Int
i = String -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> Html ()) -> String -> Html ()
forall a b. (a -> b) -> a -> b
$ case EnumStyle
style of
        EnumStyle
Arabic -> Int -> String
forall a. Show a => a -> String
show Int
i
        EnumStyle
AlphabeticLower -> Int -> String
intToLower Int
i
        EnumStyle
AlphabeticUpper -> Int -> String
intToCapital Int
i

-- | Builds the desired key in Html based on the given FormatString and the identifier Html
keyFormat :: KeyFormat -> Html () -> Html ()
keyFormat :: KeyFormat -> Html () -> Html ()
keyFormat (FormatString []) Html ()
_ = Html ()
forall a. Monoid a => a
mempty
keyFormat (FormatString (FormatAtom KeyPlaceholderAtom
a : [FormatAtom KeyPlaceholderAtom]
as)) Html ()
idHtml =
    let b :: Html ()
b = case FormatAtom KeyPlaceholderAtom
a of
            StringAtom String
s -> String -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml String
s
            PlaceholderAtom KeyPlaceholderAtom
KeyIdentifierPlaceholder -> Html ()
idHtml
            -- \| InsertedIds are not supported here
            InsertedPlaceholderAtom KeyPlaceholderAtom
KeyIdentifierPlaceholder -> Html ()
idHtml
        bs :: Html ()
bs = KeyFormat -> Html () -> Html ()
keyFormat ([FormatAtom KeyPlaceholderAtom] -> KeyFormat
forall a. [FormatAtom a] -> FormatString a
FormatString [FormatAtom KeyPlaceholderAtom]
as) Html ()
idHtml
     in Html ()
b Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> Html ()
bs

-------------------------------------------------------------------------------

-- | Converts EnumFormat to CSS class and manages global enum style map with unique classes
enumFormat
    :: EnumFormat -> ReaderT ReaderState (State GlobalState) Text
enumFormat :: EnumFormat -> ReaderT ReaderState (State GlobalState) Text
enumFormat EnumFormat
enumFormatS =
    do
        EnumStyleMap
globalEnumStyles <- (GlobalState -> EnumStyleMap)
-> ReaderT ReaderState (State GlobalState) EnumStyleMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> EnumStyleMap
enumStyles
        let mId :: Maybe Text
mId = EnumFormat -> EnumStyleMap -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup EnumFormat
enumFormatS EnumStyleMap
globalEnumStyles
         in case Maybe Text
mId of
                -- \| If Format already exists use the same class again
                Just Text
htmlId -> Text -> ReaderT ReaderState (State GlobalState) Text
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
htmlId
                -- \| Build new mangled css class name
                Maybe Text
Nothing -> do
                    Text
mangledEnumName <- (GlobalState -> Text)
-> ReaderT ReaderState (State GlobalState) Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Text
mangledEnumCounterName
                    Int
mangledEnumId <- (GlobalState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Int
mangledEnumCounterID
                    let mangledClassName :: Text
mangledClassName = Text
mangledEnumName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
mangledEnumId)
                     in do
                            -- \| Add new enumStyle to global map
                            (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
                                (\GlobalState
s -> GlobalState
s {enumStyles = (enumFormatS, mangledClassName) : enumStyles s})
                            -- \| Increment ID for next mangled name
                            (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {mangledEnumCounterID = mangledEnumCounterID s + 1})
                            Text -> ReaderT ReaderState (State GlobalState) Text
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
mangledClassName

buildEnumCounter :: EnumFormat -> Counter
buildEnumCounter :: EnumFormat -> Counter
buildEnumCounter (EnumFormat (EnumItemFormat IdentifierFormat
idFormat (EnumItemKeyFormat KeyFormat
enumKeyFormat))) =
    let idCounter :: Counter
idCounter = IdentifierFormat -> Counter
idFormatCounter IdentifierFormat
idFormat
        keyCounter :: Counter
keyCounter = KeyFormat -> Counter -> Counter
keyFormatCounter KeyFormat
enumKeyFormat Counter
idCounter
     in Counter
keyCounter

-- | Converts IdentifierFormat to CSS counter
idFormatCounter :: IdentifierFormat -> Counter
idFormatCounter :: IdentifierFormat -> Counter
idFormatCounter (FormatString []) = Counter
forall a. Monoid a => a
mempty
idFormatCounter (FormatString (FormatAtom EnumStyle
a : [FormatAtom EnumStyle]
as)) =
    let c :: Counter
c = case FormatAtom EnumStyle
a of
            StringAtom String
s -> Text -> Counter
stringCounter (Text -> Counter) -> Text -> Counter
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s
            PlaceholderAtom EnumStyle
Arabic -> Text -> Counter
counterNum Text
"item"
            PlaceholderAtom EnumStyle
AlphabeticLower -> Text -> Counter
counterChar Text
"item"
            PlaceholderAtom EnumStyle
AlphabeticUpper -> Text -> Counter
counterCharCapital Text
"item"
            -- No InsertedPlaceholders allowed here
            InsertedPlaceholderAtom EnumStyle
_ -> Counter
forall a. Monoid a => a
mempty

        cs :: Counter
cs = IdentifierFormat -> Counter
idFormatCounter ([FormatAtom EnumStyle] -> IdentifierFormat
forall a. [FormatAtom a] -> FormatString a
FormatString [FormatAtom EnumStyle]
as)
     in Counter
c Counter -> Counter -> Counter
forall a. Semigroup a => a -> a -> a
<> Counter
cs

-- | Converts KeyFormat and given identifier Counter to CSS Counter
keyFormatCounter :: KeyFormat -> Counter -> Counter
keyFormatCounter :: KeyFormat -> Counter -> Counter
keyFormatCounter (FormatString []) Counter
_ = Counter
forall a. Monoid a => a
mempty
keyFormatCounter (FormatString (FormatAtom KeyPlaceholderAtom
a : [FormatAtom KeyPlaceholderAtom]
as)) Counter
idCounter =
    let c :: Counter
c = case FormatAtom KeyPlaceholderAtom
a of
            StringAtom String
s -> Text -> Counter
stringCounter (Text -> Counter) -> Text -> Counter
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s
            PlaceholderAtom KeyPlaceholderAtom
KeyIdentifierPlaceholder -> Counter
idCounter
            -- No InsertedPlaceholders allowed here
            InsertedPlaceholderAtom KeyPlaceholderAtom
_ -> Counter
forall a. Monoid a => a
mempty
        cs :: Counter
cs = KeyFormat -> Counter -> Counter
keyFormatCounter ([FormatAtom KeyPlaceholderAtom] -> KeyFormat
forall a. [FormatAtom a] -> FormatString a
FormatString [FormatAtom KeyPlaceholderAtom]
as) Counter
idCounter
     in Counter
c Counter -> Counter -> Counter
forall a. Semigroup a => a -> a -> a
<> Counter
cs

-------------------------------------------------------------------------------

-- | Builds CSS classes from EnumFormats and class names
buildCssCounters :: EnumStyleMap -> Css
buildCssCounters :: EnumStyleMap -> Css
buildCssCounters [] = Css
forall a. Monoid a => a
mempty
buildCssCounters ((EnumFormat
enumFormatS, Text
cssClassName) : EnumStyleMap
ps) =
    Text -> Counter -> Css
enumCounter Text
cssClassName (EnumFormat -> Counter
buildEnumCounter EnumFormat
enumFormatS)
        Css -> Css -> Css
forall a. Semigroup a => a -> a -> a
<> EnumStyleMap -> Css
buildCssCounters EnumStyleMap
ps

-------------------------------------------------------------------------------

-- | Builds (Heading Html, ToC Key Html) using the required formats, an Id and a title Html
appendixFormat
    :: IdentifierFormat
    -> Int
    -> TocKeyFormat
    -> HeadingFormat True
    -> Delayed (Html ())
    -> (Delayed (Html ()), Html ())
appendixFormat :: IdentifierFormat
-> Int
-> TocKeyFormat
-> HeadingFormat 'True
-> Delayed (Html ())
-> (Delayed (Html ()), Html ())
appendixFormat IdentifierFormat
idFormatS Int
i (TocKeyFormat KeyFormat
keyFormatS) HeadingFormat 'True
headingFormatS Delayed (Html ())
titleHtml =
    let idHtml :: Html ()
idHtml = IdentifierFormat -> Int -> Int -> Html ()
identifierFormat IdentifierFormat
idFormatS Int
i Int
0
        tocKeyHtml :: Html ()
tocKeyHtml = KeyFormat -> Html () -> Html ()
keyFormat KeyFormat
keyFormatS Html ()
idHtml
        headingHtml :: Delayed (Html ())
headingHtml = HeadingFormat 'True -> Html () -> Html () -> Html ()
forall (permitId :: Bool).
HeadingFormat permitId -> Html () -> Html () -> Html ()
headingFormatId HeadingFormat 'True
headingFormatS Html ()
idHtml (Html () -> Html ()) -> Delayed (Html ()) -> Delayed (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (Html ())
titleHtml
     in (Delayed (Html ())
headingHtml, Html ()
tocKeyHtml)