{-# LANGUAGE LambdaCase #-}
module Text.MMark.Extension.TableOfContents
( Toc,
tocScanner,
toc,
)
where
import qualified Control.Foldl as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (maybeToList)
import Data.Text (Text)
import Text.MMark.Extension (Block (..), Bni, Extension, Inline (..))
import qualified Text.MMark.Extension as Ext
newtype Toc = Toc [(Int, NonEmpty Inline)]
tocScanner ::
(Int -> Bool) ->
L.Fold Bni Toc
tocScanner :: (Int -> Bool) -> Fold Bni Toc
tocScanner Int -> Bool
p = (([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]) -> Toc)
-> Fold Bni ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni Toc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Int, NonEmpty Inline)] -> Toc
Toc ([(Int, NonEmpty Inline)] -> Toc)
-> (([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)])
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Toc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
forall a b. (a -> b) -> a -> b
$ [])) (Fold Bni ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni Toc)
-> ((([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Bni -> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]))
-> (([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Bni -> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni Toc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> (([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Bni -> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
forall a. a -> (a -> Bni -> a) -> Fold Bni a
Ext.scanner [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
forall a. a -> a
id ((([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Bni -> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni Toc)
-> (([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Bni -> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> Fold Bni Toc
forall a b. (a -> b) -> a -> b
$ \[(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs Bni
block ->
case Bni
block of
Heading1 NonEmpty Inline
x -> Int
-> NonEmpty Inline
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)]
-> [(Int, NonEmpty Inline)]
forall b c. Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
1 NonEmpty Inline
x [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
Heading2 NonEmpty Inline
x -> Int
-> NonEmpty Inline
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)]
-> [(Int, NonEmpty Inline)]
forall b c. Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
2 NonEmpty Inline
x [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
Heading3 NonEmpty Inline
x -> Int
-> NonEmpty Inline
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)]
-> [(Int, NonEmpty Inline)]
forall b c. Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
3 NonEmpty Inline
x [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
Heading4 NonEmpty Inline
x -> Int
-> NonEmpty Inline
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)]
-> [(Int, NonEmpty Inline)]
forall b c. Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
4 NonEmpty Inline
x [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
Heading5 NonEmpty Inline
x -> Int
-> NonEmpty Inline
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)]
-> [(Int, NonEmpty Inline)]
forall b c. Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
5 NonEmpty Inline
x [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
Heading6 NonEmpty Inline
x -> Int
-> NonEmpty Inline
-> ([(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)])
-> [(Int, NonEmpty Inline)]
-> [(Int, NonEmpty Inline)]
forall b c. Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
6 NonEmpty Inline
x [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
Bni
_ -> [(Int, NonEmpty Inline)] -> [(Int, NonEmpty Inline)]
xs
where
f :: Int -> b -> ([(Int, b)] -> c) -> [(Int, b)] -> c
f Int
n b
a [(Int, b)] -> c
as =
if Int -> Bool
p Int
n
then [(Int, b)] -> c
as ([(Int, b)] -> c) -> ([(Int, b)] -> [(Int, b)]) -> [(Int, b)] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int
n, b
a) (Int, b) -> [(Int, b)] -> [(Int, b)]
forall a. a -> [a] -> [a]
:)
else [(Int, b)] -> c
as
toc ::
Text ->
Toc ->
Extension
toc :: Text -> Toc -> Extension
toc Text
label (Toc [(Int, NonEmpty Inline)]
xs) = (Bni -> Bni) -> Extension
Ext.blockTrans ((Bni -> Bni) -> Extension) -> (Bni -> Bni) -> Extension
forall a b. (a -> b) -> a -> b
$ \case
old :: Bni
old@(CodeBlock Maybe Text
mlabel Text
_) ->
case [(Int, NonEmpty Inline)] -> Maybe (NonEmpty (Int, NonEmpty Inline))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(Int, NonEmpty Inline)]
xs of
Maybe (NonEmpty (Int, NonEmpty Inline))
Nothing -> Bni
old
Just NonEmpty (Int, NonEmpty Inline)
ns ->
if Maybe Text
mlabel Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
label
then NonEmpty (Int, NonEmpty Inline) -> Bni
renderToc NonEmpty (Int, NonEmpty Inline)
ns
else Bni
old
Bni
other -> Bni
other
renderToc :: NonEmpty (Int, NonEmpty Inline) -> Bni
renderToc :: NonEmpty (Int, NonEmpty Inline) -> Bni
renderToc = NonEmpty [Bni] -> Bni
forall a. NonEmpty [Block a] -> Block a
UnorderedList (NonEmpty [Bni] -> Bni)
-> (NonEmpty (Int, NonEmpty Inline) -> NonEmpty [Bni])
-> NonEmpty (Int, NonEmpty Inline)
-> Bni
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Int, NonEmpty Inline)
-> ([Bni], Maybe (NonEmpty (Int, NonEmpty Inline))))
-> NonEmpty (Int, NonEmpty Inline) -> NonEmpty [Bni]
forall a b. (a -> (b, Maybe a)) -> a -> NonEmpty b
NE.unfoldr NonEmpty (Int, NonEmpty Inline)
-> ([Bni], Maybe (NonEmpty (Int, NonEmpty Inline)))
f
where
f :: NonEmpty (Int, NonEmpty Inline)
-> ([Bni], Maybe (NonEmpty (Int, NonEmpty Inline)))
f ((Int
n, NonEmpty Inline
x) :| [(Int, NonEmpty Inline)]
xs) =
let ([(Int, NonEmpty Inline)]
sitems, [(Int, NonEmpty Inline)]
fitems) = ((Int, NonEmpty Inline) -> Bool)
-> [(Int, NonEmpty Inline)]
-> ([(Int, NonEmpty Inline)], [(Int, NonEmpty Inline)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n) (Int -> Bool)
-> ((Int, NonEmpty Inline) -> Int)
-> (Int, NonEmpty Inline)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, NonEmpty Inline) -> Int
forall a b. (a, b) -> a
fst) [(Int, NonEmpty Inline)]
xs
url :: URI
url = Text -> URI
Ext.headerFragment (NonEmpty Inline -> Text
Ext.headerId NonEmpty Inline
x)
in ( NonEmpty Inline -> Bni
forall a. a -> Block a
Naked (NonEmpty Inline -> URI -> Maybe Text -> Inline
Link NonEmpty Inline
x URI
url Maybe Text
forall a. Maybe a
Nothing Inline -> [Inline] -> NonEmpty Inline
forall a. a -> [a] -> NonEmpty a
:| []) Bni -> [Bni] -> [Bni]
forall a. a -> [a] -> [a]
:
Maybe Bni -> [Bni]
forall a. Maybe a -> [a]
maybeToList (NonEmpty (Int, NonEmpty Inline) -> Bni
renderToc (NonEmpty (Int, NonEmpty Inline) -> Bni)
-> Maybe (NonEmpty (Int, NonEmpty Inline)) -> Maybe Bni
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, NonEmpty Inline)] -> Maybe (NonEmpty (Int, NonEmpty Inline))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(Int, NonEmpty Inline)]
sitems),
[(Int, NonEmpty Inline)] -> Maybe (NonEmpty (Int, NonEmpty Inline))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(Int, NonEmpty Inline)]
fitems
)