{-
pandoc-crossref is a pandoc filter for numbering figures,
equations, tables and cross-references to them.
Copyright (C) 2015  Nikolay Yakimov <root@livid.pp.ru>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-}

{-# LANGUAGE OverloadedStrings, LambdaCase #-}
module Text.Pandoc.CrossRef.Util.CodeBlockCaptions
    (
    mkCodeBlockCaptions
    ) where

import Control.Monad.Reader (ask)
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Text.Pandoc.CrossRef.References.Monad
import Text.Pandoc.CrossRef.Util.Options
import Text.Pandoc.CrossRef.Util.Util
import Text.Pandoc.Definition

mkCodeBlockCaptions :: [Block] -> WS [Block]
mkCodeBlockCaptions :: [Block] -> WS [Block]
mkCodeBlockCaptions = \case
  x :: [Block]
x@(cb :: Block
cb@CodeBlock{}:p :: Block
p@Para{}:[Block]
xs) -> [Block] -> Block -> Block -> [Block] -> WS [Block]
go [Block]
x Block
p Block
cb [Block]
xs
  x :: [Block]
x@(p :: Block
p@Para{}:cb :: Block
cb@CodeBlock{}:[Block]
xs) -> [Block] -> Block -> Block -> [Block] -> WS [Block]
go [Block]
x Block
p Block
cb [Block]
xs
  [Block]
x -> [Block] -> WS [Block]
forall a. a -> WS a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Block]
x
  where
    go :: [Block] -> Block -> Block -> [Block] -> WS [Block]
    go :: [Block] -> Block -> Block -> [Block] -> WS [Block]
go [Block]
x Block
p Block
cb [Block]
xs = do
      Options
opts <- WS Options
forall r (m :: * -> *). MonadReader r m => m r
ask
      [Block] -> WS [Block]
forall a. a -> WS a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> WS [Block]) -> [Block] -> WS [Block]
forall a b. (a -> b) -> a -> b
$ [Block] -> Maybe [Block] -> [Block]
forall a. a -> Maybe a -> a
fromMaybe [Block]
x (Maybe [Block] -> [Block]) -> Maybe [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Options -> [Block] -> Maybe [Block]
orderAgnostic Options
opts ([Block] -> Maybe [Block]) -> [Block] -> Maybe [Block]
forall a b. (a -> b) -> a -> b
$ Block
pBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:Block
cbBlock -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
xs

orderAgnostic :: Options -> [Block] -> Maybe [Block]
orderAgnostic :: Options -> [Block] -> Maybe [Block]
orderAgnostic Options
opts (Para [Inline]
ils:CodeBlock (Text
label,[Text]
classes,[(Text, Text)]
attrs) Text
code:[Block]
xs)
  | Options -> Bool
codeBlockCaptions Options
opts
  , Just [Inline]
caption <- [Inline] -> Maybe [Inline]
getCodeBlockCaption [Inline]
ils
  , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
label
  , Text
"lst" Text -> Text -> Bool
`T.isPrefixOf` Text
label
  = [Block] -> Maybe [Block]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> Maybe [Block]) -> [Block] -> Maybe [Block]
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
label,[Text
"listing"], [])
      [[Inline] -> Block
Para [Inline]
caption, (Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text
"",[Text]
classes,[(Text, Text)]
attrs) Text
code] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
orderAgnostic Options
opts (Para [Inline]
ils:CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
attrs) Text
code:[Block]
xs)
  | Options -> Bool
codeBlockCaptions Options
opts
  , Just ([Inline]
caption, [Inline]
labinl) <- [Inline] -> ([Inline], [Inline])
forall {a}. [a] -> ([a], [a])
splitLast ([Inline] -> ([Inline], [Inline]))
-> Maybe [Inline] -> Maybe ([Inline], [Inline])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> Maybe [Inline]
getCodeBlockCaption [Inline]
ils
  , Just Text
label <- Text -> [Inline] -> Maybe Text
getRefLabel Text
"lst" [Inline]
labinl
  = [Block] -> Maybe [Block]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> Maybe [Block]) -> [Block] -> Maybe [Block]
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
label,[Text
"listing"], [])
      [[Inline] -> Block
Para ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
forall a. HasCallStack => [a] -> [a]
init [Inline]
caption, (Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text
"",[Text]
classes,[(Text, Text)]
attrs) Text
code] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs
  where
    splitLast :: [a] -> ([a], [a])
splitLast [a]
xs' = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs'
orderAgnostic Options
_ [Block]
_ = Maybe [Block]
forall a. Maybe a
Nothing

getCodeBlockCaption :: [Inline] -> Maybe [Inline]
getCodeBlockCaption :: [Inline] -> Maybe [Inline]
getCodeBlockCaption [Inline]
ils
  | Just [Inline]
caption <- [Text -> Inline
Str Text
"Listing:",Inline
Space] [Inline] -> [Inline] -> Maybe [Inline]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` [Inline]
ils
  = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
caption
  | Just [Inline]
caption <- [Text -> Inline
Str Text
":",Inline
Space] [Inline] -> [Inline] -> Maybe [Inline]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` [Inline]
ils
  = [Inline] -> Maybe [Inline]
forall a. a -> Maybe a
Just [Inline]
caption
  | Bool
otherwise
  = Maybe [Inline]
forall a. Maybe a
Nothing