{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Query
(
transform,
Query(..),
Formatter(..),
Expression(..),
SortOrder(..),
satisfies
)
where
import Prelude hiding (concat)
import Data.List (sortOn)
import Data.Text qualified as T
import Text.Pandoc qualified as P
import Text.Pandoc.Util (meta, body, parseMarkdown)
import Text.Pandoc.Metadata (valueOf)
import Text.Pandoc.Walk (walkM)
import Text.Read (readEither)
data Query = Query Expression Formatter SortOrder deriving (ReadPrec [Query]
ReadPrec Query
Int -> ReadS Query
ReadS [Query]
(Int -> ReadS Query)
-> ReadS [Query]
-> ReadPrec Query
-> ReadPrec [Query]
-> Read Query
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Query
readsPrec :: Int -> ReadS Query
$creadList :: ReadS [Query]
readList :: ReadS [Query]
$creadPrec :: ReadPrec Query
readPrec :: ReadPrec Query
$creadListPrec :: ReadPrec [Query]
readListPrec :: ReadPrec [Query]
Read, Int -> Query -> ShowS
[Query] -> ShowS
Query -> [Char]
(Int -> Query -> ShowS)
-> (Query -> [Char]) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Query -> ShowS
showsPrec :: Int -> Query -> ShowS
$cshow :: Query -> [Char]
show :: Query -> [Char]
$cshowList :: [Query] -> ShowS
showList :: [Query] -> ShowS
Show)
data Formatter = ParseFromMarkdown T.Text deriving (ReadPrec [Formatter]
ReadPrec Formatter
Int -> ReadS Formatter
ReadS [Formatter]
(Int -> ReadS Formatter)
-> ReadS [Formatter]
-> ReadPrec Formatter
-> ReadPrec [Formatter]
-> Read Formatter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Formatter
readsPrec :: Int -> ReadS Formatter
$creadList :: ReadS [Formatter]
readList :: ReadS [Formatter]
$creadPrec :: ReadPrec Formatter
readPrec :: ReadPrec Formatter
$creadListPrec :: ReadPrec [Formatter]
readListPrec :: ReadPrec [Formatter]
Read, Int -> Formatter -> ShowS
[Formatter] -> ShowS
Formatter -> [Char]
(Int -> Formatter -> ShowS)
-> (Formatter -> [Char])
-> ([Formatter] -> ShowS)
-> Show Formatter
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Formatter -> ShowS
showsPrec :: Int -> Formatter -> ShowS
$cshow :: Formatter -> [Char]
show :: Formatter -> [Char]
$cshowList :: [Formatter] -> ShowS
showList :: [Formatter] -> ShowS
Show)
data Expression = MetaValueIs T.Text T.Text
| MetaValueIncludes T.Text T.Text
| All
| And Expression Expression
| Or Expression Expression
| Not Expression deriving (ReadPrec [Expression]
ReadPrec Expression
Int -> ReadS Expression
ReadS [Expression]
(Int -> ReadS Expression)
-> ReadS [Expression]
-> ReadPrec Expression
-> ReadPrec [Expression]
-> Read Expression
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Expression
readsPrec :: Int -> ReadS Expression
$creadList :: ReadS [Expression]
readList :: ReadS [Expression]
$creadPrec :: ReadPrec Expression
readPrec :: ReadPrec Expression
$creadListPrec :: ReadPrec [Expression]
readListPrec :: ReadPrec [Expression]
Read, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> [Char]
(Int -> Expression -> ShowS)
-> (Expression -> [Char])
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expression -> ShowS
showsPrec :: Int -> Expression -> ShowS
$cshow :: Expression -> [Char]
show :: Expression -> [Char]
$cshowList :: [Expression] -> ShowS
showList :: [Expression] -> ShowS
Show)
data SortOrder = Ascending T.Text | Descending T.Text deriving (ReadPrec [SortOrder]
ReadPrec SortOrder
Int -> ReadS SortOrder
ReadS [SortOrder]
(Int -> ReadS SortOrder)
-> ReadS [SortOrder]
-> ReadPrec SortOrder
-> ReadPrec [SortOrder]
-> Read SortOrder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SortOrder
readsPrec :: Int -> ReadS SortOrder
$creadList :: ReadS [SortOrder]
readList :: ReadS [SortOrder]
$creadPrec :: ReadPrec SortOrder
readPrec :: ReadPrec SortOrder
$creadListPrec :: ReadPrec [SortOrder]
readListPrec :: ReadPrec [SortOrder]
Read, Int -> SortOrder -> ShowS
[SortOrder] -> ShowS
SortOrder -> [Char]
(Int -> SortOrder -> ShowS)
-> (SortOrder -> [Char])
-> ([SortOrder] -> ShowS)
-> Show SortOrder
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortOrder -> ShowS
showsPrec :: Int -> SortOrder -> ShowS
$cshow :: SortOrder -> [Char]
show :: SortOrder -> [Char]
$cshowList :: [SortOrder] -> ShowS
showList :: [SortOrder] -> ShowS
Show)
satisfies :: P.Pandoc -> Expression -> Bool
Pandoc
p satisfies :: Pandoc -> Expression -> Bool
`satisfies` (MetaValueIs Text
k Text
v) = (Pandoc -> Meta
meta Pandoc
p) Meta -> Text -> [Text]
`valueOf` Text
k [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
v]
Pandoc
p `satisfies` (MetaValueIncludes Text
k Text
v) = Text
v Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ( (Pandoc -> Meta
meta Pandoc
p) Meta -> Text -> [Text]
`valueOf` Text
k )
Pandoc
_ `satisfies` Expression
All = Bool
True
Pandoc
p `satisfies` (And Expression
a Expression
b) = (Pandoc
p Pandoc -> Expression -> Bool
`satisfies` Expression
a) Bool -> Bool -> Bool
&& (Pandoc
p Pandoc -> Expression -> Bool
`satisfies` Expression
b)
Pandoc
p `satisfies` (Or Expression
a Expression
b) = (Pandoc
p Pandoc -> Expression -> Bool
`satisfies` Expression
a) Bool -> Bool -> Bool
|| (Pandoc
p Pandoc -> Expression -> Bool
`satisfies` Expression
b)
Pandoc
p `satisfies` (Not Expression
x) = Bool -> Bool
not (Pandoc
p Pandoc -> Expression -> Bool
`satisfies` Expression
x)
transform :: [P.Pandoc] -> P.Pandoc -> IO P.Pandoc
transform :: [Pandoc] -> Pandoc -> IO Pandoc
transform [Pandoc]
ps = (Block -> IO Block) -> Pandoc -> IO Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> Pandoc -> m Pandoc
walkM ([Pandoc] -> Block -> IO Block
runQueries [Pandoc]
ps)
runQueries :: [P.Pandoc] -> P.Block -> IO P.Block
runQueries :: [Pandoc] -> Block -> IO Block
runQueries [Pandoc]
ps x :: Block
x@(P.CodeBlock (Text
_,[Text]
cs,[(Text, Text)]
_) Text
s)
| [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cs = Block -> IO Block
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
| [Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
cs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"pandoc-query" = Query -> [Pandoc] -> IO Block
run (Text -> Query
parse Text
s) [Pandoc]
ps
| Bool
otherwise = Block -> IO Block
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
runQueries [Pandoc]
_ Block
x = Block -> IO Block
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Block
x
run :: Query -> [P.Pandoc] -> IO P.Block
run :: Query -> [Pandoc] -> IO Block
run (Query Expression
e Formatter
f SortOrder
s) [Pandoc]
ps = Formatter -> [Pandoc] -> IO Block
formatResults Formatter
f (SortOrder -> [Pandoc] -> [Pandoc]
runSort SortOrder
s ([Pandoc] -> [Pandoc]) -> [Pandoc] -> [Pandoc]
forall a b. (a -> b) -> a -> b
$ Expression -> [Pandoc] -> [Pandoc]
runQuery Expression
e [Pandoc]
ps)
parse :: T.Text -> Query
parse :: Text -> Query
parse Text
t =
case [Char] -> Either [Char] Query
forall a. Read a => [Char] -> Either [Char] a
readEither [Char]
s of
Right Query
q -> Query
q
Left [Char]
msg -> [Char] -> Query
forall a. HasCallStack => [Char] -> a
error ([Char]
msg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" while parsing query '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"'")
where s :: [Char]
s = Text -> [Char]
T.unpack Text
t
runQuery :: Expression -> [P.Pandoc] -> [P.Pandoc]
runQuery :: Expression -> [Pandoc] -> [Pandoc]
runQuery Expression
c = (Pandoc -> Bool) -> [Pandoc] -> [Pandoc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pandoc -> Expression -> Bool
`satisfies` Expression
c)
runSort :: SortOrder -> [P.Pandoc] -> [P.Pandoc]
runSort :: SortOrder -> [Pandoc] -> [Pandoc]
runSort (Ascending Text
k) = (Pandoc -> [Text]) -> [Pandoc] -> [Pandoc]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\Pandoc
p -> (Pandoc -> Meta
meta Pandoc
p) Meta -> Text -> [Text]
`valueOf` Text
k)
runSort (Descending Text
k) = [Pandoc] -> [Pandoc]
forall a. [a] -> [a]
reverse ([Pandoc] -> [Pandoc])
-> ([Pandoc] -> [Pandoc]) -> [Pandoc] -> [Pandoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SortOrder -> [Pandoc] -> [Pandoc]
runSort (Text -> SortOrder
Ascending Text
k)
formatResults :: Formatter -> [P.Pandoc] -> IO P.Block
formatResults :: Formatter -> [Pandoc] -> IO Block
formatResults f :: Formatter
f@(ParseFromMarkdown {}) [Pandoc]
ps = do
[Block]
bs <- Pandoc -> [Block]
body (Pandoc -> [Block]) -> IO Pandoc -> IO [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Pandoc
parseMarkdown ([Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Pandoc -> Text) -> [Pandoc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Formatter -> Meta -> Text
format Formatter
f (Meta -> Text) -> (Pandoc -> Meta) -> Pandoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> Meta
meta) [Pandoc]
ps)
Block -> IO Block
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> IO Block) -> Block -> IO Block
forall a b. (a -> b) -> a -> b
$
if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
bs
then [Inline] -> Block
P.Plain [ [Inline] -> Inline
P.Emph [Text -> Inline
P.Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show ([Pandoc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pandoc]
ps)) Text -> Text -> Text
`T.append` Text
" documents found"] ]
else [Block] -> Block
forall a. HasCallStack => [a] -> a
head [Block]
bs
format :: Formatter -> P.Meta -> T.Text
format :: Formatter -> Meta -> Text
format (ParseFromMarkdown Text
s) Meta
m = Meta -> Text -> Text
expandVars Meta
m Text
s
expandVars :: P.Meta -> T.Text -> T.Text
expandVars :: Meta -> Text -> Text
expandVars Meta
m Text
t = [Text] -> Text
T.concat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Meta -> Text -> Text
expandVar Meta
m) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
separateVars Text
t
expandVar :: P.Meta -> T.Text -> T.Text
expandVar :: Meta -> Text -> Text
expandVar Meta
m Text
s =
case Text -> Maybe Text
extractKey Text
s of
Just Text
t -> [Text] -> Text
forall a. HasCallStack => [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Meta
m Meta -> Text -> [Text]
`valueOf` Text
t
Maybe Text
Nothing -> Text
s
extractKey :: T.Text -> Maybe T.Text
Text
s =
if (Int -> Text -> Text
T.take Int
2 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"{{") Bool -> Bool -> Bool
&& (Int -> Text -> Text
T.takeEnd Int
2 Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"}}")
then (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.dropEnd Int
2 (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
2 Text
s)
else Maybe Text
forall a. Maybe a
Nothing
separateVars :: T.Text -> [T.Text]
separateVars :: Text -> [Text]
separateVars Text
t = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> [Text]
separateVarsHelper [] Text
t
separateVarsHelper :: [T.Text] -> T.Text -> [T.Text]
separateVarsHelper :: [Text] -> Text -> [Text]
separateVarsHelper [Text]
ss Text
s
| Text -> Bool
T.null Text
s3 = [Text]
ss'
| Bool
otherwise = [Text] -> Text -> [Text]
separateVarsHelper [Text]
ss' Text
s3
where (Text
s1, Text
s2, Text
s3) = Text -> (Text, Text, Text)
breakAroundVariable Text
s
ss' :: [Text]
ss' = Text
s2Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
s1Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ss
breakAroundVariable :: T.Text -> (T.Text, T.Text, T.Text)
breakAroundVariable :: Text -> (Text, Text, Text)
breakAroundVariable Text
s =
if Text -> Bool
T.null Text
s2
then (Text
s1, Text
"", Text
"")
else (Text
s1, Text -> Text -> Text
T.append Text
s3 Text
"}}", Int -> Text -> Text
T.drop Int
2 Text
s4)
where (Text
s1, Text
s2) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"{{" Text
s
(Text
s3, Text
s4) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"}}" Text
s2