{-# 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.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           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
  | VarInSet  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"
    VarInSet  Span
_            -> [Char]
"Variables can't appear in a set"
    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

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
*> 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)

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 = 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 <- ParsecT
  SemanticError Text Identity (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]
sepBy (Parser (VariableType 'WithinSet 'InFact)
-> Parser (SetType 'WithinSet 'WithSlices)
-> ParsecT
     SemanticError Text Identity (Term' 'WithinSet 'InFact 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType 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
VarInSet 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)) (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

factTermParser :: Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
factTermParser :: Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
factTermParser = Parser (VariableType 'NotWithinSet 'InFact)
-> Parser (SetType 'NotWithinSet 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InFact 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType 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

predicateTermParser :: Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
predicateTermParser :: Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
predicateTermParser = Parser (VariableType 'NotWithinSet 'InPredicate)
-> Parser (SetType 'NotWithinSet 'WithSlices)
-> Parser (Term' 'NotWithinSet 'InPredicate 'WithSlices)
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType 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

termParser :: Parser (VariableType inSet pof)
           -> Parser (SetType inSet 'WithSlices)
           -> Parser (Term' inSet pof 'WithSlices)
termParser :: forall (inSet :: IsWithinSet) (pof :: PredicateOrFact).
Parser (VariableType inSet pof)
-> Parser (SetType inSet 'WithSlices)
-> Parser (Term' inSet pof 'WithSlices)
termParser Parser (VariableType inSet pof)
parseVar Parser (SetType inSet 'WithSlices)
parseSet = 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
  [ 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)"
  , 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)
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])"
  , 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)
-> ([Char] -> Text) -> [Char] -> Term' inSet pof 'WithSlices
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Term' inSet pof 'WithSlices)
-> ParsecT SemanticError Text Identity [Char]
-> Parser (Term' inSet pof 'WithSlices)
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
'"')) 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)"
  ]

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

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
EBinary 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
EBinary 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")
   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)
infixL Text
"&&" Binary
And ]
      , [ Text
-> Binary
-> Operator
     (ParsecT SemanticError Text Identity) (Expression' 'WithSlices)
forall {ctx :: DatalogContext}.
Text
-> Binary
-> Operator (ParsecT SemanticError Text Identity) (Expression' ctx)
infixL Text
"||" Binary
Or ]
      ]

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"
    ]
  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 <- 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 -> 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 <- 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"
  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
One 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
All 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"
                      ]
  [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"
  }