    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Text.Pandoc.SideNote (usingSideNotes) where

    import           Data.List           (intercalate)
    import           Data.Text           (Text, append, pack)

    import           Control.Monad.State

    import           Text.Pandoc.JSON
    import           Text.Pandoc.Walk    (walk, walkM)

    getFirstStr :: [Inline] -> Maybe Text
    getFirstStr :: [Inline] -> Maybe Text
    getFirstStr []                 = Maybe Text
    forall a. Maybe a
    Nothing
    getFirstStr (Str text :: Text
    text:_      ) = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    text
    getFirstStr (_       :inlines :: [Inline]
    inlines) = [Inline] -> Maybe Text
    getFirstStr [Inline]
    inlines

    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
    + 1)
      Int -> State Int Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    i

    -- Extract inlines from blocks
    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     ls :: [Inline]
    ls    ) = [Inline]
    ls
      -- Simulate paragraphs with double LineBreak
      deBlock (Para      ls :: [Inline]
    ls    ) = [Inline]
    ls [Inline] -> [Inline] -> [Inline]
    forall a. [a] -> [a] -> [a]
    ++ [Inline]
    newline
      -- See extension: line_blocks
      deBlock (LineBlock lss :: [[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 fmt :: Format
    fmt str :: 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 _                  = []

      deNote :: Inline -> Inline
    deNote (Note _) = Text -> Inline
    Str ""
      deNote x :: Inline
    x        = Inline
    x

    filterInline :: Inline -> State Int Inline
    filterInline :: Inline -> State Int Inline
    filterInline (Note blocks :: [Block]
    blocks) = do
      -- Generate a unique number for the 'for=' attribute
      Int
    i <- State Int Int
    getThenIncr

      -- Note has a [Block], but Span needs [Inline]
      let content :: [Inline]
    content  = [Block] -> [Inline]
    coerceToInline [Block]
    blocks

      -- The '{-}' symbol differentiates between margin note and side note
      let nonu :: Bool
    nonu     = [Inline] -> Maybe Text
    getFirstStr [Inline]
    content Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just "{-}"
      let content' :: [Inline]
    content' = if Bool
    nonu then [Inline] -> [Inline]
    forall a. [a] -> [a]
    tail [Inline]
    content else [Inline]
    content

      let labelCls :: Text
    labelCls = "margin-toggle" Text -> Text -> Text
    `append`
                     (if Bool
    nonu then "" else " sidenote-number")
      let labelSym :: Text
    labelSym = if Bool
    nonu then "&#8853;" else ""
      let labelHTML :: Text
    labelHTML = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat
             [ "<label for=\"sn-"
             , String -> Text
    pack (Int -> String
    forall a. Show a => a -> String
    show Int
    i)
             , "\" class=\""
             , Text
    labelCls
             , "\">"
             , Text
    labelSym
             , "</label>"
             ]
      let label :: Inline
    label = Format -> Text -> Inline
    RawInline (Text -> Format
    Format "html") Text
    labelHTML

      let inputHTML :: Text
    inputHTML = [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat
            [ "<input type=\"checkbox\" id=\"sn-"
            , String -> Text
    pack (Int -> String
    forall a. Show a => a -> String
    show Int
    i)
            , "\" "
            , "class=\"margin-toggle\"/>"
            ]
      let input :: Inline
    input             = Format -> Text -> Inline
    RawInline (Text -> Format
    Format "html") Text
    inputHTML

      let (ident :: Text
    ident, _, attrs :: [(Text, Text)]
    attrs) = (Text, [Text], [(Text, Text)])
    nullAttr
      let noteTypeCls :: Text
    noteTypeCls       = if Bool
    nonu then "marginnote" else "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 (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 ("", ["sidenote-wrapper"], []) [Inline
    label, Inline
    input, Inline
    note]

    filterInline inline :: Inline
    inline = Inline -> State Int Inline
    forall (m :: * -> *) a. Monad m => a -> m a
    return Inline
    inline

    usingSideNotes :: Pandoc -> Pandoc
    usingSideNotes :: Pandoc -> Pandoc
    usingSideNotes (Pandoc meta :: Meta
    meta blocks :: [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
    walkM Inline -> State Int Inline
    filterInline [Block]
    blocks) 0)