{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Avoid lambda using `infix`" #-}

module Language.Ltml.HTML.Util
    ( -- * ID Conversion
      intToLower
    , intToCapital
    , iToT

      -- * Monad Helpers
    , whenJust
    , mapState
    , withModified
    , nothingA2

      -- * HTML Conversion
    , convertNewLine

      -- * Lucid Attributes
    , mId_
    , mTextId_

      -- * ToHtmlM Helpers
    , getNextRawTextTree
    , isSuper
    , isInserted

      -- * FilePaths
    , disjointRelative

      -- * Textual Headings
    , headingText
    ) where

import Control.Monad.State (MonadState, gets, modify)
import Data.Char (chr)
import Data.Text (Text, pack)
import Data.Text.Lazy (toStrict)
import Data.Void (absurd)
import Language.Lsd.AST.Type.Section (SectionFormat (..))
import Language.Ltml.AST.Label (Label (..))
import Language.Ltml.AST.Section (SectionBody (InnerSectionBody))
import Language.Ltml.AST.Text (HeadingTextTree, TextTree (..))
import Language.Ltml.HTML.Common (Delayed (..), GlobalState (..))
import Lucid
import System.FilePath.Posix (splitDirectories, (</>))

-- | Converts Int to corresponding lowercase letter in the alphabet.
-- If Int is (<= 0) or (>= 27), it returns "?"
--
-- === __Examples__
--
-- >>> intToLower 0
-- "?"
--
-- >>> intToLower 1
-- "a"
--
-- >>> intToLower 26
-- "z"
--
-- >>> intToLower 27
-- "a"
intToLower :: Int -> String
intToLower :: Int -> [Char]
intToLower = Int -> Int -> [Char]
intToLetter Int
96

-- | Converts Int to corresponding capital letter in the alphabet.
--   If Int is (<= 0) or (>= 27), it returns "?"
--
-- === __Examples__
--
-- >>> intToCapital 0
-- "?"
--
-- >>> intToCapital 1
-- "A"
--
-- >>> intToCapital 26
-- "Z"
--
-- >>> intToCapital 27
-- "A"
intToCapital :: Int -> String
intToCapital :: Int -> [Char]
intToCapital = Int -> Int -> [Char]
intToLetter Int
64

-- | Converts Int to corresponding ASCII Char with offset shift.
--   If n is (<= 0) or (>= 27), it returns "?"
intToLetter :: Int -> Int -> String
intToLetter :: Int -> Int -> [Char]
intToLetter Int
shift Int
n
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [Char]
"?"
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
26 = (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: []) (Char -> [Char]) -> Char -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shift)
    | Bool
otherwise = Int -> Int -> [Char]
intToLetter Int
shift (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
n Int
27 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Converts 'Int' to 'Text'
iToT :: Int -> Text
iToT :: Int -> Text
iToT = [Char] -> Text
pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show

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

-- | If maybe value is Nothing returns (), else passes a into function
whenJust :: (Applicative m) => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
ma a -> m ()
fa = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
fa Maybe a
ma

-- | Applies functions to every item in the list and
--   chains those calls together by propagating the state s from
--   left to right; the final state is dropped
mapState :: (Monad m) => (s -> a -> m s) -> s -> [a] -> m ()
mapState :: forall (m :: * -> *) s a.
Monad m =>
(s -> a -> m s) -> s -> [a] -> m ()
mapState s -> a -> m s
_ s
_ [] = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
mapState s -> a -> m s
f s
s (a
a : [a]
as) = do
    s
s' <- s -> a -> m s
f s
s a
a
    (s -> a -> m s) -> s -> [a] -> m ()
forall (m :: * -> *) s a.
Monad m =>
(s -> a -> m s) -> s -> [a] -> m ()
mapState s -> a -> m s
f s
s' [a]
as

-- | Saves state field and modifies it with a new temporary value for the span
--   of the given monadic action (like local); restores old state field afterwards
withModified
    :: (MonadState GlobalState m)
    => (GlobalState -> a)
    -> (GlobalState -> a -> GlobalState)
    -> a
    -> m b
    -> m b
withModified :: forall (m :: * -> *) a b.
MonadState GlobalState m =>
(GlobalState -> a)
-> (GlobalState -> a -> GlobalState) -> a -> m b -> m b
withModified GlobalState -> a
getter GlobalState -> a -> GlobalState
setter a
newValue m b
action = do
    a
saved <- (GlobalState -> a) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> a
getter
    (GlobalState -> GlobalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState -> a -> GlobalState
setter GlobalState
s a
newValue)
    b
res <- m b
action
    (GlobalState -> GlobalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState -> a -> GlobalState
setter GlobalState
s a
saved)
    b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

-- | Ignores both arguments and does nothing;
--   except returning '()'
nothingA2 :: (Monad m) => a -> b -> m ()
nothingA2 :: forall (m :: * -> *) a b. Monad m => a -> b -> m ()
nothingA2 = (b -> m ()) -> a -> b -> m ()
forall a b. a -> b -> a
const ((b -> m ()) -> a -> b -> m ()) -> (b -> m ()) -> a -> b -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> b -> m ()
forall a b. a -> b -> a
const (m () -> b -> m ()) -> m () -> b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

-- | Replaces every '\n' with HTML <br> while maintaining toHtml input sanitization
convertNewLine :: String -> Html ()
convertNewLine :: [Char] -> Html ()
convertNewLine [] = Html ()
forall a. Monoid a => a
mempty
convertNewLine [Char]
s =
    let ([Char]
raw, [Char]
newLine) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
s
     in case [Char]
newLine of
            [] -> [Char] -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => [Char] -> HtmlT m ()
toHtml [Char]
raw
            (Char
_ : [Char]
next) -> [Char] -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => [Char] -> HtmlT m ()
toHtml [Char]
raw Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> [Attributes] -> Html ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
br_ [] Html () -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> [Char] -> Html ()
convertNewLine [Char]
next

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

-- | Adds Label as id, if it exists
mId_ :: Maybe Label -> Attributes
mId_ :: Maybe Label -> Attributes
mId_ Maybe Label
Nothing = Attributes
forall a. Monoid a => a
mempty
mId_ (Just Label
label) = Text -> Attributes
id_ (Text -> Attributes) -> Text -> Attributes
forall a b. (a -> b) -> a -> b
$ Label -> Text
unLabel Label
label

-- | Adds Text as id, if it exists
mTextId_ :: Maybe Text -> Attributes
mTextId_ :: Maybe Text -> Attributes
mTextId_ Maybe Text
Nothing = Attributes
forall a. Monoid a => a
mempty
mTextId_ (Just Text
text) = Text -> Attributes
id_ Text
text

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

-- | Splits list into raw text part until next enumeration (raw is everything except enums)
getNextRawTextTree
    :: [TextTree lbrk fnref style enum special]
    -> ( [TextTree lbrk fnref style enum special]
       , [TextTree lbrk fnref style enum special]
       )
getNextRawTextTree :: forall lbrk fnref style enum special.
[TextTree lbrk fnref style enum special]
-> ([TextTree lbrk fnref style enum special],
    [TextTree lbrk fnref style enum special])
getNextRawTextTree =
    (TextTree lbrk fnref style enum special -> Bool)
-> [TextTree lbrk fnref style enum special]
-> ([TextTree lbrk fnref style enum special],
    [TextTree lbrk fnref style enum special])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break
        ( \case
            Enum enum
_ -> Bool
True
            TextTree lbrk fnref style enum special
_ -> Bool
False
        )

-- | Is given section a super-section? (has sections as children)
isSuper :: SectionBody -> Bool
isSuper :: SectionBody -> Bool
isSuper (InnerSectionBody [Flagged' FormattedSection]
_) = Bool
True
isSuper SectionBody
_ = Bool
False

-- | Is given 'Section' an inserted 'Section'?
isInserted :: SectionFormat -> Bool
isInserted :: SectionFormat -> Bool
isInserted (SectionFormat IdentifierFormat
_ TocKeyFormat
_ Bool
insertedFlag) = Bool
insertedFlag

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

-- | Creates relative path from base to target; Will introduce @".."@ and
--   should only be used for disjoint base and target paths;
--   otherwise use 'makeRelative'
disjointRelative :: FilePath -> FilePath -> FilePath
disjointRelative :: [Char] -> [Char] -> [Char]
disjointRelative [Char]
base [Char]
target =
    let dirs :: Int
dirs = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> Int) -> [[Char]] -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
splitDirectories [Char]
base
        prefix :: [Char]
prefix = ([Char] -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Char] -> [Char] -> [Char]
(</>) [Char]
"" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
dirs [Char]
".."
     in [Char]
prefix [Char] -> [Char] -> [Char]
</> [Char]
target

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

-- | Generate raw textual title from 'HeadingTextTree';
--   Note: Footnotes are skipped and check for undefined Labels
--         before using this function.
headingText :: [HeadingTextTree] -> Delayed Text
headingText :: [HeadingTextTree] -> Delayed Text
headingText = (HeadingTextTree -> Delayed Text -> Delayed Text)
-> Delayed Text -> [HeadingTextTree] -> Delayed Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Delayed Text -> Delayed Text -> Delayed Text
forall a. Semigroup a => a -> a -> a
(<>) (Delayed Text -> Delayed Text -> Delayed Text)
-> (HeadingTextTree -> Delayed Text)
-> HeadingTextTree
-> Delayed Text
-> Delayed Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeadingTextTree -> Delayed Text
translate) (Text -> Delayed Text
forall a. a -> Delayed a
Now Text
"")
  where
    translate :: HeadingTextTree -> Delayed Text
    translate :: HeadingTextTree -> Delayed Text
translate HeadingTextTree
htt = case HeadingTextTree
htt of
        Word Text
text -> Text -> Delayed Text
forall a. a -> Delayed a
Now Text
text
        HeadingTextTree
Space -> Text -> Delayed Text
forall a. a -> Delayed a
Now Text
" "
        -- TODO: textual non breaking space?
        HeadingTextTree
NonBreakingSpace -> Text -> Delayed Text
forall a. a -> Delayed a
Now Text
" "
        LineBreak Void
void -> Void -> Delayed Text
forall a. Void -> a
absurd Void
void
        Special Void
void -> Void -> Delayed Text
forall a. Void -> a
absurd Void
void
        Reference Label
label -> (GlobalState -> Text) -> Delayed Text
forall a. (GlobalState -> a) -> Delayed a
Later ((GlobalState -> Text) -> Delayed Text)
-> (GlobalState -> Text) -> Delayed Text
forall a b. (a -> b) -> a -> b
$ \GlobalState
globalState ->
            case Label -> [(Label, Html ())] -> Maybe (Html ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
label ([(Label, Html ())] -> Maybe (Html ()))
-> [(Label, Html ())] -> Maybe (Html ())
forall a b. (a -> b) -> a -> b
$ GlobalState -> [(Label, Html ())]
labels GlobalState
globalState of
                -- \| Label was not found in GlobalState;
                --    Since this function is only used for export,
                --    no errors will occur
                Maybe (Html ())
Nothing -> Text
""
                Just Html ()
labelHtml -> LazyText -> Text
toStrict (LazyText -> Text) -> LazyText -> Text
forall a b. (a -> b) -> a -> b
$ Html () -> LazyText
forall a. Html a -> LazyText
renderText Html ()
labelHtml
        Styled Void
void [HeadingTextTree]
_ -> Void -> Delayed Text
forall a. Void -> a
absurd Void
void
        Enum Void
void -> Void -> Delayed Text
forall a. Void -> a
absurd Void
void
        -- \| Note this: Footnotes are skipped
        FootnoteRef FootnoteReference
_ -> Text -> Delayed Text
forall a. a -> Delayed a
Now Text
""