{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}
{-|
  Module      : Auth.Biscuit.Datalog.AST
  Copyright   : © Clément Delafargue, 2021
  License     : BSD-3-Clause
  Maintainer  : clement@delafargue.name
  Parser for the authorization language
-}
module Auth.Biscuit.Datalog.Parser
  where

import           Auth.Biscuit.Crypto            (PublicKey,
                                                 readEd25519PublicKey)
import           Auth.Biscuit.Datalog.AST
import           Auth.Biscuit.Utils             (decodeHex)
import           Control.Monad                  (join)
import qualified Control.Monad.Combinators.Expr as Expr
import           Data.Bifunctor
import           Data.ByteString                (ByteString)
import qualified Data.ByteString.Char8          as C8
import           Data.Char
import           Data.Either                    (partitionEithers)
import           Data.Function                  ((&))
import           Data.Int                       (Int64)
import           Data.List.NonEmpty             (NonEmpty)
import qualified Data.List.NonEmpty             as NE
import           Data.Map.Strict                (Map)
import qualified Data.Map.Strict                as Map
import           Data.Maybe                     (isJust)
import           Data.Set                       (Set)
import qualified Data.Set                       as Set
import           Data.Text                      (Text)
import qualified Data.Text                      as T
import           Data.Time                      (UTCTime, defaultTimeLocale,
                                                 parseTimeM)
import           Instances.TH.Lift              ()
import           Language.Haskell.TH
import           Language.Haskell.TH.Quote      (QuasiQuoter (..))
import           Language.Haskell.TH.Syntax     (Lift)
import           Text.Megaparsec
import qualified Text.Megaparsec.Char           as C
import qualified Text.Megaparsec.Char.Lexer     as L
import           Validation                     (Validation (..),
                                                 validationToEither)

type Parser = Parsec SemanticError Text

type Span = (Int, Int)

data SemanticError =
    VarInFact Span
  | VarInCollection  Span
  | NestedSet Span
  | InvalidBs Text Span
  | InvalidPublicKey Text Span
  | UnboundVariables (NonEmpty Text) Span
  | PreviousInAuthorizer Span
  deriving stock (SemanticError -> SemanticError -> Bool
(SemanticError -> SemanticError -> Bool)
-> (SemanticError -> SemanticError -> Bool) -> Eq SemanticError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SemanticError -> SemanticError -> Bool
== :: SemanticError -> SemanticError -> Bool
$c/= :: SemanticError -> SemanticError -> Bool
/= :: SemanticError -> SemanticError -> Bool
Eq, Eq SemanticError
Eq SemanticError
-> (SemanticError -> SemanticError -> Ordering)
-> (SemanticError -> SemanticError -> Bool)
-> (SemanticError -> SemanticError -> Bool)
-> (SemanticError -> SemanticError -> Bool)
-> (SemanticError -> SemanticError -> Bool)
-> (SemanticError -> SemanticError -> SemanticError)
-> (SemanticError -> SemanticError -> SemanticError)
-> Ord SemanticError
SemanticError -> SemanticError -> Bool
SemanticError -> SemanticError -> Ordering
SemanticError -> SemanticError -> SemanticError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SemanticError -> SemanticError -> Ordering
compare :: SemanticError -> SemanticError -> Ordering
$c< :: SemanticError -> SemanticError -> Bool
< :: SemanticError -> SemanticError -> Bool
$c<= :: SemanticError -> SemanticError -> Bool
<= :: SemanticError -> SemanticError -> Bool
$c> :: SemanticError -> SemanticError -> Bool
> :: SemanticError -> SemanticError -> Bool
$c>= :: SemanticError -> SemanticError -> Bool
>= :: SemanticError -> SemanticError -> Bool
$cmax :: SemanticError -> SemanticError -> SemanticError
max :: SemanticError -> SemanticError -> SemanticError
$cmin :: SemanticError -> SemanticError -> SemanticError
min :: SemanticError -> SemanticError -> SemanticError
Ord)

instance ShowErrorComponent SemanticError where
  showErrorComponent :: SemanticError -> [Char]
showErrorComponent = \case
    VarInFact Span
_            -> [Char]
"Variables can't appear in a fact"
    VarInCollection  Span
_     -> [Char]
"Variables can't appear in a collection (set, array, map"
    NestedSet Span
_            -> [Char]
"Sets cannot be nested"
    InvalidBs Text
e Span
_          -> [Char]
"Invalid bytestring literal: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
e
    InvalidPublicKey Text
e Span
_   -> [Char]
"Invalid public key: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
e
    UnboundVariables NonEmpty Text
e Span
_   -> [Char]
"Unbound variables: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
e)
    PreviousInAuthorizer Span
_ -> [Char]
"'previous' can't appear in an authorizer scope"

run :: Parser a -> Text -> Either String a
run :: forall a. Parser a -> Text -> Either [Char] a
run Parser a
p = (ParseErrorBundle Text SemanticError -> [Char])
-> Either (ParseErrorBundle Text SemanticError) a
-> Either [Char] a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text SemanticError -> [Char]
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
errorBundlePretty (Either (ParseErrorBundle Text SemanticError) a -> Either [Char] a)
-> (Text -> Either (ParseErrorBundle Text SemanticError) a)
-> Text
-> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a
-> [Char] -> Text -> Either (ParseErrorBundle Text SemanticError) a
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (Parser () -> Parser ()
forall a. Parser a -> Parser a
l (() -> Parser ()
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Parser () -> Parser a -> Parser a
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a -> Parser a
forall a. Parser a -> Parser a
l Parser a
p Parser a -> Parser () -> Parser a
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
""

l :: Parser a -> Parser a
l :: forall a. Parser a -> Parser a
l = Parser ()
-> ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme (Parser ()
 -> ParsecT SemanticError Text Identity a
 -> ParsecT SemanticError Text Identity a)
-> Parser ()
-> ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity a
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
C.space1 (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"//") Parser ()
forall a. ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

getSpan :: Parser a -> Parser (Span, a)
getSpan :: forall a. Parser a -> Parser (Span, a)
getSpan Parser a
p = do
  Int
begin <- ParsecT SemanticError Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  a
a <- Parser a
p
  Int
end <- ParsecT SemanticError Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (Span, a) -> Parser (Span, a)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
begin, Int
end), a
a)

registerError :: (Span -> SemanticError) -> Span -> Parser a
registerError :: forall a. (Span -> SemanticError) -> Span -> Parser a
registerError Span -> SemanticError
mkError Span
sp = do
  let err :: ParseError s SemanticError
err = Int -> Set (ErrorFancy SemanticError) -> ParseError s SemanticError
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError (Span -> Int
forall a b. (a, b) -> a
fst Span
sp) (ErrorFancy SemanticError -> Set (ErrorFancy SemanticError)
forall a. a -> Set a
Set.singleton (SemanticError -> ErrorFancy SemanticError
forall e. e -> ErrorFancy e
ErrorCustom (SemanticError -> ErrorFancy SemanticError)
-> SemanticError -> ErrorFancy SemanticError
forall a b. (a -> b) -> a -> b
$ Span -> SemanticError
mkError Span
sp))
  ParseError Text SemanticError -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
ParseError s e -> m ()
registerParseError ParseError Text SemanticError
forall {s}. ParseError s SemanticError
err
  a -> Parser a
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"delayed parsing error"

forbid :: (Span -> SemanticError) -> Parser a -> Parser b
forbid :: forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
mkError Parser a
p = do
  (Span
sp, a
_) <- Parser a -> Parser (Span, a)
forall a. Parser a -> Parser (Span, a)
getSpan Parser a
p
  (Span -> SemanticError) -> Span -> Parser b
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError Span -> SemanticError
mkError Span
sp

identifierParser :: Parser Text
identifierParser :: Parser Text
identifierParser = Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"_, :, or any alphanumeric char") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
Token Text
c)

variableParser :: Parser Text
variableParser :: Parser Text
variableParser =
  Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'$' ParsecT SemanticError Text Identity Char
-> Parser Text -> Parser Text
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
identifierParser

haskellVariableParser :: Parser Text
haskellVariableParser :: Parser Text
haskellVariableParser = Parser Text -> Parser Text
forall a. Parser a -> Parser a
l (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"{"
  Maybe Char
leadingUS <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity (Maybe Char))
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'_'
  Char
x <- if Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
leadingUS then ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.letterChar else ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.lowerChar
  Text
xs <- Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"_, ', or any alphanumeric char") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
Token Text
c)
  Char
_ <- Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'}'
  Text -> Parser Text
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> (Text -> Text) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (Char -> Text -> Text) -> Maybe Char -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id Char -> Text -> Text
T.cons Maybe Char
leadingUS (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
x Text
xs

setParser :: Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
setParser :: Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
setParser = [Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))]
-> Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
emptySetParser, Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
nonEmptySetParser]

emptySetParser :: Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
emptySetParser :: Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
emptySetParser = Set (Term' 'WithinSet 'InFact 'WithSlices)
forall a. Monoid a => a
mempty Set (Term' 'WithinSet 'InFact 'WithSlices)
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"{,}"

setTermParser :: Parser (Term' 'WithinSet 'InFact 'WithSlices)
setTermParser :: Parser (Term' 'WithinSet 'InFact 'WithSlices)
setTermParser = Parser (VariableType 'WithinSet 'InFact)
-> Parser (SetType 'WithinSet 'WithSlices)
-> Parser (ArrayType 'WithinSet 'WithSlices)
-> Parser (MapType 'WithinSet 'WithSlices)
-> Parser (Term' 'WithinSet 'InFact 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType inSet 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
termParser
  ((Span -> SemanticError) -> Parser Text -> Parser Void
forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
VarInCollection Parser Text
variableParser)
  ((Span -> SemanticError)
-> Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
-> Parser Void
forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
NestedSet Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
setParser)
  ((Span -> SemanticError)
-> Parser [Term' 'NotWithinSet 'InFact 'WithSlices] -> Parser Void
forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
NestedSet Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
arrayParser)
  ((Span -> SemanticError)
-> Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
-> Parser Void
forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
NestedSet Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
mapParser)

nonEmptySetParser :: Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
nonEmptySetParser :: Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
nonEmptySetParser = do
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'{'
  [Term' 'WithinSet 'InFact 'WithSlices]
ts <- Parser (Term' 'WithinSet 'InFact 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> ParsecT
     SemanticError Text Identity [Term' 'WithinSet 'InFact 'WithSlices]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 Parser (Term' 'WithinSet 'InFact 'WithSlices)
setTermParser (ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
',')
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'}'
  Set (Term' 'WithinSet 'InFact 'WithSlices)
-> Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set (Term' 'WithinSet 'InFact 'WithSlices)
 -> Parser (Set (Term' 'WithinSet 'InFact 'WithSlices)))
-> Set (Term' 'WithinSet 'InFact 'WithSlices)
-> Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
forall a b. (a -> b) -> a -> b
$ [Term' 'WithinSet 'InFact 'WithSlices]
-> Set (Term' 'WithinSet 'InFact 'WithSlices)
forall a. Ord a => [a] -> Set a
Set.fromList [Term' 'WithinSet 'InFact 'WithSlices]
ts

valueParser :: Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
valueParser :: Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
valueParser = Parser (VariableType 'NotWithinSet 'InFact)
-> Parser (SetType 'NotWithinSet 'WithSlices)
-> Parser (ArrayType 'NotWithinSet 'WithSlices)
-> Parser (MapType 'NotWithinSet 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType inSet 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
termParser
  ((Span -> SemanticError) -> Parser Text -> Parser Void
forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
VarInCollection Parser Text
variableParser)
  Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
Parser (SetType 'NotWithinSet 'WithSlices)
setParser
  Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
Parser (ArrayType 'NotWithinSet 'WithSlices)
arrayParser
  Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
Parser (MapType 'NotWithinSet 'WithSlices)
mapParser

arrayParser :: Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
arrayParser :: Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
arrayParser = do
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'['
  [Term' 'NotWithinSet 'InFact 'WithSlices]
ts <- Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
valueParser (ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
',')
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
']'
  [Term' 'NotWithinSet 'InFact 'WithSlices]
-> Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Term' 'NotWithinSet 'InFact 'WithSlices]
ts

mapEntryParser :: Parser (MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)
mapEntryParser :: Parser (MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)
mapEntryParser = do
  MapKey
k <- Parser MapKey -> Parser MapKey
forall a. Parser a -> Parser a
l (Parser MapKey -> Parser MapKey) -> Parser MapKey -> Parser MapKey
forall a b. (a -> b) -> a -> b
$ [Parser MapKey] -> Parser MapKey
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Int64 -> MapKey
IntKey (Int64 -> MapKey)
-> ParsecT SemanticError Text Identity Int64 -> Parser MapKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Int64
intParser
                  , Text -> MapKey
StringKey (Text -> MapKey) -> Parser Text -> Parser MapKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringParser
                  ]
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
':'
  Term' 'NotWithinSet 'InFact 'WithSlices
v <- Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
valueParser
  (MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)
-> Parser (MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MapKey
k, Term' 'NotWithinSet 'InFact 'WithSlices
v)

mapParser :: Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
mapParser :: Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
mapParser = do
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'{'
  [(MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)]
ts <- Parser (MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> ParsecT
     SemanticError
     Text
     Identity
     [(MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 Parser (MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)
mapEntryParser (ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
',')
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'}'
  Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices)
-> Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices)
 -> Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices)))
-> Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices)
-> Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
forall a b. (a -> b) -> a -> b
$ [(MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)]
-> Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(MapKey, Term' 'NotWithinSet 'InFact 'WithSlices)]
ts

factTermParser :: Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
factTermParser :: Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
factTermParser = Parser (VariableType 'NotWithinSet 'InFact)
-> Parser (SetType 'NotWithinSet 'WithSlices)
-> Parser (ArrayType 'NotWithinSet 'WithSlices)
-> Parser (MapType 'NotWithinSet 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType inSet 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
termParser ((Span -> SemanticError) -> Parser Text -> Parser Void
forall a b. (Span -> SemanticError) -> Parser a -> Parser b
forbid Span -> SemanticError
VarInFact Parser Text
variableParser)
                            Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
Parser (SetType 'NotWithinSet 'WithSlices)
setParser
                            Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
Parser (ArrayType 'NotWithinSet 'WithSlices)
arrayParser
                            Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
Parser (MapType 'NotWithinSet 'WithSlices)
mapParser

predicateTermParser :: Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
predicateTermParser :: Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
predicateTermParser = Parser (VariableType 'NotWithinSet 'InPredicate)
-> Parser (SetType 'NotWithinSet 'WithSlices)
-> Parser (ArrayType 'NotWithinSet 'WithSlices)
-> Parser (MapType 'NotWithinSet 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType inSet 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
termParser Parser Text
Parser (VariableType 'NotWithinSet 'InPredicate)
variableParser
                                 Parser (Set (Term' 'WithinSet 'InFact 'WithSlices))
Parser (SetType 'NotWithinSet 'WithSlices)
setParser
                                 Parser [Term' 'NotWithinSet 'InFact 'WithSlices]
Parser (ArrayType 'NotWithinSet 'WithSlices)
arrayParser
                                 Parser (Map MapKey (Term' 'NotWithinSet 'InFact 'WithSlices))
Parser (MapType 'NotWithinSet 'WithSlices)
mapParser

termParser :: Parser (VariableType inSet pof)
           -> Parser (SetType inSet 'WithSlices)
           -> Parser (ArrayType inSet 'WithSlices)
           -> Parser (MapType inSet 'WithSlices)
           -> Parser (Term' inSet pof 'WithSlices)
termParser :: forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType inSet 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
termParser Parser (VariableType inSet pof)
parseVar Parser (SetType inSet 'WithSlices)
parseSet Parser (ArrayType inSet 'WithSlices)
parseArray Parser (MapType inSet 'WithSlices)
parseMap = Parser (Term' inSet pof 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
forall a. Parser a -> Parser a
l (Parser (Term' inSet pof 'WithSlices)
 -> Parser (Term' inSet pof 'WithSlices))
-> Parser (Term' inSet pof 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
forall a b. (a -> b) -> a -> b
$ [Parser (Term' inSet pof 'WithSlices)]
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ SetType inSet 'WithSlices -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (SetType inSet 'WithSlices -> Term' inSet pof 'WithSlices)
-> Parser (SetType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (SetType inSet 'WithSlices)
-> Parser (SetType inSet 'WithSlices)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (SetType inSet 'WithSlices)
parseSet Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"set (eg. {1,2,3})"
  , ArrayType inSet 'WithSlices -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ArrayType inSet ctx -> Term' inSet pof ctx
TermArray (ArrayType inSet 'WithSlices -> Term' inSet pof 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ArrayType inSet 'WithSlices)
-> Parser (ArrayType inSet 'WithSlices)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (ArrayType inSet 'WithSlices)
parseArray Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"array (eg. [1, 2, 3])"
  , MapType inSet 'WithSlices -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
MapType inSet ctx -> Term' inSet pof ctx
TermMap (MapType inSet 'WithSlices -> Term' inSet pof 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (MapType inSet 'WithSlices)
-> Parser (MapType inSet 'WithSlices)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (MapType inSet 'WithSlices)
parseMap Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"map (eg. {\"key\": 1})"
  , SliceType 'WithSlices -> Term' inSet pof 'WithSlices
Slice -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
SliceType ctx -> Term' inSet pof ctx
Antiquote (Slice -> Term' inSet pof 'WithSlices)
-> (Text -> Slice) -> Text -> Term' inSet pof 'WithSlices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Slice
Slice (Text -> Term' inSet pof 'WithSlices)
-> Parser Text -> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
haskellVariableParser Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"parameter (eg. {paramName})"
  , VariableType inSet pof -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
VariableType inSet pof -> Term' inSet pof ctx
Variable (VariableType inSet pof -> Term' inSet pof 'WithSlices)
-> Parser (VariableType inSet pof)
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VariableType inSet pof)
parseVar Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"datalog variable (eg. $variable)"
  , ByteString -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
ByteString -> Term' inSet pof ctx
LBytes (ByteString -> Term' inSet pof 'WithSlices)
-> ParsecT SemanticError Text Identity ByteString
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"hex:" ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity ByteString
-> ParsecT SemanticError Text Identity ByteString
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SemanticError Text Identity ByteString
hexParser) Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"hex-encoded bytestring (eg. hex:00ff99)"
  , UTCTime -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
UTCTime -> Term' inSet pof ctx
LDate (UTCTime -> Term' inSet pof 'WithSlices)
-> ParsecT SemanticError Text Identity UTCTime
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity UTCTime
rfc3339DateParser Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"RFC3339-formatted timestamp (eg. 2022-11-29T00:00:00Z)"
  , Int64 -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Int64 -> Term' inSet pof ctx
LInteger (Int64 -> Term' inSet pof 'WithSlices)
-> ParsecT SemanticError Text Identity Int64
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Int64
intParser Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"(signed) integer"
  , Text -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Text -> Term' inSet pof ctx
LString (Text -> Term' inSet pof 'WithSlices)
-> Parser Text -> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
stringParser Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"string literal"
  , Bool -> Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Bool -> Term' inSet pof ctx
LBool (Bool -> Term' inSet pof 'WithSlices)
-> ParsecT SemanticError Text Identity Bool
-> Parser (Term' inSet pof 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT SemanticError Text Identity Bool]
-> ParsecT SemanticError Text Identity Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Bool
True Bool
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Bool
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"true"
                     , Bool
False Bool
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Bool
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"false"
                     ]
          Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"boolean value (eg. true or false)"
  , Term' inSet pof 'WithSlices
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: DatalogContext).
Term' inSet pof ctx
LNull Term' inSet pof 'WithSlices
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser (Term' inSet pof 'WithSlices)
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"null" Parser (Term' inSet pof 'WithSlices)
-> [Char] -> Parser (Term' inSet pof 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"null value"
  ]

stringParser :: Parser Text
stringParser :: Parser Text
stringParser = [Char] -> Text
T.pack ([Char] -> Text)
-> ParsecT SemanticError Text Identity [Char] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'"' ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
-> ParsecT SemanticError Text Identity [Char]
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT SemanticError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'"'))

intParser :: Parser Int64
intParser :: ParsecT SemanticError Text Identity Int64
intParser = do
  Integer
integer :: Integer <- Parser ()
-> ParsecT SemanticError Text Identity Integer
-> ParsecT SemanticError Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
C.space ParsecT SemanticError Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal ParsecT SemanticError Text Identity Integer
-> [Char] -> ParsecT SemanticError Text Identity Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"(signed) integer"
  if Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound @Int64)
     Bool -> Bool -> Bool
|| Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound @Int64)
  then [Char] -> ParsecT SemanticError Text Identity Int64
forall a. [Char] -> ParsecT SemanticError Text Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"integer literals must fit in the int64 range"
  else Int64 -> ParsecT SemanticError Text Identity Int64
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> ParsecT SemanticError Text Identity Int64)
-> Int64 -> ParsecT SemanticError Text Identity Int64
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer

hexParser :: Parser ByteString
hexParser :: ParsecT SemanticError Text Identity ByteString
hexParser = do
  (Span
sp, ByteString
hexStr) <- ParsecT SemanticError Text Identity ByteString
-> Parser (Span, ByteString)
forall a. Parser a -> Parser (Span, a)
getSpan (ParsecT SemanticError Text Identity ByteString
 -> Parser (Span, ByteString))
-> ParsecT SemanticError Text Identity ByteString
-> Parser (Span, ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
C8.pack ([Char] -> ByteString)
-> ParsecT SemanticError Text Identity [Char]
-> ParsecT SemanticError Text Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.hexDigitChar
  case ByteString -> Either Text ByteString
decodeHex ByteString
hexStr of
    Left Text
e   -> (Span -> SemanticError)
-> Span -> ParsecT SemanticError Text Identity ByteString
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError (Text -> Span -> SemanticError
InvalidBs Text
e) Span
sp
    Right ByteString
bs -> ByteString -> ParsecT SemanticError Text Identity ByteString
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

publicKeyParser :: Parser PublicKey
publicKeyParser :: Parser PublicKey
publicKeyParser = do
  (Span
sp, ByteString
hexStr) <- ParsecT SemanticError Text Identity ByteString
-> Parser (Span, ByteString)
forall a. Parser a -> Parser (Span, a)
getSpan (ParsecT SemanticError Text Identity ByteString
 -> Parser (Span, ByteString))
-> ParsecT SemanticError Text Identity ByteString
-> Parser (Span, ByteString)
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
C8.pack ([Char] -> ByteString)
-> ParsecT SemanticError Text Identity [Char]
-> ParsecT SemanticError Text Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"ed25519/" ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity [Char]
-> ParsecT SemanticError Text Identity [Char]
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.hexDigitChar)
  case ByteString -> Either Text ByteString
decodeHex ByteString
hexStr of
    Left Text
e -> (Span -> SemanticError) -> Span -> Parser PublicKey
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError (Text -> Span -> SemanticError
InvalidPublicKey Text
e) Span
sp
    Right ByteString
bs -> case ByteString -> Maybe PublicKey
readEd25519PublicKey ByteString
bs of
      Maybe PublicKey
Nothing -> (Span -> SemanticError) -> Span -> Parser PublicKey
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError (Text -> Span -> SemanticError
InvalidPublicKey Text
"Invalid ed25519 public key") Span
sp
      Just PublicKey
pk -> PublicKey -> Parser PublicKey
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PublicKey
pk

rfc3339DateParser :: Parser UTCTime
rfc3339DateParser :: ParsecT SemanticError Text Identity UTCTime
rfc3339DateParser = do
  let parseDate :: [Char] -> ParsecT SemanticError Text Identity UTCTime
parseDate = Bool
-> TimeLocale
-> [Char]
-> [Char]
-> ParsecT SemanticError Text Identity UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale [Char]
"%FT%T%Q%EZ"
  [[Char]]
input <- [ParsecT SemanticError Text Identity [Char]]
-> ParsecT SemanticError Text Identity [[Char]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [
      ParsecT SemanticError Text Identity [Char]
-> ParsecT SemanticError Text Identity [Char]
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ([ParsecT SemanticError Text Identity Char]
-> ParsecT SemanticError Text Identity [Char]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'-',
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'-',
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
        Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'T'
      ]),
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
':',
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
':',
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
      Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
      ([[Char]] -> [Char]) -> Maybe [[Char]] -> [Char]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [[Char]] -> [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe [[Char]] -> [Char])
-> ParsecT SemanticError Text Identity (Maybe [[Char]])
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity [[Char]]
-> ParsecT SemanticError Text Identity (Maybe [[Char]])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([ParsecT SemanticError Text Identity [Char]]
-> ParsecT SemanticError Text Identity [[Char]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [
        Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'.',
        ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar
      ]),
      [ParsecT SemanticError Text Identity [Char]]
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
        Char -> [Char]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> [Char])
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'Z',
        [ParsecT SemanticError Text Identity Char]
-> ParsecT SemanticError Text Identity [Char]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [
           [ParsecT SemanticError Text Identity Char]
-> ParsecT SemanticError Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'+', Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'-'],
           ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
           ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
           Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
':',
           ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar,
           ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.digitChar
        ]
      ]
    ]
  [Char] -> ParsecT SemanticError Text Identity UTCTime
parseDate ([Char] -> ParsecT SemanticError Text Identity UTCTime)
-> [Char] -> ParsecT SemanticError Text Identity UTCTime
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[Char]]
input

predicateParser' :: Parser (Term' 'NotWithinSet pof 'WithSlices)
                 -> Parser (Predicate' pof 'WithSlices)
predicateParser' :: forall (pof :: PredicateOrFact).
Parser (Term' 'NotWithinSet pof 'WithSlices)
-> Parser (Predicate' pof 'WithSlices)
predicateParser' Parser (Term' 'NotWithinSet pof 'WithSlices)
parseTerm = Parser (Predicate' pof 'WithSlices)
-> Parser (Predicate' pof 'WithSlices)
forall a. Parser a -> Parser a
l (Parser (Predicate' pof 'WithSlices)
 -> Parser (Predicate' pof 'WithSlices))
-> Parser (Predicate' pof 'WithSlices)
-> Parser (Predicate' pof 'WithSlices)
forall a b. (a -> b) -> a -> b
$ do
  Text
name <- Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser Text -> [Char] -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"predicate name") (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
    Char
x      <- ParsecT SemanticError Text Identity Char
ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
C.letterChar
    Text
xs     <- Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"_, :, or any alphanumeric char") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
Token Text
c)
    Char
_      <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'('
    Text -> Parser Text
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
x Text
xs
  [Term' 'NotWithinSet pof 'WithSlices]
terms  <- Parser (Term' 'NotWithinSet pof 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> ParsecT
     SemanticError Text Identity [Term' 'NotWithinSet pof 'WithSlices]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 Parser (Term' 'NotWithinSet pof 'WithSlices)
parseTerm (ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
',')
  Char
_      <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
')'
  Predicate' pof 'WithSlices -> Parser (Predicate' pof 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate {
    Text
name :: Text
name :: Text
name,
    [Term' 'NotWithinSet pof 'WithSlices]
terms :: [Term' 'NotWithinSet pof 'WithSlices]
terms :: [Term' 'NotWithinSet pof 'WithSlices]
terms
  }

factParser :: Parser (Predicate' 'InFact 'WithSlices)
factParser :: Parser (Predicate' 'InFact 'WithSlices)
factParser = Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
-> Parser (Predicate' 'InFact 'WithSlices)
forall (pof :: PredicateOrFact).
Parser (Term' 'NotWithinSet pof 'WithSlices)
-> Parser (Predicate' pof 'WithSlices)
predicateParser' Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
factTermParser

predicateParser :: Parser (Predicate' 'InPredicate 'WithSlices)
predicateParser :: Parser (Predicate' 'InPredicate 'WithSlices)
predicateParser = Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
-> Parser (Predicate' 'InPredicate 'WithSlices)
forall (pof :: PredicateOrFact).
Parser (Term' 'NotWithinSet pof 'WithSlices)
-> Parser (Predicate' pof 'WithSlices)
predicateParser' Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
predicateTermParser

closureParser :: Parser (Text, Expression' 'WithSlices)
closureParser :: Parser (Text, Expression' 'WithSlices)
closureParser = do
    Text
param <- Parser Text -> Parser Text
forall a. Parser a -> Parser a
l Parser Text
variableParser
    Tokens Text
_ <- ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity (Tokens Text)
 -> ParsecT SemanticError Text Identity (Tokens Text))
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"->"
    Expression' 'WithSlices
body <- Parser (Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Expression' 'WithSlices)
expressionParser
    (Text, Expression' 'WithSlices)
-> Parser (Text, Expression' 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
param, Expression' 'WithSlices
body)

expressionParser :: Parser (Expression' 'WithSlices)
expressionParser :: Parser (Expression' 'WithSlices)
expressionParser =
  let base :: Parser (Expression' 'WithSlices)
base = [Parser (Expression' 'WithSlices)]
-> Parser (Expression' 'WithSlices)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Parser (Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Expression' 'WithSlices)
methodsParser
                    , Parser (Expression' 'WithSlices)
exprTerm
                    ]
   in Parser (Expression' 'WithSlices)
-> [[Operator
       (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)]]
-> Parser (Expression' 'WithSlices)
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
Expr.makeExprParser Parser (Expression' 'WithSlices)
base [[Operator
    (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)]]
table

table :: [[Expr.Operator Parser (Expression' 'WithSlices)]]
table :: [[Operator
    (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)]]
table =
  let infixL :: Tokens Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL Tokens Text
name Binary
op = ParsecT
  SemanticError
  Text
  Identity
  (Expression' ctx -> Expression' ctx -> Expression' ctx)
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
Expr.InfixL (Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
makeBinary Binary
op (Expression' ctx -> Expression' ctx -> Expression' ctx)
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT
     SemanticError
     Text
     Identity
     (Expression' ctx -> Expression' ctx -> Expression' ctx)
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
name) ParsecT
  SemanticError
  Text
  Identity
  (Expression' ctx -> Expression' ctx -> Expression' ctx)
-> [Char]
-> ParsecT
     SemanticError
     Text
     Identity
     (Expression' ctx -> Expression' ctx -> Expression' ctx)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"infix operator")
      infixN :: Tokens Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN Tokens Text
name Binary
op = ParsecT
  SemanticError
  Text
  Identity
  (Expression' ctx -> Expression' ctx -> Expression' ctx)
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
Expr.InfixN (Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
makeBinary Binary
op (Expression' ctx -> Expression' ctx -> Expression' ctx)
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT
     SemanticError
     Text
     Identity
     (Expression' ctx -> Expression' ctx -> Expression' ctx)
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
name) ParsecT
  SemanticError
  Text
  Identity
  (Expression' ctx -> Expression' ctx -> Expression' ctx)
-> [Char]
-> ParsecT
     SemanticError
     Text
     Identity
     (Expression' ctx -> Expression' ctx -> Expression' ctx)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"infix operator")
      prefix :: Tokens Text
-> Unary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
prefix Tokens Text
name Unary
op = ParsecT
  SemanticError Text Identity (Expression' ctx -> Expression' ctx)
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Expr.Prefix (Unary -> Expression' ctx -> Expression' ctx
forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
op (Expression' ctx -> Expression' ctx)
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT
     SemanticError Text Identity (Expression' ctx -> Expression' ctx)
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
name) ParsecT
  SemanticError Text Identity (Expression' ctx -> Expression' ctx)
-> [Char]
-> ParsecT
     SemanticError Text Identity (Expression' ctx -> Expression' ctx)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"prefix operator")
      makeBinary :: Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
makeBinary Binary
LazyOr Expression' ctx
e Expression' ctx
e'  = Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
LazyOr Expression' ctx
e ([Text] -> Expression' ctx -> Expression' ctx
forall (ctx :: DatalogContext).
[Text] -> Expression' ctx -> Expression' ctx
EClosure [] Expression' ctx
e')
      makeBinary Binary
LazyAnd Expression' ctx
e Expression' ctx
e' = Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
LazyAnd Expression' ctx
e ([Text] -> Expression' ctx -> Expression' ctx
forall (ctx :: DatalogContext).
[Text] -> Expression' ctx -> Expression' ctx
EClosure [] Expression' ctx
e')
      makeBinary Binary
op Expression' ctx
e Expression' ctx
e'      = Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
op Expression' ctx
e Expression' ctx
e'
   in [ [ Text
-> Unary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Unary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
prefix Text
"!" Unary
Negate]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"*" Binary
Mul
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"/" Binary
Div
        ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"+" Binary
Add
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"-" Binary
Sub
        ]
      -- TODO find a better way to avoid eager parsing
      -- of && and || by the bitwise operators
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"& " Binary
BitwiseAnd ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"| " Binary
BitwiseOr  ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL  Text
"^" Binary
BitwiseXor ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
"<=" Binary
LessOrEqual
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
">=" Binary
GreaterOrEqual
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
"<"  Binary
LessThan
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
">"  Binary
GreaterThan
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
"===" Binary
Equal
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
"!==" Binary
NotEqual
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
"==" Binary
HeterogeneousEqual
        , Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixN  Text
"!=" Binary
HeterogeneousNotEqual
        ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL Text
"&&" Binary
LazyAnd ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL Text
"||" Binary
LazyOr ]
      ]

binaryMethodParser :: Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
binaryMethodParser :: Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
binaryMethodParser = do
  Char
_ <- Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'.'
  Binary
method <- [ParsecT SemanticError Text Identity Binary]
-> ParsecT SemanticError Text Identity Binary
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Binary
Contains     Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"contains"
    , Binary
Intersection Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"intersection"
    , Binary
Union        Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"union"
    , Binary
Prefix       Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"starts_with"
    , Binary
Suffix       Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"ends_with"
    , Binary
Regex        Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"matches"
    , Binary
Any          Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"any"
    , Binary
All          Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"all"
    , Binary
Get          Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"get"
    , Text -> Binary
BinaryFfi    (Text -> Binary)
-> Parser Text -> ParsecT SemanticError Text Identity Binary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"extern::" ParsecT SemanticError Text Identity (Tokens Text)
-> Parser Text -> Parser Text
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
identifierParser)
    , Binary
Try          Binary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Binary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"try_or"
    ]
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'('
  Expression' 'WithSlices
e2 <- case Binary
method of
    Binary
Any -> ([Text] -> Expression' 'WithSlices -> Expression' 'WithSlices)
-> ([Text], Expression' 'WithSlices) -> Expression' 'WithSlices
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> Expression' 'WithSlices -> Expression' 'WithSlices
forall (ctx :: DatalogContext).
[Text] -> Expression' ctx -> Expression' ctx
EClosure (([Text], Expression' 'WithSlices) -> Expression' 'WithSlices)
-> ((Text, Expression' 'WithSlices)
    -> ([Text], Expression' 'WithSlices))
-> (Text, Expression' 'WithSlices)
-> Expression' 'WithSlices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text])
-> (Text, Expression' 'WithSlices)
-> ([Text], Expression' 'WithSlices)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Expression' 'WithSlices) -> Expression' 'WithSlices)
-> Parser (Text, Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Expression' 'WithSlices)
-> Parser (Text, Expression' 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Text, Expression' 'WithSlices)
closureParser
    Binary
All -> ([Text] -> Expression' 'WithSlices -> Expression' 'WithSlices)
-> ([Text], Expression' 'WithSlices) -> Expression' 'WithSlices
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> Expression' 'WithSlices -> Expression' 'WithSlices
forall (ctx :: DatalogContext).
[Text] -> Expression' ctx -> Expression' ctx
EClosure (([Text], Expression' 'WithSlices) -> Expression' 'WithSlices)
-> ((Text, Expression' 'WithSlices)
    -> ([Text], Expression' 'WithSlices))
-> (Text, Expression' 'WithSlices)
-> Expression' 'WithSlices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text])
-> (Text, Expression' 'WithSlices)
-> ([Text], Expression' 'WithSlices)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Expression' 'WithSlices) -> Expression' 'WithSlices)
-> Parser (Text, Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Expression' 'WithSlices)
-> Parser (Text, Expression' 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Text, Expression' 'WithSlices)
closureParser
    Binary
_   -> Parser (Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Expression' 'WithSlices)
expressionParser
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
')'
  (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expression' 'WithSlices -> Expression' 'WithSlices)
 -> Parser (Expression' 'WithSlices -> Expression' 'WithSlices))
-> (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
forall a b. (a -> b) -> a -> b
$ \Expression' 'WithSlices
e1 -> case Binary
method of
    Binary
Try -> Binary
-> Expression' 'WithSlices
-> Expression' 'WithSlices
-> Expression' 'WithSlices
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
method ([Text] -> Expression' 'WithSlices -> Expression' 'WithSlices
forall (ctx :: DatalogContext).
[Text] -> Expression' ctx -> Expression' ctx
EClosure [] Expression' 'WithSlices
e1) Expression' 'WithSlices
e2
    Binary
_   -> Binary
-> Expression' 'WithSlices
-> Expression' 'WithSlices
-> Expression' 'WithSlices
forall {ctx :: DatalogContext}.
Binary -> Expression' ctx -> Expression' ctx -> Expression' ctx
EBinary Binary
method Expression' 'WithSlices
e1 Expression' 'WithSlices
e2

unaryMethodParser :: Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
unaryMethodParser :: Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
unaryMethodParser = do
  Char
_ <- Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'.'
  Unary
method <- [ParsecT SemanticError Text Identity Unary]
-> ParsecT SemanticError Text Identity Unary
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
            [ Unary
Length Unary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Unary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"length"
            , Unary
TypeOf Unary
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity Unary
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"type"
            , Text -> Unary
UnaryFfi (Text -> Unary)
-> Parser Text -> ParsecT SemanticError Text Identity Unary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"extern::" ParsecT SemanticError Text Identity (Tokens Text)
-> Parser Text -> Parser Text
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
identifierParser)
            ]
  Tokens Text
_ <- ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity (Tokens Text)
 -> ParsecT SemanticError Text Identity (Tokens Text))
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"()"
  (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expression' 'WithSlices -> Expression' 'WithSlices)
 -> Parser (Expression' 'WithSlices -> Expression' 'WithSlices))
-> (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
forall a b. (a -> b) -> a -> b
$ Unary -> Expression' 'WithSlices -> Expression' 'WithSlices
forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
method

methodsParser :: Parser (Expression' 'WithSlices)
methodsParser :: Parser (Expression' 'WithSlices)
methodsParser = do
  Expression' 'WithSlices
e1 <- Parser (Expression' 'WithSlices)
exprTerm
  [Expression' 'WithSlices -> Expression' 'WithSlices]
methods <- Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
-> ParsecT
     SemanticError
     Text
     Identity
     [Expression' 'WithSlices -> Expression' 'WithSlices]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
binaryMethodParser Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
forall a.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Expression' 'WithSlices -> Expression' 'WithSlices)
unaryMethodParser)
  Expression' 'WithSlices -> Parser (Expression' 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression' 'WithSlices -> Parser (Expression' 'WithSlices))
-> Expression' 'WithSlices -> Parser (Expression' 'WithSlices)
forall a b. (a -> b) -> a -> b
$ (Expression' 'WithSlices
 -> (Expression' 'WithSlices -> Expression' 'WithSlices)
 -> Expression' 'WithSlices)
-> Expression' 'WithSlices
-> [Expression' 'WithSlices -> Expression' 'WithSlices]
-> Expression' 'WithSlices
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expression' 'WithSlices
-> (Expression' 'WithSlices -> Expression' 'WithSlices)
-> Expression' 'WithSlices
forall a b. a -> (a -> b) -> b
(&) Expression' 'WithSlices
e1 [Expression' 'WithSlices -> Expression' 'WithSlices]
methods

unaryParens :: Parser (Expression' 'WithSlices)
unaryParens :: Parser (Expression' 'WithSlices)
unaryParens = do
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
'('
  Expression' 'WithSlices
e <- Parser (Expression' 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Expression' 'WithSlices)
expressionParser
  Char
_ <- ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
')'
  Expression' 'WithSlices -> Parser (Expression' 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression' 'WithSlices -> Parser (Expression' 'WithSlices))
-> Expression' 'WithSlices -> Parser (Expression' 'WithSlices)
forall a b. (a -> b) -> a -> b
$ Unary -> Expression' 'WithSlices -> Expression' 'WithSlices
forall (ctx :: DatalogContext).
Unary -> Expression' ctx -> Expression' ctx
EUnary Unary
Parens Expression' 'WithSlices
e

exprTerm :: Parser (Expression' 'WithSlices)
exprTerm :: Parser (Expression' 'WithSlices)
exprTerm = [Parser (Expression' 'WithSlices)]
-> Parser (Expression' 'WithSlices)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Parser (Expression' 'WithSlices)
unaryParens Parser (Expression' 'WithSlices)
-> [Char] -> Parser (Expression' 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"parens"
  , Term' 'NotWithinSet 'InPredicate 'WithSlices
-> Expression' 'WithSlices
forall (ctx :: DatalogContext).
Term' 'NotWithinSet 'InPredicate ctx -> Expression' ctx
EValue (Term' 'NotWithinSet 'InPredicate 'WithSlices
 -> Expression' 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
-> Parser (Expression' 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
predicateTermParser
  ]

ruleParser :: Bool -> Parser (Rule' 'Repr 'WithSlices)
ruleParser :: Bool -> Parser (Rule' 'Repr 'WithSlices)
ruleParser Bool
inAuthorizer = do
  Int
begin <- ParsecT SemanticError Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Predicate' 'InPredicate 'WithSlices
rhead <- Parser (Predicate' 'InPredicate 'WithSlices)
-> Parser (Predicate' 'InPredicate 'WithSlices)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (Predicate' 'InPredicate 'WithSlices)
 -> Parser (Predicate' 'InPredicate 'WithSlices))
-> Parser (Predicate' 'InPredicate 'WithSlices)
-> Parser (Predicate' 'InPredicate 'WithSlices)
forall a b. (a -> b) -> a -> b
$ Parser (Predicate' 'InPredicate 'WithSlices)
-> Parser (Predicate' 'InPredicate 'WithSlices)
forall a. Parser a -> Parser a
l Parser (Predicate' 'InPredicate 'WithSlices)
predicateParser Parser (Predicate' 'InPredicate 'WithSlices)
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser (Predicate' 'InPredicate 'WithSlices)
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"<-")
  ([Predicate' 'InPredicate 'WithSlices]
body, [Expression' 'WithSlices]
expressions, Set (RuleScope' 'Repr 'WithSlices)
scope) <- Bool
-> Parser
     ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
      Set (RuleScope' 'Repr 'WithSlices))
ruleBodyParser Bool
inAuthorizer
  Int
end <- ParsecT SemanticError Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  case Predicate' 'InPredicate 'WithSlices
-> [Predicate' 'InPredicate 'WithSlices]
-> [Expression' 'WithSlices]
-> Set (RuleScope' 'Repr 'WithSlices)
-> Validation (NonEmpty Text) (Rule' 'Repr 'WithSlices)
forall (ctx :: DatalogContext).
Predicate' 'InPredicate ctx
-> [Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (Rule' 'Repr ctx)
makeRule Predicate' 'InPredicate 'WithSlices
rhead [Predicate' 'InPredicate 'WithSlices]
body [Expression' 'WithSlices]
expressions Set (RuleScope' 'Repr 'WithSlices)
scope of
    Failure NonEmpty Text
vs -> (Span -> SemanticError) -> Span -> Parser (Rule' 'Repr 'WithSlices)
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError (NonEmpty Text -> Span -> SemanticError
UnboundVariables NonEmpty Text
vs) (Int
begin, Int
end)
    Success Rule' 'Repr 'WithSlices
r  -> Rule' 'Repr 'WithSlices -> Parser (Rule' 'Repr 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rule' 'Repr 'WithSlices
r

ruleBodyParser :: Bool -> Parser ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices], Set.Set (RuleScope' 'Repr 'WithSlices))
ruleBodyParser :: Bool
-> Parser
     ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
      Set (RuleScope' 'Repr 'WithSlices))
ruleBodyParser Bool
inAuthorizer = do
  let predicateOrExprParser :: ParsecT
  SemanticError
  Text
  Identity
  (Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
predicateOrExprParser =
            Predicate' 'InPredicate 'WithSlices
-> Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)
forall a b. a -> Either a b
Left  (Predicate' 'InPredicate 'WithSlices
 -> Either
      (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
-> Parser (Predicate' 'InPredicate 'WithSlices)
-> ParsecT
     SemanticError
     Text
     Identity
     (Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (Predicate' 'InPredicate 'WithSlices)
predicateParser Parser (Predicate' 'InPredicate 'WithSlices)
-> [Char] -> Parser (Predicate' 'InPredicate 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"predicate")
        ParsecT
  SemanticError
  Text
  Identity
  (Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
-> ParsecT
     SemanticError
     Text
     Identity
     (Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
-> ParsecT
     SemanticError
     Text
     Identity
     (Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
forall a.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expression' 'WithSlices
-> Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)
forall a b. b -> Either a b
Right (Expression' 'WithSlices
 -> Either
      (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
-> Parser (Expression' 'WithSlices)
-> ParsecT
     SemanticError
     Text
     Identity
     (Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (Expression' 'WithSlices)
expressionParser Parser (Expression' 'WithSlices)
-> [Char] -> Parser (Expression' 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"expression")
  [Either
   (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
elems <- Parser
  [Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
-> Parser
     [Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
forall a. Parser a -> Parser a
l (Parser
   [Either
      (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
 -> Parser
      [Either
         (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)])
-> Parser
     [Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
-> Parser
     [Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
forall a b. (a -> b) -> a -> b
$ ParsecT
  SemanticError
  Text
  Identity
  (Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
-> ParsecT SemanticError Text Identity Char
-> Parser
     [Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (ParsecT
  SemanticError
  Text
  Identity
  (Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
-> ParsecT
     SemanticError
     Text
     Identity
     (Either
        (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
forall a. Parser a -> Parser a
l ParsecT
  SemanticError
  Text
  Identity
  (Either
     (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices))
predicateOrExprParser)
                      (ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
',')
  Set (RuleScope' 'Repr 'WithSlices)
scope <- Set (RuleScope' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Set (RuleScope' 'Repr 'WithSlices)
forall a. Set a
Set.empty (ParsecT
   SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
 -> ParsecT
      SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices)))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a b. (a -> b) -> a -> b
$ Bool
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
scopeParser Bool
inAuthorizer
  let ([Predicate' 'InPredicate 'WithSlices]
predicates, [Expression' 'WithSlices]
expressions) = [Either
   (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
-> ([Predicate' 'InPredicate 'WithSlices],
    [Expression' 'WithSlices])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (Predicate' 'InPredicate 'WithSlices) (Expression' 'WithSlices)]
elems
  ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
 Set (RuleScope' 'Repr 'WithSlices))
-> Parser
     ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
      Set (RuleScope' 'Repr 'WithSlices))
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Predicate' 'InPredicate 'WithSlices]
predicates, [Expression' 'WithSlices]
expressions, Set (RuleScope' 'Repr 'WithSlices)
scope)

scopeParser :: Bool -> Parser (Set.Set (RuleScope' 'Repr 'WithSlices))
scopeParser :: Bool
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
scopeParser Bool
inAuthorizer = (ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> [Char]
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"scope annotation") (ParsecT
   SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
 -> ParsecT
      SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices)))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity (Tokens Text)
 -> ParsecT SemanticError Text Identity (Tokens Text))
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"trusting "
  let elemParser :: ParsecT SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
elemParser = do
        (Span
sp, RuleScope' 'Repr 'WithSlices
s) <- ParsecT SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
-> Parser (Span, RuleScope' 'Repr 'WithSlices)
forall a. Parser a -> Parser (Span, a)
getSpan (ParsecT SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
 -> Parser (Span, RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
-> Parser (Span, RuleScope' 'Repr 'WithSlices)
forall a b. (a -> b) -> a -> b
$ [ParsecT
   SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)]
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ RuleScope' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
OnlyAuthority RuleScope' 'Repr 'WithSlices
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"authority"
                                    , RuleScope' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous      RuleScope' 'Repr 'WithSlices
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"previous"
                                    , BlockIdType 'Repr 'WithSlices -> RuleScope' 'Repr 'WithSlices
PkOrSlice -> RuleScope' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockIdType evalCtx ctx -> RuleScope' evalCtx ctx
BlockId       (PkOrSlice -> RuleScope' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity PkOrSlice
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                       [ParsecT SemanticError Text Identity PkOrSlice]
-> ParsecT SemanticError Text Identity PkOrSlice
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Text -> PkOrSlice
PkSlice (Text -> PkOrSlice)
-> Parser Text -> ParsecT SemanticError Text Identity PkOrSlice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
haskellVariableParser ParsecT SemanticError Text Identity PkOrSlice
-> [Char] -> ParsecT SemanticError Text Identity PkOrSlice
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"parameter (eg. {paramName})"
                                              , PublicKey -> PkOrSlice
Pk (PublicKey -> PkOrSlice)
-> Parser PublicKey
-> ParsecT SemanticError Text Identity PkOrSlice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PublicKey
publicKeyParser ParsecT SemanticError Text Identity PkOrSlice
-> [Char] -> ParsecT SemanticError Text Identity PkOrSlice
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"public key (eg. ed25519/00ff99)"
                                              ]
                                    ]
        if Bool
inAuthorizer Bool -> Bool -> Bool
&& RuleScope' 'Repr 'WithSlices
s RuleScope' 'Repr 'WithSlices
-> RuleScope' 'Repr 'WithSlices -> Bool
forall a. Eq a => a -> a -> Bool
== RuleScope' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
RuleScope' evalCtx ctx
Previous
        then (Span -> SemanticError)
-> Span
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError Span -> SemanticError
PreviousInAuthorizer Span
sp
        else RuleScope' 'Repr 'WithSlices
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RuleScope' 'Repr 'WithSlices
s
  [RuleScope' 'Repr 'WithSlices]
-> Set (RuleScope' 'Repr 'WithSlices)
forall a. Ord a => [a] -> Set a
Set.fromList ([RuleScope' 'Repr 'WithSlices]
 -> Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity [RuleScope' 'Repr 'WithSlices]
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> ParsecT
     SemanticError Text Identity [RuleScope' 'Repr 'WithSlices]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (ParsecT SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
forall a. Parser a -> Parser a
l ParsecT SemanticError Text Identity (RuleScope' 'Repr 'WithSlices)
elemParser)
                          (ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity Char
 -> ParsecT SemanticError Text Identity Char)
-> ParsecT SemanticError Text Identity Char
-> ParsecT SemanticError Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
',')

queryItemParser :: Bool -> Parser (QueryItem' 'Repr 'WithSlices)
queryItemParser :: Bool -> Parser (QueryItem' 'Repr 'WithSlices)
queryItemParser Bool
inAuthorizer = do
  (Span
sp, ([Predicate' 'InPredicate 'WithSlices]
predicates, [Expression' 'WithSlices]
expressions, Set (RuleScope' 'Repr 'WithSlices)
scope)) <- Parser
  ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
   Set (RuleScope' 'Repr 'WithSlices))
-> Parser
     (Span,
      ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
       Set (RuleScope' 'Repr 'WithSlices)))
forall a. Parser a -> Parser (Span, a)
getSpan (Parser
   ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
    Set (RuleScope' 'Repr 'WithSlices))
 -> Parser
      (Span,
       ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
        Set (RuleScope' 'Repr 'WithSlices))))
-> Parser
     ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
      Set (RuleScope' 'Repr 'WithSlices))
-> Parser
     (Span,
      ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
       Set (RuleScope' 'Repr 'WithSlices)))
forall a b. (a -> b) -> a -> b
$ Bool
-> Parser
     ([Predicate' 'InPredicate 'WithSlices], [Expression' 'WithSlices],
      Set (RuleScope' 'Repr 'WithSlices))
ruleBodyParser Bool
inAuthorizer
  case [Predicate' 'InPredicate 'WithSlices]
-> [Expression' 'WithSlices]
-> Set (RuleScope' 'Repr 'WithSlices)
-> Validation (NonEmpty Text) (QueryItem' 'Repr 'WithSlices)
forall (ctx :: DatalogContext).
[Predicate' 'InPredicate ctx]
-> [Expression' ctx]
-> Set (RuleScope' 'Repr ctx)
-> Validation (NonEmpty Text) (QueryItem' 'Repr ctx)
makeQueryItem [Predicate' 'InPredicate 'WithSlices]
predicates [Expression' 'WithSlices]
expressions Set (RuleScope' 'Repr 'WithSlices)
scope of
    Failure NonEmpty Text
e  -> (Span -> SemanticError)
-> Span -> Parser (QueryItem' 'Repr 'WithSlices)
forall a. (Span -> SemanticError) -> Span -> Parser a
registerError (NonEmpty Text -> Span -> SemanticError
UnboundVariables NonEmpty Text
e) Span
sp
    Success QueryItem' 'Repr 'WithSlices
qi -> QueryItem' 'Repr 'WithSlices
-> Parser (QueryItem' 'Repr 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryItem' 'Repr 'WithSlices
qi

queryParser :: Bool -> Parser [QueryItem' 'Repr 'WithSlices]
queryParser :: Bool -> Parser [QueryItem' 'Repr 'WithSlices]
queryParser Bool
inAuthorizer =
   Parser (QueryItem' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser [QueryItem' 'Repr 'WithSlices]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Bool -> Parser (QueryItem' 'Repr 'WithSlices)
queryItemParser Bool
inAuthorizer) (ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a. Parser a -> Parser a
l (ParsecT SemanticError Text Identity (Tokens Text)
 -> ParsecT SemanticError Text Identity (Tokens Text))
-> ParsecT SemanticError Text Identity (Tokens Text)
-> ParsecT SemanticError Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
C.string' Tokens Text
"or" ParsecT SemanticError Text Identity (Tokens Text)
-> Parser () -> ParsecT SemanticError Text Identity (Tokens Text)
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
C.space)
     Parser [QueryItem' 'Repr 'WithSlices]
-> [Char] -> Parser [QueryItem' 'Repr 'WithSlices]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"datalog query"

checkParser :: Bool -> Parser (Check' 'Repr 'WithSlices)
checkParser :: Bool -> Parser (Check' 'Repr 'WithSlices)
checkParser Bool
inAuthorizer = do
  CheckKind
cKind <- Parser CheckKind -> Parser CheckKind
forall a. Parser a -> Parser a
l (Parser CheckKind -> Parser CheckKind)
-> Parser CheckKind -> Parser CheckKind
forall a b. (a -> b) -> a -> b
$ [Parser CheckKind] -> Parser CheckKind
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ CheckKind
CheckOne CheckKind
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser CheckKind
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"check if"
                      , CheckKind
CheckAll CheckKind
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser CheckKind
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"check all"
                      , CheckKind
Reject CheckKind
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser CheckKind
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"reject if"
                      ]
  [QueryItem' 'Repr 'WithSlices]
cQueries <- Bool -> Parser [QueryItem' 'Repr 'WithSlices]
queryParser Bool
inAuthorizer
  Check' 'Repr 'WithSlices -> Parser (Check' 'Repr 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Check{[QueryItem' 'Repr 'WithSlices]
CheckKind
cKind :: CheckKind
cQueries :: [QueryItem' 'Repr 'WithSlices]
cQueries :: [QueryItem' 'Repr 'WithSlices]
cKind :: CheckKind
..}

policyParser :: Parser (Policy' 'Repr 'WithSlices)
policyParser :: Parser (Policy' 'Repr 'WithSlices)
policyParser = do
  PolicyType
policy <- Parser PolicyType -> Parser PolicyType
forall a. Parser a -> Parser a
l (Parser PolicyType -> Parser PolicyType)
-> Parser PolicyType -> Parser PolicyType
forall a b. (a -> b) -> a -> b
$ [Parser PolicyType] -> Parser PolicyType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ PolicyType
Allow PolicyType
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser PolicyType
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"allow if"
                       , PolicyType
Deny  PolicyType
-> ParsecT SemanticError Text Identity (Tokens Text)
-> Parser PolicyType
forall a b.
a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT SemanticError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk Tokens Text
"deny if"
                       ]
  (PolicyType
policy, ) ([QueryItem' 'Repr 'WithSlices] -> Policy' 'Repr 'WithSlices)
-> Parser [QueryItem' 'Repr 'WithSlices]
-> Parser (Policy' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser [QueryItem' 'Repr 'WithSlices]
queryParser Bool
True

blockElementParser :: Bool -> Parser (BlockElement' 'Repr 'WithSlices)
blockElementParser :: Bool -> Parser (BlockElement' 'Repr 'WithSlices)
blockElementParser Bool
inAuthorizer = [Parser (BlockElement' 'Repr 'WithSlices)]
-> Parser (BlockElement' 'Repr 'WithSlices)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Check' 'Repr 'WithSlices -> BlockElement' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Check' evalCtx ctx -> BlockElement' evalCtx ctx
BlockCheck   (Check' 'Repr 'WithSlices -> BlockElement' 'Repr 'WithSlices)
-> Parser (Check' 'Repr 'WithSlices)
-> Parser (BlockElement' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser (Check' 'Repr 'WithSlices)
checkParser Bool
inAuthorizer Parser (BlockElement' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> Parser (BlockElement' 'Repr 'WithSlices)
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
';' Parser (BlockElement' 'Repr 'WithSlices)
-> [Char] -> Parser (BlockElement' 'Repr 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"check"
  , Rule' 'Repr 'WithSlices -> BlockElement' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Rule' evalCtx ctx -> BlockElement' evalCtx ctx
BlockRule    (Rule' 'Repr 'WithSlices -> BlockElement' 'Repr 'WithSlices)
-> Parser (Rule' 'Repr 'WithSlices)
-> Parser (BlockElement' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser (Rule' 'Repr 'WithSlices)
ruleParser  Bool
inAuthorizer Parser (BlockElement' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> Parser (BlockElement' 'Repr 'WithSlices)
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
';' Parser (BlockElement' 'Repr 'WithSlices)
-> [Char] -> Parser (BlockElement' 'Repr 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"rule"
  , Predicate' 'InFact 'WithSlices -> BlockElement' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Predicate' 'InFact ctx -> BlockElement' evalCtx ctx
BlockFact    (Predicate' 'InFact 'WithSlices -> BlockElement' 'Repr 'WithSlices)
-> Parser (Predicate' 'InFact 'WithSlices)
-> Parser (BlockElement' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Predicate' 'InFact 'WithSlices)
factParser Parser (BlockElement' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> Parser (BlockElement' 'Repr 'WithSlices)
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
';' Parser (BlockElement' 'Repr 'WithSlices)
-> [Char] -> Parser (BlockElement' 'Repr 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"fact"
  ]

authorizerElementParser :: Parser (AuthorizerElement' 'Repr 'WithSlices)
authorizerElementParser :: Parser (AuthorizerElement' 'Repr 'WithSlices)
authorizerElementParser = [Parser (AuthorizerElement' 'Repr 'WithSlices)]
-> Parser (AuthorizerElement' 'Repr 'WithSlices)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Policy' 'Repr 'WithSlices -> AuthorizerElement' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Policy' evalCtx ctx -> AuthorizerElement' evalCtx ctx
AuthorizerPolicy  (Policy' 'Repr 'WithSlices -> AuthorizerElement' 'Repr 'WithSlices)
-> Parser (Policy' 'Repr 'WithSlices)
-> Parser (AuthorizerElement' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Policy' 'Repr 'WithSlices)
policyParser Parser (AuthorizerElement' 'Repr 'WithSlices)
-> ParsecT SemanticError Text Identity Char
-> Parser (AuthorizerElement' 'Repr 'WithSlices)
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
';' Parser (AuthorizerElement' 'Repr 'WithSlices)
-> [Char] -> Parser (AuthorizerElement' 'Repr 'WithSlices)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"policy"
  , BlockElement' 'Repr 'WithSlices
-> AuthorizerElement' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockElement' evalCtx ctx -> AuthorizerElement' evalCtx ctx
BlockElement    (BlockElement' 'Repr 'WithSlices
 -> AuthorizerElement' 'Repr 'WithSlices)
-> Parser (BlockElement' 'Repr 'WithSlices)
-> Parser (AuthorizerElement' 'Repr 'WithSlices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser (BlockElement' 'Repr 'WithSlices)
blockElementParser Bool
True
  ]

blockParser :: Parser (Block' 'Repr 'WithSlices)
blockParser :: Parser (Block' 'Repr 'WithSlices)
blockParser = do
  Set (RuleScope' 'Repr 'WithSlices)
bScope <- Set (RuleScope' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Set (RuleScope' 'Repr 'WithSlices)
forall a. Set a
Set.empty (ParsecT
   SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
 -> ParsecT
      SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices)))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a b. (a -> b) -> a -> b
$ ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a. Parser a -> Parser a
l (Bool
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
scopeParser Bool
False ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT SemanticError Text Identity Char
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
';' ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> [Char]
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"scope annotation")
  [BlockElement' 'Repr 'WithSlices]
elems <- Parser (BlockElement' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity [BlockElement' 'Repr 'WithSlices]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser (BlockElement' 'Repr 'WithSlices)
 -> ParsecT
      SemanticError Text Identity [BlockElement' 'Repr 'WithSlices])
-> Parser (BlockElement' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity [BlockElement' 'Repr 'WithSlices]
forall a b. (a -> b) -> a -> b
$ Parser (BlockElement' 'Repr 'WithSlices)
-> Parser (BlockElement' 'Repr 'WithSlices)
forall a. Parser a -> Parser a
l (Parser (BlockElement' 'Repr 'WithSlices)
 -> Parser (BlockElement' 'Repr 'WithSlices))
-> Parser (BlockElement' 'Repr 'WithSlices)
-> Parser (BlockElement' 'Repr 'WithSlices)
forall a b. (a -> b) -> a -> b
$ Bool -> Parser (BlockElement' 'Repr 'WithSlices)
blockElementParser Bool
False
  Block' 'Repr 'WithSlices -> Parser (Block' 'Repr 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block' 'Repr 'WithSlices -> Parser (Block' 'Repr 'WithSlices))
-> Block' 'Repr 'WithSlices -> Parser (Block' 'Repr 'WithSlices)
forall a b. (a -> b) -> a -> b
$ ((BlockElement' 'Repr 'WithSlices -> Block' 'Repr 'WithSlices)
-> [BlockElement' 'Repr 'WithSlices] -> Block' 'Repr 'WithSlices
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap BlockElement' 'Repr 'WithSlices -> Block' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
BlockElement' evalCtx ctx -> Block' evalCtx ctx
elementToBlock [BlockElement' 'Repr 'WithSlices]
elems) { bScope :: Set (RuleScope' 'Repr 'WithSlices)
bScope = Set (RuleScope' 'Repr 'WithSlices)
bScope }

authorizerParser :: Parser (Authorizer' 'Repr 'WithSlices)
authorizerParser :: Parser (Authorizer' 'Repr 'WithSlices)
authorizerParser = do
  Set (RuleScope' 'Repr 'WithSlices)
bScope <- Set (RuleScope' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Set (RuleScope' 'Repr 'WithSlices)
forall a. Set a
Set.empty (ParsecT
   SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
 -> ParsecT
      SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices)))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a b. (a -> b) -> a -> b
$ ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a. Parser a -> Parser a
l (Bool
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
scopeParser Bool
True ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> ParsecT SemanticError Text Identity Char
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall a b.
ParsecT SemanticError Text Identity a
-> ParsecT SemanticError Text Identity b
-> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT SemanticError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
C.char Char
Token Text
';' ParsecT
  SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
-> [Char]
-> ParsecT
     SemanticError Text Identity (Set (RuleScope' 'Repr 'WithSlices))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"scope annotation")
  [AuthorizerElement' 'Repr 'WithSlices]
elems <- Parser (AuthorizerElement' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity [AuthorizerElement' 'Repr 'WithSlices]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser (AuthorizerElement' 'Repr 'WithSlices)
 -> ParsecT
      SemanticError Text Identity [AuthorizerElement' 'Repr 'WithSlices])
-> Parser (AuthorizerElement' 'Repr 'WithSlices)
-> ParsecT
     SemanticError Text Identity [AuthorizerElement' 'Repr 'WithSlices]
forall a b. (a -> b) -> a -> b
$ Parser (AuthorizerElement' 'Repr 'WithSlices)
-> Parser (AuthorizerElement' 'Repr 'WithSlices)
forall a. Parser a -> Parser a
l Parser (AuthorizerElement' 'Repr 'WithSlices)
authorizerElementParser
  let addScope :: Authorizer' 'Repr 'WithSlices -> Authorizer' 'Repr 'WithSlices
addScope Authorizer' 'Repr 'WithSlices
a = Authorizer' 'Repr 'WithSlices
a { vBlock :: Block' 'Repr 'WithSlices
vBlock = (Authorizer' 'Repr 'WithSlices -> Block' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
Authorizer' evalCtx ctx -> Block' evalCtx ctx
vBlock Authorizer' 'Repr 'WithSlices
a) { bScope :: Set (RuleScope' 'Repr 'WithSlices)
bScope = Set (RuleScope' 'Repr 'WithSlices)
bScope } }
  Authorizer' 'Repr 'WithSlices
-> Parser (Authorizer' 'Repr 'WithSlices)
forall a. a -> ParsecT SemanticError Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Authorizer' 'Repr 'WithSlices
 -> Parser (Authorizer' 'Repr 'WithSlices))
-> Authorizer' 'Repr 'WithSlices
-> Parser (Authorizer' 'Repr 'WithSlices)
forall a b. (a -> b) -> a -> b
$ Authorizer' 'Repr 'WithSlices -> Authorizer' 'Repr 'WithSlices
addScope (Authorizer' 'Repr 'WithSlices -> Authorizer' 'Repr 'WithSlices)
-> Authorizer' 'Repr 'WithSlices -> Authorizer' 'Repr 'WithSlices
forall a b. (a -> b) -> a -> b
$ (AuthorizerElement' 'Repr 'WithSlices
 -> Authorizer' 'Repr 'WithSlices)
-> [AuthorizerElement' 'Repr 'WithSlices]
-> Authorizer' 'Repr 'WithSlices
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap AuthorizerElement' 'Repr 'WithSlices
-> Authorizer' 'Repr 'WithSlices
forall (evalCtx :: EvaluationContext) (ctx :: DatalogContext).
AuthorizerElement' evalCtx ctx -> Authorizer' evalCtx ctx
elementToAuthorizer [AuthorizerElement' 'Repr 'WithSlices]
elems

parseWithParams :: Parser (a 'WithSlices)
                -> (Map Text Value -> Map Text PublicKey -> a 'WithSlices -> Validation (NonEmpty Text) (a 'Representation))
                -> Text
                -> Map Text Value -> Map Text PublicKey
                -> Either (NonEmpty Text) (a 'Representation)
parseWithParams :: forall (a :: DatalogContext -> *).
Parser (a 'WithSlices)
-> (Map Text Value
    -> Map Text PublicKey
    -> a 'WithSlices
    -> Validation (NonEmpty Text) (a 'Representation))
-> Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) (a 'Representation)
parseWithParams Parser (a 'WithSlices)
parser Map Text Value
-> Map Text PublicKey
-> a 'WithSlices
-> Validation (NonEmpty Text) (a 'Representation)
substitute Text
input Map Text Value
termMapping Map Text PublicKey
keyMapping = do
  a 'WithSlices
withSlices <- ([Char] -> NonEmpty Text)
-> Either [Char] (a 'WithSlices)
-> Either (NonEmpty Text) (a 'WithSlices)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> NonEmpty Text
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> NonEmpty Text)
-> ([Char] -> Text) -> [Char] -> NonEmpty Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) (Either [Char] (a 'WithSlices)
 -> Either (NonEmpty Text) (a 'WithSlices))
-> Either [Char] (a 'WithSlices)
-> Either (NonEmpty Text) (a 'WithSlices)
forall a b. (a -> b) -> a -> b
$ Parser (a 'WithSlices) -> Text -> Either [Char] (a 'WithSlices)
forall a. Parser a -> Text -> Either [Char] a
run Parser (a 'WithSlices)
parser Text
input
  Validation (NonEmpty Text) (a 'Representation)
-> Either (NonEmpty Text) (a 'Representation)
forall e a. Validation e a -> Either e a
validationToEither (Validation (NonEmpty Text) (a 'Representation)
 -> Either (NonEmpty Text) (a 'Representation))
-> Validation (NonEmpty Text) (a 'Representation)
-> Either (NonEmpty Text) (a 'Representation)
forall a b. (a -> b) -> a -> b
$ Map Text Value
-> Map Text PublicKey
-> a 'WithSlices
-> Validation (NonEmpty Text) (a 'Representation)
substitute Map Text Value
termMapping Map Text PublicKey
keyMapping a 'WithSlices
withSlices

parseBlock :: Text -> Map Text Value -> Map Text PublicKey
           -> Either (NonEmpty Text) Block
parseBlock :: Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) Block
parseBlock = Parser (Block' 'Repr 'WithSlices)
-> (Map Text Value
    -> Map Text PublicKey
    -> Block' 'Repr 'WithSlices
    -> Validation (NonEmpty Text) Block)
-> Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) Block
forall (a :: DatalogContext -> *).
Parser (a 'WithSlices)
-> (Map Text Value
    -> Map Text PublicKey
    -> a 'WithSlices
    -> Validation (NonEmpty Text) (a 'Representation))
-> Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) (a 'Representation)
parseWithParams Parser (Block' 'Repr 'WithSlices)
blockParser Map Text Value
-> Map Text PublicKey
-> Block' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Block
substituteBlock

parseAuthorizer :: Text -> Map Text Value -> Map Text PublicKey
                -> Either (NonEmpty Text) Authorizer
parseAuthorizer :: Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) Authorizer
parseAuthorizer = Parser (Authorizer' 'Repr 'WithSlices)
-> (Map Text Value
    -> Map Text PublicKey
    -> Authorizer' 'Repr 'WithSlices
    -> Validation (NonEmpty Text) Authorizer)
-> Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) Authorizer
forall (a :: DatalogContext -> *).
Parser (a 'WithSlices)
-> (Map Text Value
    -> Map Text PublicKey
    -> a 'WithSlices
    -> Validation (NonEmpty Text) (a 'Representation))
-> Text
-> Map Text Value
-> Map Text PublicKey
-> Either (NonEmpty Text) (a 'Representation)
parseWithParams Parser (Authorizer' 'Repr 'WithSlices)
authorizerParser Map Text Value
-> Map Text PublicKey
-> Authorizer' 'Repr 'WithSlices
-> Validation (NonEmpty Text) Authorizer
substituteAuthorizer

compileParser :: Lift a => Parser a -> (a -> Q Exp) -> String -> Q Exp
compileParser :: forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser Parser a
p a -> Q Exp
build =
  ([Char] -> Q Exp) -> (a -> Q Exp) -> Either [Char] a -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail a -> Q Exp
build (Either [Char] a -> Q Exp)
-> ([Char] -> Either [Char] a) -> [Char] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Text -> Either [Char] a
forall a. Parser a -> Text -> Either [Char] a
run Parser a
p (Text -> Either [Char] a)
-> ([Char] -> Text) -> [Char] -> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- | Quasiquoter for a rule expression. You can reference haskell variables
-- like this: @{variableName}@.
--
-- You most likely want to directly use 'block' or 'authorizer' instead.
rule :: QuasiQuoter
rule :: QuasiQuoter
rule = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser (Rule' 'Repr 'WithSlices)
-> (Rule' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser (Bool -> Parser (Rule' 'Repr 'WithSlices)
ruleParser Bool
False) ((Rule' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp)
-> (Rule' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Rule' 'Repr 'WithSlices
result -> [| result :: Rule |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }

-- | Quasiquoter for a predicate expression. You can reference haskell variables
-- like this: @{variableName}@.
--
-- You most likely want to directly use 'block' or 'authorizer' instead.
predicate :: QuasiQuoter
predicate :: QuasiQuoter
predicate = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser (Predicate' 'InPredicate 'WithSlices)
-> (Predicate' 'InPredicate 'WithSlices -> Q Exp)
-> [Char]
-> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser Parser (Predicate' 'InPredicate 'WithSlices)
predicateParser ((Predicate' 'InPredicate 'WithSlices -> Q Exp) -> [Char] -> Q Exp)
-> (Predicate' 'InPredicate 'WithSlices -> Q Exp)
-> [Char]
-> Q Exp
forall a b. (a -> b) -> a -> b
$ \Predicate' 'InPredicate 'WithSlices
result -> [| result :: Predicate |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }

-- | Quasiquoter for a fact expression. You can reference haskell variables
-- like this: @{variableName}@.
--
-- You most likely want to directly use 'block' or 'authorizer' instead.
fact :: QuasiQuoter
fact :: QuasiQuoter
fact = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser (Predicate' 'InFact 'WithSlices)
-> (Predicate' 'InFact 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser Parser (Predicate' 'InFact 'WithSlices)
factParser ((Predicate' 'InFact 'WithSlices -> Q Exp) -> [Char] -> Q Exp)
-> (Predicate' 'InFact 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Predicate' 'InFact 'WithSlices
result -> [| result :: Fact |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }

-- | Quasiquoter for a check expression. You can reference haskell variables
-- like this: @{variableName}@.
--
-- You most likely want to directly use 'block' or 'authorizer' instead.
check :: QuasiQuoter
check :: QuasiQuoter
check = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser (Check' 'Repr 'WithSlices)
-> (Check' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser (Bool -> Parser (Check' 'Repr 'WithSlices)
checkParser Bool
False) ((Check' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp)
-> (Check' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Check' 'Repr 'WithSlices
result -> [| result :: Check |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }

-- | Compile-time parser for a block expression, intended to be used with the
-- @QuasiQuotes@ extension.
--
-- A typical use of 'block' looks like this:
--
-- > let fileName = "data.pdf"
-- >  in [block|
-- >       // datalog can reference haskell variables with {variableName}
-- >       resource({fileName});
-- >       rule($variable) <- fact($value), other_fact($value);
-- >       check if operation("read");
-- >     |]
block :: QuasiQuoter
block :: QuasiQuoter
block = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser (Block' 'Repr 'WithSlices)
-> (Block' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser Parser (Block' 'Repr 'WithSlices)
blockParser ((Block' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp)
-> (Block' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Block' 'Repr 'WithSlices
result -> [| result :: Block |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }

-- | Compile-time parser for an authorizer expression, intended to be used with the
-- @QuasiQuotes@ extension.
--
-- A typical use of 'authorizer' looks like this:
--
-- > do
-- >   now <- getCurrentTime
-- >   pure [authorizer|
-- >          // datalog can reference haskell variables with {variableName}
-- >          current_time({now});
-- >          // authorizers can contain facts, rules and checks like blocks, but
-- >          // also declare policies. While every check has to pass for a biscuit to
-- >          // be valid, policies are tried in order. The first one to match decides
-- >          // if the token is valid or not
-- >          allow if resource("file1");
-- >          deny if true;
-- >        |]
authorizer :: QuasiQuoter
authorizer :: QuasiQuoter
authorizer = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser (Authorizer' 'Repr 'WithSlices)
-> (Authorizer' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser Parser (Authorizer' 'Repr 'WithSlices)
authorizerParser ((Authorizer' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp)
-> (Authorizer' 'Repr 'WithSlices -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ \Authorizer' 'Repr 'WithSlices
result -> [| result :: Authorizer |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }

-- | Compile-time parser for a query expression, intended to be used with the
-- @QuasiQuotes@ extension.
--
-- A typical use of 'query' looks like this:
--
-- > [query|user($user_id) or group($group_id)|]
query :: QuasiQuoter
query :: QuasiQuoter
query = QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = Parser [QueryItem' 'Repr 'WithSlices]
-> ([QueryItem' 'Repr 'WithSlices] -> Q Exp) -> [Char] -> Q Exp
forall a. Lift a => Parser a -> (a -> Q Exp) -> [Char] -> Q Exp
compileParser (Bool -> Parser [QueryItem' 'Repr 'WithSlices]
queryParser Bool
False) (([QueryItem' 'Repr 'WithSlices] -> Q Exp) -> [Char] -> Q Exp)
-> ([QueryItem' 'Repr 'WithSlices] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ \[QueryItem' 'Repr 'WithSlices]
result -> [| result :: Query |]
  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"not supported"
  }