{-|
Module      : Query
Description : Provides a way to run queries in Markdown.
Copyright   : (c) 2023 Amy de Buitléir
License     : GPL-3.0-only
Maintainer  : amy@nualeargais.ie
Stability   : experimental
Portability : POSIX

See <https://github.com/mhwombat/pandoc-maths-web> for information
on how to use this filter.
-}

{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Query
  (
    -- the star of the show
    transform,
    -- supporting cast members
    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)

-- |
-- Represents an executable query and specifies how to format the results.
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)

-- |
-- Specifies how to format the query results.
-- Currently results can only be specified using markdown syntax.
-- However, the query results will be parsed into Pandoc's native format
-- and inserted into the document.
-- So the resulting document can be output in any format supported by Pandoc.
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)

-- | Document filter for query.
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)

-- | Order in which the selected documents should be presented.
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)

-- | Returns true if the document satisfies the expression; returns false otherwise.
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)

-- |
-- Replaces any executable queries in a Pandoc document with the formatted result of the query.
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)

-- | Formats information about a set of pandoc documents.
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

-- | Formats information about a Pandoc document.
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
extractKey :: Text -> Maybe Text
extractKey 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