Query.hs

{-|
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(..),
    satisfies
  )
where

import Prelude hiding (concat)
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)

-- |
-- Represents an executable query and specifies how to format the results.
data Query = Query Expression Formatter deriving (Read, Show)

-- 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 (Read, Show)

data Expression = MetaValueIs T.Text T.Text
                | MetaValueIncludes T.Text T.Text
                | All
                | And Expression Expression
                | Or Expression Expression
                | Not Expression deriving (Read, Show)

satisfies :: P.Pandoc -> Expression -> Bool
p `satisfies` (MetaValueIs k v) = (meta p) `valueOf` k == [v]
p `satisfies` (MetaValueIncludes k v) = v `elem` ( (meta p) `valueOf` k )
_ `satisfies` All = True
p `satisfies` (And a b) = (p `satisfies` a) && (p `satisfies` b)
p `satisfies` (Or a b) = (p `satisfies` a) || (p `satisfies` b)
p `satisfies` (Not x) = not (p `satisfies` 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 ps = walkM (runQueries ps)

runQueries :: [P.Pandoc] -> P.Block -> IO P.Block
runQueries ps x@(P.CodeBlock (_,cs,_) s)
  | null cs                   = return x
  | head cs == "pandoc-query" = run (parse s) ps
  | otherwise                 = return x
runQueries _ x = return x

run :: Query -> [P.Pandoc] -> IO P.Block
run (Query e f) ps = formatResults f (runQuery e ps)

parse :: T.Text -> Query
parse = read . T.unpack

runQuery :: Expression -> [P.Pandoc] -> [P.Pandoc]
runQuery c = filter (`satisfies` c)

-- | Formats information about a set of pandoc documents.
formatResults :: Formatter -> [P.Pandoc] -> IO P.Block
formatResults f@(ParseFromMarkdown {}) ps = do
  bs <- body <$> parseMarkdown (T.concat $ map (format f . meta) ps)
  return $
    if null bs
      then P.Plain [ P.Emph [P.Str $ T.pack (show (length ps)) `T.append` " documents found"] ]
      else head bs

-- | Formats information about a Pandoc document.
format :: Formatter -> P.Meta -> T.Text
format (ParseFromMarkdown s) m = expandVars m s

expandVars :: P.Meta -> T.Text -> T.Text
expandVars m t = T.concat . map (expandVar m) $ separateVars t

expandVar :: P.Meta -> T.Text -> T.Text
expandVar m s =
  case extractKey s of
    Just t  -> head $ m `valueOf` t
    Nothing -> s

extractKey :: T.Text -> Maybe T.Text
extractKey s =
  if (T.take 2 s == "{{") && (T.takeEnd 2 s == "}}")
    then (Just . T.dropEnd 2 $ T.drop 2 s)
    else Nothing

separateVars :: T.Text -> [T.Text]
separateVars t = reverse $ separateVarsHelper [] t

separateVarsHelper :: [T.Text] -> T.Text -> [T.Text]
separateVarsHelper ss s
  | T.null s3 = ss'
  | otherwise = separateVarsHelper ss' s3
  where (s1, s2, s3) = breakAroundVariable s
        ss' = s2:s1:ss

breakAroundVariable :: T.Text -> (T.Text, T.Text, T.Text)
breakAroundVariable s =
  if T.null s2
    then (s1, "", "")
    else (s1, T.append s3 "}}", T.drop 2 s4)
  where (s1, s2) = T.breakOn "{{" s
        (s3, s4) = T.breakOn "}}" s2