{-# LANGUAGE DeriveAnyClass #-}

module Emanote.Model.Title (
  Title,

  -- * Title conversion
  fromRoute,
  fromInlines,
  toInlines,

  -- * Rendering a Title
  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
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. 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
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
(==) =
    -- Use toPlain here, rather than toInlines, because the same text can have
    -- different inlines structure. For example, "Foo Bar" can be represented as
    --   [Str "Foo", Space, Str "Bar"],
    -- or as,
    --   [Str "Foo Bar"]
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) Title -> Text
toPlain

instance Ord Title where
  compare :: Title -> Title -> Ordering
compare =
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on 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 forall a. Semigroup a => a -> a -> a
<> Text
b)
  Title
x <> Title
y =
    [Inline] -> Title
TitlePandoc forall a b. (a -> b) -> a -> b
$ forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText

fromRoute :: R.LMLRoute -> Title
fromRoute :: LMLRoute -> Title
fromRoute =
  Text -> Title
TitlePlain forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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 -> 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 ->
    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 forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
B.Plain forall a b. (a -> b) -> a -> b
$ b -> b
f [Inline]
is
    RenderCtx -> Pandoc -> Splice Identity
HP.pandocSplice RenderCtx
ctx Pandoc
titleDoc

titleSpliceNoHtml :: Title -> HI.Splice Identity
titleSpliceNoHtml :: Title -> Splice Identity
titleSpliceNoHtml =
  forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> Text
toPlain