{-# 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
]
, [ 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
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"
}
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"
}
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"
}
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"
}
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"
}
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"
}
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"
}