module Text.BlogLiterately.Block
(
unTag
, onTag
) where
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc (Attr, Block (CodeBlock))
import Text.Parsec
import Text.Parsec.Text
unTag :: Text -> (Maybe Text, Text)
unTag :: Text -> (Maybe Text, Text)
unTag Text
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const (forall a. Maybe a
Nothing, Text
s)) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse Parser (Maybe Text, Text)
tag SourceName
"" Text
s
where
tag :: Parser (Maybe Text, Text)
tag :: Parser (Maybe Text, Text)
tag = do
Text
tg <- SourceName -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
noneOf SourceName
"[]")
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m Char
oneOf SourceName
" \t"
SourceName
_ <- (forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"\r\n" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
SourceName -> ParsecT s u m SourceName
string SourceName
"\n")
Text
txt <- SourceName -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
tg, Text
txt)
onTag :: Text -> (Attr -> Text -> a) -> (Block -> a) -> Block -> a
onTag :: forall a. Text -> (Attr -> Text -> a) -> (Block -> a) -> Block -> a
onTag Text
t Attr -> Text -> a
f Block -> a
def b :: Block
b@(CodeBlock attr :: Attr
attr@(Text
_, [Text]
as, [(Text, Text)]
_) Text
s)
| Text -> Text
T.toLower Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (:) Maybe Text
tag forall a b. (a -> b) -> a -> b
$ [Text]
as)
= Attr -> Text -> a
f Attr
attr Text
src
| Bool
otherwise = Block -> a
def Block
b
where (Maybe Text
tag, Text
src) = Text -> (Maybe Text, Text)
unTag Text
s
onTag Text
_ Attr -> Text -> a
_ Block -> a
def Block
b = Block -> a
def Block
b