    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Readers.Org
       Copyright   : © 2019-2020 Albert Krewinkel
       License     : GNU GPL, version 2 or above

       Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

    Conversion of jira wiki formatted plain text to 'Pandoc' document.
    -}
    module Text.Pandoc.Readers.Jira ( readJira ) where

    import Control.Monad.Except (throwError)
    import Data.Text (Text, append, pack, singleton, unpack)
    import Text.HTML.TagSoup.Entity (lookupEntity)
    import Text.Jira.Parser (parse)
    import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
    import Text.Pandoc.Builder
    import Text.Pandoc.Error (PandocError (PandocParseError))
    import Text.Pandoc.Options (ReaderOptions)
    import Text.Pandoc.Shared (stringify)

    import qualified Text.Jira.Markup as Jira

    -- | Read Jira wiki markup.
    readJira :: PandocMonad m
             => ReaderOptions
             -> Text
             -> m Pandoc
    readJira :: ReaderOptions -> Text -> m Pandoc
    readJira _opts :: ReaderOptions
    _opts s :: Text
    s = case Text -> Either ParseError Doc
    parse Text
    s of
      Right d :: Doc
    d -> Pandoc -> m Pandoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
    forall a b. (a -> b) -> a -> b
    $ Doc -> Pandoc
    jiraToPandoc Doc
    d
      Left e :: ParseError
    e  -> PandocError -> m Pandoc
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m Pandoc)
    -> (Text -> PandocError) -> Text -> m Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> PandocError
    PandocParseError (Text -> m Pandoc) -> Text -> m Pandoc
    forall a b. (a -> b) -> a -> b
    $
                 "Jira parse error" Text -> Text -> Text
    `append` String -> Text
    pack (ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    e)

    jiraToPandoc :: Jira.Doc -> Pandoc
    jiraToPandoc :: Doc -> Pandoc
    jiraToPandoc (Jira.Doc blks :: [Block]
    blks) = Blocks -> Pandoc
    doc (Blocks -> Pandoc) -> Blocks -> Pandoc
    forall a b. (a -> b) -> a -> b
    $ (Block -> Blocks) -> [Block] -> Blocks
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Blocks
    jiraToPandocBlocks [Block]
    blks

    --
    -- Blocks
    --

    -- | Converts a Jira block to a Pandoc block.
    jiraToPandocBlocks :: Jira.Block -> Blocks
    jiraToPandocBlocks :: Block -> Blocks
    jiraToPandocBlocks = \case
      Jira.BlockQuote blcks :: [Block]
    blcks -> Blocks -> Blocks
    blockQuote (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $ (Block -> Blocks) -> [Block] -> Blocks
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Blocks
    jiraToPandocBlocks [Block]
    blcks
      Jira.Code lang :: Language
    lang ps :: [Parameter]
    ps txt :: Text
    txt -> Maybe Language -> [Parameter] -> Text -> Blocks
    toPandocCodeBlocks (Language -> Maybe Language
    forall a. a -> Maybe a
    Just Language
    lang) [Parameter]
    ps Text
    txt
      Jira.Color c :: ColorName
    c blcks :: [Block]
    blcks    -> Attr -> Blocks -> Blocks
    divWith (Text
    forall a. Monoid a => a
    mempty, [Text]
    forall a. Monoid a => a
    mempty, [("color", ColorName -> Text
    colorName ColorName
    c)]) (Blocks -> Blocks) -> Blocks -> Blocks
    forall a b. (a -> b) -> a -> b
    $
                               (Block -> Blocks) -> [Block] -> Blocks
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Blocks
    jiraToPandocBlocks [Block]
    blcks
      Jira.Header lvl :: Int
    lvl inlns :: [Inline]
    inlns -> Int -> Inlines -> Blocks
    header Int
    lvl (Inlines -> Blocks) -> Inlines -> Blocks
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Inlines) -> [Inline] -> Inlines
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Inline -> Inlines
    jiraToPandocInlines [Inline]
    inlns
      Jira.HorizontalRule   -> Blocks
    horizontalRule
      Jira.List style :: ListStyle
    style items :: [[Block]]
    items -> ListStyle -> [[Block]] -> Blocks
    toPandocList ListStyle
    style [[Block]]
    items
      Jira.NoFormat ps :: [Parameter]
    ps txt :: Text
    txt  -> Maybe Language -> [Parameter] -> Text -> Blocks
    toPandocCodeBlocks Maybe Language
    forall a. Maybe a
    Nothing [Parameter]
    ps Text
    txt
      Jira.Panel ps :: [Parameter]
    ps blcks :: [Block]
    blcks   -> [Parameter] -> [Block] -> Blocks
    toPandocDiv [Parameter]
    ps [Block]
    blcks
      Jira.Para inlns :: [Inline]
    inlns       -> Inlines -> Blocks
    para (Inlines -> Blocks) -> Inlines -> Blocks
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Inlines) -> [Inline] -> Inlines
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Inline -> Inlines
    jiraToPandocInlines [Inline]
    inlns
      Jira.Table rows :: [Row]
    rows       -> [Row] -> Blocks
    toPandocTable [Row]
    rows

    -- | Create a pandoc list – either to a @'BulletList'@ or an @'OrderedList'@.
    toPandocList :: Jira.ListStyle -> [[Jira.Block]] -> Blocks
    toPandocList :: ListStyle -> [[Block]] -> Blocks
    toPandocList style :: ListStyle
    style items :: [[Block]]
    items =
      let items' :: [Blocks]
    items' = ([Block] -> Blocks) -> [[Block]] -> [Blocks]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Block -> Blocks) -> [Block] -> Blocks
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Blocks
    jiraToPandocBlocks) [[Block]]
    items
      in if ListStyle
    style ListStyle -> ListStyle -> Bool
    forall a. Eq a => a -> a -> Bool
    == ListStyle
    Jira.Enumeration
         then [Blocks] -> Blocks
    orderedList [Blocks]
    items'
         else [Blocks] -> Blocks
    bulletList [Blocks]
    items'

    -- | Create a pandoc @'CodeBlock'@
    toPandocCodeBlocks :: Maybe Jira.Language -> [Jira.Parameter] -> Text -> Blocks
    toPandocCodeBlocks :: Maybe Language -> [Parameter] -> Text -> Blocks
    toPandocCodeBlocks langMay :: Maybe Language
    langMay params :: [Parameter]
    params txt :: Text
    txt =
      let classes :: [Text]
    classes = case Maybe Language
    langMay of
                      Just (Jira.Language lang :: Text
    lang) -> [Text
    lang]
                      Nothing                   -> []
      in Attr -> Text -> Blocks
    codeBlockWith ("", [Text]
    classes, (Parameter -> (Text, Text)) -> [Parameter] -> [(Text, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map Parameter -> (Text, Text)
    paramToPair [Parameter]
    params) Text
    txt

    -- | Create a pandoc @'Div'@
    toPandocDiv :: [Jira.Parameter] -> [Jira.Block] -> Blocks
    toPandocDiv :: [Parameter] -> [Block] -> Blocks
    toPandocDiv params :: [Parameter]
    params =
      Attr -> Blocks -> Blocks
    divWith ("", [], (Parameter -> (Text, Text)) -> [Parameter] -> [(Text, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map Parameter -> (Text, Text)
    paramToPair [Parameter]
    params) (Blocks -> Blocks) -> ([Block] -> Blocks) -> [Block] -> Blocks
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Block -> Blocks) -> [Block] -> Blocks
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Blocks
    jiraToPandocBlocks

    paramToPair :: Jira.Parameter -> (Text, Text)
    paramToPair :: Parameter -> (Text, Text)
    paramToPair (Jira.Parameter key :: Text
    key value :: Text
    value) = (Text
    key, Text
    value)

    -- | Give textual representation of a color.
    colorName :: Jira.ColorName -> Text
    colorName :: ColorName -> Text
    colorName (Jira.ColorName name :: Text
    name) = Text
    name

    -- | Create a pandoc @'Table'@.
    -- This relies on 'simpleTable' to sanitize the table.
    toPandocTable :: [Jira.Row] -> Blocks
    toPandocTable :: [Row] -> Blocks
    toPandocTable rows :: [Row]
    rows =
      let (headerRow :: Row
    headerRow, bodyRows :: [Row]
    bodyRows) = [Row] -> (Row, [Row])
    splitIntoHeaderAndBody [Row]
    rows
      in [Blocks] -> [[Blocks]] -> Blocks
    simpleTable
           (Row -> [Blocks]
    rowToBlocksList Row
    headerRow)
           ((Row -> [Blocks]) -> [Row] -> [[Blocks]]
    forall a b. (a -> b) -> [a] -> [b]
    map Row -> [Blocks]
    rowToBlocksList [Row]
    bodyRows)

    rowToBlocksList :: Jira.Row -> [Blocks]
    rowToBlocksList :: Row -> [Blocks]
    rowToBlocksList (Jira.Row cells :: [Cell]
    cells) =
      (Cell -> Blocks) -> [Cell] -> [Blocks]
    forall a b. (a -> b) -> [a] -> [b]
    map Cell -> Blocks
    cellContent [Cell]
    cells
      where
        cellContent :: Cell -> Blocks
    cellContent cell :: Cell
    cell = let content :: [Block]
    content = case Cell
    cell of
                                 Jira.HeaderCell x -> [Block]
    x
                                 Jira.BodyCell x   -> [Block]
    x
                           in (Block -> Blocks) -> [Block] -> Blocks
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Block -> Blocks
    jiraToPandocBlocks [Block]
    content

    splitIntoHeaderAndBody :: [Jira.Row] -> (Jira.Row, [Jira.Row])
    splitIntoHeaderAndBody :: [Row] -> (Row, [Row])
    splitIntoHeaderAndBody [] = ([Cell] -> Row
    Jira.Row [], [])
    splitIntoHeaderAndBody rows :: [Row]
    rows@(first :: Row
    first@(Jira.Row cells :: [Cell]
    cells) : rest :: [Row]
    rest) =
      let isHeaderCell :: Cell -> Bool
    isHeaderCell Jira.HeaderCell{} = Bool
    True
          isHeaderCell Jira.BodyCell{}   = Bool
    False
      in if (Cell -> Bool) -> [Cell] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Cell -> Bool
    isHeaderCell [Cell]
    cells
         then (Row
    first, [Row]
    rest)
         else ([Cell] -> Row
    Jira.Row [], [Row]
    rows)

    --
    -- Inlines
    --

    -- | Converts a Jira inline to a Pandoc block.
    jiraToPandocInlines :: Jira.Inline -> Inlines
    jiraToPandocInlines :: Inline -> Inlines
    jiraToPandocInlines = \case
      Jira.Anchor t :: Text
    t          -> Attr -> Inlines -> Inlines
    spanWith (Text
    t, [], []) Inlines
    forall a. Monoid a => a
    mempty
      Jira.AutoLink url :: URL
    url      -> Text -> Text -> Inlines -> Inlines
    link (URL -> Text
    Jira.fromURL URL
    url) "" (Text -> Inlines
    str (URL -> Text
    Jira.fromURL URL
    url))
      Jira.ColorInline c :: ColorName
    c ils :: [Inline]
    ils -> Attr -> Inlines -> Inlines
    spanWith ("", [], [("color", ColorName -> Text
    colorName ColorName
    c)]) (Inlines -> Inlines) -> Inlines -> Inlines
    forall a b. (a -> b) -> a -> b
    $
                                         [Inline] -> Inlines
    fromInlines [Inline]
    ils
      Jira.Emoji icon :: Icon
    icon        -> Text -> Inlines
    str (Text -> Inlines) -> (Icon -> Text) -> Icon -> Inlines
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Icon -> Text
    iconUnicode (Icon -> Inlines) -> Icon -> Inlines
    forall a b. (a -> b) -> a -> b
    $ Icon
    icon
      Jira.Entity entity :: Text
    entity     -> Text -> Inlines
    str (Text -> Inlines) -> (Text -> Text) -> Text -> Inlines
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    fromEntity (Text -> Inlines) -> Text -> Inlines
    forall a b. (a -> b) -> a -> b
    $ Text
    entity
      Jira.Image _ url :: URL
    url       -> Text -> Text -> Inlines -> Inlines
    image (URL -> Text
    Jira.fromURL URL
    url)  "" Inlines
    forall a. Monoid a => a
    mempty
      Jira.Link alias :: [Inline]
    alias url :: URL
    url    -> Text -> Text -> Inlines -> Inlines
    link (URL -> Text
    Jira.fromURL URL
    url) "" ([Inline] -> Inlines
    fromInlines [Inline]
    alias)
      Jira.Linebreak         -> Inlines
    linebreak
      Jira.Monospaced inlns :: [Inline]
    inlns  -> Text -> Inlines
    code (Text -> Inlines) -> ([Inline] -> Text) -> [Inline] -> Inlines
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Inline] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify ([Inline] -> Text) -> ([Inline] -> [Inline]) -> [Inline] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Inlines -> [Inline]
    forall a. Many a -> [a]
    toList (Inlines -> [Inline])
    -> ([Inline] -> Inlines) -> [Inline] -> [Inline]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Inline] -> Inlines
    fromInlines ([Inline] -> Inlines) -> [Inline] -> Inlines
    forall a b. (a -> b) -> a -> b
    $ [Inline]
    inlns
      Jira.Space             -> Inlines
    space
      Jira.SpecialChar c :: Char
    c     -> Text -> Inlines
    str (Char -> Text
    Data.Text.singleton Char
    c)
      Jira.Str t :: Text
    t             -> Text -> Inlines
    str Text
    t
      Jira.Styled style :: InlineStyle
    style inlns :: [Inline]
    inlns -> InlineStyle -> Inlines -> Inlines
    fromStyle InlineStyle
    style (Inlines -> Inlines) -> Inlines -> Inlines
    forall a b. (a -> b) -> a -> b
    $ [Inline] -> Inlines
    fromInlines [Inline]
    inlns
      where
        fromInlines :: [Inline] -> Inlines
    fromInlines  = (Inline -> Inlines) -> [Inline] -> Inlines
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Inline -> Inlines
    jiraToPandocInlines
        fromEntity :: Text -> Text
    fromEntity e :: Text
    e = case String -> Maybe String
    lookupEntity (Text -> String
    unpack Text
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ";") of
                         Nothing -> "&" Text -> Text -> Text
    `append` Text
    e Text -> Text -> Text
    `append` ";"
                         Just cs :: String
    cs -> String -> Text
    pack String
    cs

        fromStyle :: InlineStyle -> Inlines -> Inlines
    fromStyle = \case
          Jira.Emphasis    -> Inlines -> Inlines
    emph
          Jira.Insert      -> Attr -> Inlines -> Inlines
    spanWith ("", ["inserted"], [])
          Jira.Strikeout   -> Inlines -> Inlines
    strikeout
          Jira.Strong      -> Inlines -> Inlines
    strong
          Jira.Subscript   -> Inlines -> Inlines
    subscript
          Jira.Superscript -> Inlines -> Inlines
    superscript

    -- | Get unicode representation of a Jira icon.
    iconUnicode :: Jira.Icon -> Text
    iconUnicode :: Icon -> Text
    iconUnicode = \case
      Jira.IconSlightlySmiling -> "🙂"
      Jira.IconFrowning        -> "🙁"
      Jira.IconTongue          -> "😛"
      Jira.IconSmiling         -> "😃"
      Jira.IconWinking         -> "😉"
      Jira.IconThumbsUp        -> "👍"
      Jira.IconThumbsDown      -> "👎"
      Jira.IconInfo            -> "ℹ"
      Jira.IconCheckmark       -> "✓"
      Jira.IconX               -> "🅇"
      Jira.IconAttention       -> "⚠"
      Jira.IconPlus            -> "⊞"
      Jira.IconMinus           -> "⊟"
      Jira.IconQuestionmark    -> "?"
      Jira.IconOn              -> "💡"
      Jira.IconOff             -> "💡"
      Jira.IconStar            -> "★"
      Jira.IconStarRed         -> "★"
      Jira.IconStarGreen       -> "★"
      Jira.IconStarBlue        -> "★"
      Jira.IconStarYellow      -> "★"
      Jira.IconFlag            -> "⚑"
      Jira.IconFlagOff         -> "⚐"