{-# LANGUAGE DeriveAnyClass #-}
module Emanote.Model.Title
( Title,
fromRoute,
fromInlines,
toInlines,
titleSplice,
titleSpliceNoHtml,
toPlain,
)
where
import Commonmark.Extensions.WikiLink (plainify)
import Data.Aeson (ToJSON)
import Emanote.Route qualified as R
import Heist.Extra.Splices.Pandoc qualified as HP
import Heist.Interpreted qualified as HI
import Relude
import Text.Pandoc.Definition qualified as B
import Text.Pandoc.Walk qualified as W
data Title
= TitlePlain Text
| TitlePandoc [B.Inline]
deriving stock (Int -> Title -> ShowS
[Title] -> ShowS
Title -> String
(Int -> Title -> ShowS)
-> (Title -> String) -> ([Title] -> ShowS) -> Show Title
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Title] -> ShowS
$cshowList :: [Title] -> ShowS
show :: Title -> String
$cshow :: Title -> String
showsPrec :: Int -> Title -> ShowS
$cshowsPrec :: Int -> Title -> ShowS
Show, (forall x. Title -> Rep Title x)
-> (forall x. Rep Title x -> Title) -> Generic Title
forall x. Rep Title x -> Title
forall x. Title -> Rep Title x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Title x -> Title
$cfrom :: forall x. Title -> Rep Title x
Generic)
deriving anyclass ([Title] -> Encoding
[Title] -> Value
Title -> Encoding
Title -> Value
(Title -> Value)
-> (Title -> Encoding)
-> ([Title] -> Value)
-> ([Title] -> Encoding)
-> ToJSON Title
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Title] -> Encoding
$ctoEncodingList :: [Title] -> Encoding
toJSONList :: [Title] -> Value
$ctoJSONList :: [Title] -> Value
toEncoding :: Title -> Encoding
$ctoEncoding :: Title -> Encoding
toJSON :: Title -> Value
$ctoJSON :: Title -> Value
ToJSON)
instance Eq Title where
== :: Title -> Title -> Bool
(==) =
(Text -> Text -> Bool) -> (Title -> Text) -> Title -> Title -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Title -> Text
toPlain
instance Ord Title where
compare :: Title -> Title -> Ordering
compare =
(Text -> Text -> Ordering)
-> (Title -> Text) -> Title -> Title -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Title -> Text
toPlain
instance Semigroup Title where
TitlePlain Text
a <> :: Title -> Title -> Title
<> TitlePlain Text
b =
Text -> Title
TitlePlain (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b)
Title
x <> Title
y =
[Inline] -> Title
TitlePandoc ([Inline] -> Title) -> [Inline] -> Title
forall a b. (a -> b) -> a -> b
$ ([Inline] -> [Inline] -> [Inline])
-> (Title -> [Inline]) -> Title -> Title -> [Inline]
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
(<>) Title -> [Inline]
toInlines Title
x Title
y
instance IsString Title where
fromString :: String -> Title
fromString = Text -> Title
TitlePlain (Text -> Title) -> (String -> Text) -> String -> Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText
fromRoute :: R.LMLRoute -> Title
fromRoute :: LMLRoute -> Title
fromRoute =
Text -> Title
TitlePlain (Text -> Title) -> (LMLRoute -> Text) -> LMLRoute -> Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> Text)
-> LMLRoute -> Text
forall r.
(forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall {a} (ext :: FileType a). R @a ext -> Text
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> Text
R.routeBaseName
fromInlines :: [B.Inline] -> Title
fromInlines :: [Inline] -> Title
fromInlines = [Inline] -> Title
TitlePandoc
toInlines :: Title -> [B.Inline]
toInlines :: Title -> [Inline]
toInlines = \case
TitlePlain Text
s -> OneItem [Inline] -> [Inline]
forall x. One x => OneItem x -> x
one (Text -> Inline
B.Str Text
s)
TitlePandoc [Inline]
is -> [Inline]
is
toPlain :: Title -> Text
toPlain :: Title -> Text
toPlain = \case
TitlePlain Text
s -> Text
s
TitlePandoc [Inline]
is -> [Inline] -> Text
plainify [Inline]
is
titleSplice ::
forall b.
(W.Walkable B.Inline b, b ~ [B.Inline]) =>
HP.RenderCtx ->
(b -> b) ->
Title ->
HI.Splice Identity
titleSplice :: forall b.
(Walkable Inline b, (b :: Type) ~ ([Inline] :: Type)) =>
RenderCtx -> (b -> b) -> Title -> Splice Identity
titleSplice RenderCtx
ctx b -> b
f = \case
TitlePlain Text
x ->
Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice Text
x
TitlePandoc [Inline]
is -> do
let titleDoc :: Pandoc
titleDoc = Meta -> [Block] -> Pandoc
B.Pandoc Meta
forall a. Monoid a => a
mempty ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ OneItem [Block] -> [Block]
forall x. One x => OneItem x -> x
one (OneItem [Block] -> [Block]) -> OneItem [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
B.Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ b -> b
f b
[Inline]
is
RenderCtx -> Pandoc -> Splice Identity
HP.pandocSplice RenderCtx
ctx Pandoc
titleDoc
titleSpliceNoHtml :: Title -> HI.Splice Identity
titleSpliceNoHtml :: Title -> Splice Identity
titleSpliceNoHtml =
Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (Text -> Splice Identity)
-> (Title -> Text) -> Title -> Splice Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Text
toPlain