{-# 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
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]

-- 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 <- 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

-- Extract inlines from blocks. Note has a [Block], but Span needs [Inline].
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
  -- Simulate paragraphs with double LineBreak
  deBlock (Para      [Inline]
ls    ) = [Inline]
ls forall a. [a] -> [a] -> [a]
++ [Inline]
newline
  -- See extension: line_blocks
  deBlock (LineBlock [[Inline]]
lss   ) = forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak] [[Inline]]
lss 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 = 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
  -- 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') -> 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)