{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.SideNote (usingSideNotes) where
import Data.List (intercalate)
import Data.Text (append, pack)
import Control.Monad.State
import Text.Pandoc.JSON
import Text.Pandoc.Walk (walk, walkM)
data NoteType
= SideNote
| MarginNote
|
deriving (Int -> NoteType -> ShowS
[NoteType] -> ShowS
NoteType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteType] -> ShowS
$cshowList :: [NoteType] -> ShowS
show :: NoteType -> String
$cshow :: NoteType -> String
showsPrec :: Int -> NoteType -> ShowS
$cshowsPrec :: Int -> NoteType -> ShowS
Show, NoteType -> NoteType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteType -> NoteType -> Bool
$c/= :: NoteType -> NoteType -> Bool
== :: NoteType -> NoteType -> Bool
$c== :: NoteType -> NoteType -> Bool
Eq)
getFirstStr :: [Block] -> (NoteType, [Block])
getFirstStr :: [Block] -> (NoteType, [Block])
getFirstStr blocks :: [Block]
blocks@(Block
block:[Block]
blocks') =
case Block
block of
Plain ((Str Text
"{-}"):Inline
Space:[Inline]
rest) -> (NoteType
MarginNote, ([Inline] -> Block
Plain [Inline]
rest)forall a. a -> [a] -> [a]
:[Block]
blocks')
Plain ((Str Text
"{.}"):Inline
Space:[Inline]
rest) -> (NoteType
FootNote, ([Inline] -> Block
Plain [Inline]
rest)forall a. a -> [a] -> [a]
:[Block]
blocks')
Para ((Str Text
"{-}"):Inline
Space:[Inline]
rest) -> (NoteType
MarginNote, ([Inline] -> Block
Para [Inline]
rest)forall a. a -> [a] -> [a]
:[Block]
blocks')
Para ((Str Text
"{.}"):Inline
Space:[Inline]
rest) -> (NoteType
FootNote, ([Inline] -> Block
Para [Inline]
rest)forall a. a -> [a] -> [a]
:[Block]
blocks')
LineBlock (((Str Text
"{-}"):Inline
Space:[Inline]
rest):[[Inline]]
rest') -> (NoteType
MarginNote, ([[Inline]] -> Block
LineBlock ([Inline]
restforall a. a -> [a] -> [a]
:[[Inline]]
rest'))forall a. a -> [a] -> [a]
:[Block]
blocks')
LineBlock (((Str Text
"{.}"):Inline
Space:[Inline]
rest):[[Inline]]
rest') -> (NoteType
FootNote, ([[Inline]] -> Block
LineBlock ([Inline]
restforall a. a -> [a] -> [a]
:[[Inline]]
rest'))forall a. a -> [a] -> [a]
:[Block]
blocks')
Block
_ -> (NoteType
SideNote, [Block]
blocks)
getFirstStr [Block]
blocks = (NoteType
SideNote, [Block]
blocks)
newline :: [Inline]
newline :: [Inline]
newline = [Inline
LineBreak, Inline
LineBreak]
getThenIncr :: State Int Int
getThenIncr :: State Int Int
getThenIncr = do
Int
i <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
i forall a. Num a => a -> a -> a
+ Int
1)
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
coerceToInline :: [Block] -> [Inline]
coerceToInline :: [Block] -> [Inline]
coerceToInline = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Inline]
deBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
deNote
where
deBlock :: Block -> [Inline]
deBlock :: Block -> [Inline]
deBlock (Plain [Inline]
ls ) = [Inline]
ls
deBlock (Para [Inline]
ls ) = [Inline]
ls forall a. [a] -> [a] -> [a]
++ [Inline]
newline
deBlock (LineBlock [[Inline]]
lss ) = forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lss forall a. [a] -> [a] -> [a]
++ [Inline]
newline
deBlock (RawBlock Format
fmt Text
str) = [Format -> Text -> Inline
RawInline Format
fmt Text
str]
deBlock Block
_ = []
deNote :: Inline -> Inline
deNote (Note [Block]
_) = Text -> Inline
Str Text
""
deNote Inline
x = Inline
x
filterNote :: Bool -> [Inline] -> State Int Inline
filterNote :: Bool -> [Inline] -> State Int Inline
filterNote Bool
nonu [Inline]
content = do
Int
i <- State Int Int
getThenIncr
let labelCls :: Text
labelCls = Text
"margin-toggle" Text -> Text -> Text
`append`
(if Bool
nonu then Text
"" else Text
" sidenote-number")
let labelSym :: Text
labelSym = if Bool
nonu then Text
"⊕" else Text
""
let labelHTML :: Text
labelHTML = forall a. Monoid a => [a] -> a
mconcat
[ Text
"<label for=\"sn-"
, String -> Text
pack (forall a. Show a => a -> String
show Int
i)
, Text
"\" class=\""
, Text
labelCls
, Text
"\">"
, Text
labelSym
, Text
"</label>"
]
let label :: Inline
label = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"html") Text
labelHTML
let inputHTML :: Text
inputHTML = forall a. Monoid a => [a] -> a
mconcat
[ Text
"<input type=\"checkbox\" id=\"sn-"
, String -> Text
pack (forall a. Show a => a -> String
show Int
i)
, Text
"\" "
, Text
"class=\"margin-toggle\"/>"
]
let input :: Inline
input = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"html") Text
inputHTML
let (Text
ident, [Text]
_, [(Text, Text)]
attrs) = (Text, [Text], [(Text, Text)])
nullAttr
let noteTypeCls :: Text
noteTypeCls = if Bool
nonu then Text
"marginnote" else Text
"sidenote"
let note :: Inline
note = (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
ident, [Text
noteTypeCls], [(Text, Text)]
attrs) [Inline]
content
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Inline] -> Inline
Span (Text
"", [Text
"sidenote-wrapper"], []) [Inline
label, Inline
input, Inline
note]
filterInline :: Inline -> State Int Inline
filterInline :: Inline -> State Int Inline
filterInline (Note [Block]
blocks) = do
case ([Block] -> (NoteType, [Block])
getFirstStr [Block]
blocks) of
(NoteType
FootNote, [Block]
blocks') -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> Inline
Note [Block]
blocks')
(NoteType
MarginNote, [Block]
blocks') -> Bool -> [Inline] -> State Int Inline
filterNote Bool
True ([Block] -> [Inline]
coerceToInline [Block]
blocks')
(NoteType
SideNote, [Block]
blocks') -> Bool -> [Inline] -> State Int Inline
filterNote Bool
False ([Block] -> [Inline]
coerceToInline [Block]
blocks')
filterInline Inline
inline = forall (m :: * -> *) a. Monad m => a -> m a
return Inline
inline
usingSideNotes :: Pandoc -> Pandoc
usingSideNotes :: Pandoc -> Pandoc
usingSideNotes (Pandoc Meta
meta [Block]
blocks) =
Meta -> [Block] -> Pandoc
Pandoc Meta
meta (forall s a. State s a -> s -> a
evalState (forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
walkM Inline -> State Int Inline
filterInline [Block]
blocks) Int
0)