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