{-# 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
  | FootNote
  deriving (Int -> NoteType -> ShowS
[NoteType] -> ShowS
NoteType -> String
(Int -> NoteType -> ShowS)
-> (NoteType -> String) -> ([NoteType] -> ShowS) -> Show NoteType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoteType -> ShowS
showsPrec :: Int -> NoteType -> ShowS
$cshow :: NoteType -> String
show :: NoteType -> String
$cshowList :: [NoteType] -> ShowS
showList :: [NoteType] -> ShowS
Show, NoteType -> NoteType -> Bool
(NoteType -> NoteType -> Bool)
-> (NoteType -> NoteType -> Bool) -> Eq NoteType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoteType -> NoteType -> Bool
== :: NoteType -> NoteType -> Bool
$c/= :: NoteType -> NoteType -> Bool
/= :: 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)Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
blocks')
    Plain ((Str Text
"{.}"):Inline
Space:[Inline]
rest) -> (NoteType
FootNote, ([Inline] -> Block
Plain [Inline]
rest)Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
blocks')
    Para ((Str Text
"{-}"):Inline
Space:[Inline]
rest) -> (NoteType
MarginNote, ([Inline] -> Block
Para [Inline]
rest)Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
blocks')
    Para ((Str Text
"{.}"):Inline
Space:[Inline]
rest) -> (NoteType
FootNote, ([Inline] -> Block
Para [Inline]
rest)Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
blocks')
    LineBlock (((Str Text
"{-}"):Inline
Space:[Inline]
rest):[[Inline]]
rest') -> (NoteType
MarginNote, ([[Inline]] -> Block
LineBlock ([Inline]
rest[Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
:[[Inline]]
rest'))Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
blocks')
    LineBlock (((Str Text
"{.}"):Inline
Space:[Inline]
rest):[[Inline]]
rest') -> (NoteType
FootNote, ([[Inline]] -> Block
LineBlock ([Inline]
rest[Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
:[[Inline]]
rest'))Block -> [Block] -> [Block]
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]

-- This could be implemented more concisely, but I think this is more clear.
getThenIncr :: State Int Int
getThenIncr :: State Int Int
getThenIncr = do
  Int
i <- State Int Int
forall s (m :: * -> *). MonadState s m => m s
get
  Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int -> State Int Int
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i

-- Extract inlines from blocks. Note has a [Block], but Span needs [Inline].
coerceToInline :: [Block] -> [Inline]
coerceToInline :: [Block] -> [Inline]
coerceToInline = (Block -> [Inline]) -> [Block] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Inline]
deBlock ([Block] -> [Inline])
-> ([Block] -> [Block]) -> [Block] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Block] -> [Block]
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
  -- Simulate paragraphs with double LineBreak
  deBlock (Para      [Inline]
ls    ) = [Inline]
ls [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
newline
  -- See extension: line_blocks
  deBlock (LineBlock [[Inline]]
lss   ) = [Inline] -> [[Inline]] -> [Inline]
forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lss [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
newline
  -- Pretend RawBlock is RawInline (might not work!)
  -- Consider: raw <div> now inside RawInline... what happens?
  deBlock (RawBlock Format
fmt Text
str) = [Format -> Text -> Inline
RawInline Format
fmt Text
str]
  -- lists, blockquotes, headers, hrs, and tables are all omitted
  -- Think they shouldn't be? I'm open to sensible PR's.
  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
  -- Generate a unique number for the 'for=' attribute
  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
"&#8853;" else Text
""
  let labelHTML :: Text
labelHTML = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
         [ Text
"<label for=\"sn-"
         , String -> Text
pack (Int -> String
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 = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"<input type=\"checkbox\" id=\"sn-"
        , String -> Text
pack (Int -> String
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

  Inline -> State Int Inline
forall a. a -> StateT Int Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> State Int Inline) -> Inline -> State Int Inline
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
  -- The '{-}' symbol differentiates between margin note and side note
  -- Also '{.}' indicates whether to leave the footnote untouched (a footnote)
  case ([Block] -> (NoteType, [Block])
getFirstStr [Block]
blocks) of
    (NoteType
FootNote, [Block]
blocks') -> Inline -> State Int Inline
forall a. a -> StateT Int Identity a
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 = Inline -> State Int Inline
forall a. a -> StateT Int Identity a
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 (State Int [Block] -> Int -> [Block]
forall s a. State s a -> s -> a
evalState ((Inline -> State Int Inline) -> [Block] -> State Int [Block]
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Inline -> m Inline) -> [Block] -> m [Block]
walkM Inline -> State Int Inline
filterInline [Block]
blocks) Int
0)