{-# 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 -> 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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [Block]
x forall a b. (a -> b) -> a -> b
$ Options -> [Block] -> Maybe [Block]
orderAgnostic Options
opts forall a b. (a -> b) -> a -> b
$ Block
pforall a. a -> [a] -> [a]
:Block
cbforall 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 forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
label
, Text
"lst" Text -> Text -> Bool
`T.isPrefixOf` Text
label
= forall (m :: * -> *) a. Monad m => a -> m a
return 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] 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) <- forall {a}. [a] -> ([a], [a])
splitLast 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
= forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
label,[Text
"listing"], [])
[[Inline] -> Block
Para forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [Inline]
caption, (Text, [Text], [(Text, Text)]) -> Text -> Block
CodeBlock (Text
"",[Text]
classes,[(Text, Text)]
attrs) Text
code] forall a. a -> [a] -> [a]
: [Block]
xs
where
splitLast :: [a] -> ([a], [a])
splitLast [a]
xs' = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs' forall a. Num a => a -> a -> a
- Int
1) [a]
xs'
orderAgnostic Options
_ [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] forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` [Inline]
ils
= forall a. a -> Maybe a
Just [Inline]
caption
| Just [Inline]
caption <- [Text -> Inline
Str Text
":",Inline
Space] forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` [Inline]
ils
= forall a. a -> Maybe a
Just [Inline]
caption
| Bool
otherwise
= forall a. Maybe a
Nothing