{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-|
  Module      : Auth.Biscuit.Utils
  Copyright   : © Clément Delafargue, 2021
  License     : MIT
  Maintainer  : clement@delafargue.name
  Conversion functions between biscuit components and protobuf-encoded components
-}
module Auth.Biscuit.ProtoBufAdapter
  ( Symbols
  , extractSymbols
  , commonSymbols
  , buildSymbolTable
  , pbToBlock
  , blockToPb
  , pbToSignedBlock
  , signedBlockToPb
  , pbToProof
  ) where

import           Control.Monad            (when)
import           Crypto.PubKey.Ed25519    (PublicKey)
import           Data.Bifunctor           (first)
import           Data.Int                 (Int32, Int64)
import           Data.Map.Strict          (Map)
import qualified Data.Map.Strict          as Map
import qualified Data.Set                 as Set
import           Data.Text                (Text)
import           Data.Time                (UTCTime)
import           Data.Time.Clock.POSIX    (posixSecondsToUTCTime,
                                           utcTimeToPOSIXSeconds)
import           Data.Void                (absurd)

import qualified Auth.Biscuit.Crypto      as Crypto
import           Auth.Biscuit.Datalog.AST
import qualified Auth.Biscuit.Proto       as PB
import           Auth.Biscuit.Utils       (maybeToRight)

-- | A map to get symbol names from symbol ids
type Symbols = Map Int32 Text
-- | A map to get symbol ids from symbol names
type ReverseSymbols = Map Text Int32

-- | The common symbols defined in the biscuit spec
commonSymbols :: Symbols
commonSymbols :: Symbols
commonSymbols = [(Int32, Text)] -> Symbols
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int32, Text)] -> Symbols) -> [(Int32, Text)] -> Symbols
forall a b. (a -> b) -> a -> b
$ [Int32] -> [Text] -> [(Int32, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
0..]
  [ Text
"authority"
  , Text
"ambient"
  , Text
"resource"
  , Text
"operation"
  , Text
"right"
  , Text
"time"
  , Text
"revocation_id"
  ]

-- | Given existing symbols and a series of protobuf blocks,
-- compute the complete symbol mapping
extractSymbols :: Symbols -> [PB.Block] -> Symbols
extractSymbols :: Symbols -> [Block] -> Symbols
extractSymbols Symbols
existingSymbols [Block]
blocks =
    let blocksSymbols :: [Text]
blocksSymbols  = Repeated 1 (Value Text) -> [Text]
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Value Text) -> [Text])
-> (Block -> Repeated 1 (Value Text)) -> Block -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Repeated 1 (Value Text)
PB.symbols (Block -> [Text]) -> [Block] -> [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Block]
blocks
        startingIndex :: Int32
startingIndex = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Symbols -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Symbols
existingSymbols
     in Symbols
existingSymbols Symbols -> Symbols -> Symbols
forall a. Semigroup a => a -> a -> a
<> [(Int32, Text)] -> Symbols
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Int32] -> [Text] -> [(Int32, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
startingIndex..] [Text]
blocksSymbols)

-- | Given existing symbols and a biscuit block, compute the
-- symbol table for the given block. Already existing symbols
-- won't be included
buildSymbolTable :: Symbols -> Block -> Symbols
buildSymbolTable :: Symbols -> Block -> Symbols
buildSymbolTable Symbols
existingSymbols Block
block =
  let allSymbols :: Set Text
allSymbols = Block -> Set Text
listSymbolsInBlock Block
block
      newSymbols :: Set Text
newSymbols = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Text
allSymbols ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Symbols -> [Text]
forall k a. Map k a -> [a]
Map.elems Symbols
existingSymbols)
      newSymbolsWithIndices :: [(Int32, Text)]
newSymbolsWithIndices = [Int32] -> [Text] -> [(Int32, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> [Int] -> [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbols -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Symbols
existingSymbols..]) (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
newSymbols)
   in [(Int32, Text)] -> Symbols
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int32, Text)]
newSymbolsWithIndices

reverseSymbols :: Symbols -> ReverseSymbols
reverseSymbols :: Symbols -> ReverseSymbols
reverseSymbols =
  let swap :: (b, a) -> (a, b)
swap (b
a,a
b) = (a
b,b
a)
   in [(Text, Int32)] -> ReverseSymbols
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Int32)] -> ReverseSymbols)
-> (Symbols -> [(Text, Int32)]) -> Symbols -> ReverseSymbols
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int32, Text) -> (Text, Int32))
-> [(Int32, Text)] -> [(Text, Int32)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32, Text) -> (Text, Int32)
forall b a. (b, a) -> (a, b)
swap ([(Int32, Text)] -> [(Text, Int32)])
-> (Symbols -> [(Int32, Text)]) -> Symbols -> [(Text, Int32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbols -> [(Int32, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList

getSymbolCode :: Integral i => ReverseSymbols -> Text -> i
getSymbolCode :: ReverseSymbols -> Text -> i
getSymbolCode = (Int32 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> i) -> (Text -> Int32) -> Text -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Text -> Int32) -> Text -> i)
-> (ReverseSymbols -> Text -> Int32) -> ReverseSymbols -> Text -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReverseSymbols -> Text -> Int32
forall k a. Ord k => Map k a -> k -> a
(Map.!)

pbToPublicKey :: PB.PublicKey -> Either String PublicKey
pbToPublicKey :: PublicKey -> Either String PublicKey
pbToPublicKey PB.PublicKey{Required 1 (Enumeration Algorithm)
Required 2 (Value ByteString)
$sel:key:PublicKey :: PublicKey -> Required 2 (Value ByteString)
$sel:algorithm:PublicKey :: PublicKey -> Required 1 (Enumeration Algorithm)
key :: Required 2 (Value ByteString)
algorithm :: Required 1 (Enumeration Algorithm)
..} =
  let keyBytes :: FieldType (Field 2 (RequiredField (Always (Value ByteString))))
keyBytes = Field 2 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 2 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Value ByteString)))
Required 2 (Value ByteString)
key
      parseKey :: ByteString -> Either CryptoError PublicKey
parseKey = CryptoFailable PublicKey -> Either CryptoError PublicKey
forall a. CryptoFailable a -> Either CryptoError a
Crypto.eitherCryptoError (CryptoFailable PublicKey -> Either CryptoError PublicKey)
-> (ByteString -> CryptoFailable PublicKey)
-> ByteString
-> Either CryptoError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Crypto.publicKey
   in case Field 1 (RequiredField (Always (Enumeration Algorithm)))
-> FieldType
     (Field 1 (RequiredField (Always (Enumeration Algorithm))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Enumeration Algorithm)))
Required 1 (Enumeration Algorithm)
algorithm of
        FieldType
  (Field 1 (RequiredField (Always (Enumeration Algorithm))))
PB.Ed25519 -> (CryptoError -> String)
-> Either CryptoError PublicKey -> Either String PublicKey
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> CryptoError -> String
forall a b. a -> b -> a
const String
"Invalid ed25519 public key") (Either CryptoError PublicKey -> Either String PublicKey)
-> Either CryptoError PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Either CryptoError PublicKey
parseKey ByteString
keyBytes

-- | Parse a protobuf signed block into a signed biscuit block
pbToSignedBlock :: PB.SignedBlock -> Either String Crypto.SignedBlock
pbToSignedBlock :: SignedBlock -> Either String SignedBlock
pbToSignedBlock PB.SignedBlock{Required 1 (Value ByteString)
Required 2 (Message PublicKey)
Required 3 (Value ByteString)
$sel:signature:SignedBlock :: SignedBlock -> Required 3 (Value ByteString)
$sel:nextKey:SignedBlock :: SignedBlock -> Required 2 (Message PublicKey)
$sel:block:SignedBlock :: SignedBlock -> Required 1 (Value ByteString)
signature :: Required 3 (Value ByteString)
nextKey :: Required 2 (Message PublicKey)
block :: Required 1 (Value ByteString)
..} = do
  Signature
sig <- (CryptoError -> String)
-> Either CryptoError Signature -> Either String Signature
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> CryptoError -> String
forall a b. a -> b -> a
const String
"Invalid signature") (Either CryptoError Signature -> Either String Signature)
-> Either CryptoError Signature -> Either String Signature
forall a b. (a -> b) -> a -> b
$ CryptoFailable Signature -> Either CryptoError Signature
forall a. CryptoFailable a -> Either CryptoError a
Crypto.eitherCryptoError (CryptoFailable Signature -> Either CryptoError Signature)
-> CryptoFailable Signature -> Either CryptoError Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Crypto.signature (ByteString -> CryptoFailable Signature)
-> ByteString -> CryptoFailable Signature
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 3 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 3 (RequiredField (Always (Value ByteString)))
Required 3 (Value ByteString)
signature
  PublicKey
pk  <- PublicKey -> Either String PublicKey
pbToPublicKey (PublicKey -> Either String PublicKey)
-> PublicKey -> Either String PublicKey
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message PublicKey)))
-> FieldType (Field 2 (RequiredField (Always (Message PublicKey))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Message PublicKey)))
Required 2 (Message PublicKey)
nextKey
  SignedBlock -> Either String SignedBlock
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Field 1 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 1 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Value ByteString)))
Required 1 (Value ByteString)
block
       , Signature
sig
       , PublicKey
pk
       )

publicKeyToPb :: PublicKey -> PB.PublicKey
publicKeyToPb :: PublicKey -> PublicKey
publicKeyToPb PublicKey
pk = PublicKey :: Required 1 (Enumeration Algorithm)
-> Required 2 (Value ByteString) -> PublicKey
PB.PublicKey
  { $sel:algorithm:PublicKey :: Required 1 (Enumeration Algorithm)
algorithm = FieldType
  (Field 1 (RequiredField (Always (Enumeration Algorithm))))
-> Field 1 (RequiredField (Always (Enumeration Algorithm)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType
  (Field 1 (RequiredField (Always (Enumeration Algorithm))))
Algorithm
PB.Ed25519
  , $sel:key:PublicKey :: Required 2 (Value ByteString)
key = FieldType (Field 2 (RequiredField (Always (Value ByteString))))
-> Field 2 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Value ByteString))))
 -> Field 2 (RequiredField (Always (Value ByteString))))
-> FieldType (Field 2 (RequiredField (Always (Value ByteString))))
-> Field 2 (RequiredField (Always (Value ByteString)))
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Crypto.convert PublicKey
pk
  }

signedBlockToPb :: Crypto.SignedBlock -> PB.SignedBlock
signedBlockToPb :: SignedBlock -> SignedBlock
signedBlockToPb (ByteString
block, Signature
sig, PublicKey
pk) = SignedBlock :: Required 1 (Value ByteString)
-> Required 2 (Message PublicKey)
-> Required 3 (Value ByteString)
-> SignedBlock
PB.SignedBlock
  { $sel:block:SignedBlock :: Required 1 (Value ByteString)
block = FieldType (Field 1 (RequiredField (Always (Value ByteString))))
-> Field 1 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 1 (RequiredField (Always (Value ByteString))))
block
  , $sel:signature:SignedBlock :: Required 3 (Value ByteString)
signature = FieldType (Field 3 (RequiredField (Always (Value ByteString))))
-> Field 3 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (RequiredField (Always (Value ByteString))))
 -> Field 3 (RequiredField (Always (Value ByteString))))
-> FieldType (Field 3 (RequiredField (Always (Value ByteString))))
-> Field 3 (RequiredField (Always (Value ByteString)))
forall a b. (a -> b) -> a -> b
$ Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Crypto.convert Signature
sig
  , $sel:nextKey:SignedBlock :: Required 2 (Message PublicKey)
nextKey = FieldType (Field 2 (RequiredField (Always (Message PublicKey))))
-> Field 2 (RequiredField (Always (Message PublicKey)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Message PublicKey))))
 -> Field 2 (RequiredField (Always (Message PublicKey))))
-> FieldType (Field 2 (RequiredField (Always (Message PublicKey))))
-> Field 2 (RequiredField (Always (Message PublicKey)))
forall a b. (a -> b) -> a -> b
$ PublicKey -> PublicKey
publicKeyToPb PublicKey
pk
  }

pbToProof :: PB.Proof -> Either String (Either Crypto.Signature Crypto.SecretKey)
pbToProof :: Proof -> Either String (Either Signature SecretKey)
pbToProof (PB.ProofSignature Required 2 (Value ByteString)
rawSig) = Signature -> Either Signature SecretKey
forall a b. a -> Either a b
Left  (Signature -> Either Signature SecretKey)
-> Either String Signature
-> Either String (Either Signature SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CryptoError -> String)
-> Either CryptoError Signature -> Either String Signature
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> CryptoError -> String
forall a b. a -> b -> a
const String
"Invalid signature proof") (CryptoFailable Signature -> Either CryptoError Signature
forall a. CryptoFailable a -> Either CryptoError a
Crypto.eitherCryptoError (CryptoFailable Signature -> Either CryptoError Signature)
-> CryptoFailable Signature -> Either CryptoError Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Crypto.signature (ByteString -> CryptoFailable Signature)
-> ByteString -> CryptoFailable Signature
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 2 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Value ByteString)))
Required 2 (Value ByteString)
rawSig)
pbToProof (PB.ProofSecret    Required 1 (Value ByteString)
rawPk)  = SecretKey -> Either Signature SecretKey
forall a b. b -> Either a b
Right (SecretKey -> Either Signature SecretKey)
-> Either String SecretKey
-> Either String (Either Signature SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CryptoError -> String)
-> Either CryptoError SecretKey -> Either String SecretKey
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> CryptoError -> String
forall a b. a -> b -> a
const String
"Invalid public key proof") (CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a. CryptoFailable a -> Either CryptoError a
Crypto.eitherCryptoError (CryptoFailable SecretKey -> Either CryptoError SecretKey)
-> CryptoFailable SecretKey -> Either CryptoError SecretKey
forall a b. (a -> b) -> a -> b
$ ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Crypto.secretKey (ByteString -> CryptoFailable SecretKey)
-> ByteString -> CryptoFailable SecretKey
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 1 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Value ByteString)))
Required 1 (Value ByteString)
rawPk)

-- | Parse a protobuf block into a proper biscuit block
pbToBlock :: Symbols -> PB.Block -> Either String Block
pbToBlock :: Symbols -> Block -> Either String Block
pbToBlock Symbols
s PB.Block{Repeated 1 (Value Text)
Repeated 4 (Message FactV2)
Repeated 5 (Message RuleV2)
Repeated 6 (Message CheckV2)
Optional 2 (Value Text)
Optional 3 (Value Int32)
$sel:checks_v2:Block :: Block -> Repeated 6 (Message CheckV2)
$sel:rules_v2:Block :: Block -> Repeated 5 (Message RuleV2)
$sel:facts_v2:Block :: Block -> Repeated 4 (Message FactV2)
$sel:version:Block :: Block -> Optional 3 (Value Int32)
$sel:context:Block :: Block -> Optional 2 (Value Text)
checks_v2 :: Repeated 6 (Message CheckV2)
rules_v2 :: Repeated 5 (Message RuleV2)
facts_v2 :: Repeated 4 (Message FactV2)
version :: Optional 3 (Value Int32)
context :: Optional 2 (Value Text)
symbols :: Repeated 1 (Value Text)
$sel:symbols:Block :: Block -> Repeated 1 (Value Text)
..} = do
  let bContext :: FieldType (Field 2 (OptionalField (Last (Value Text))))
bContext = Field 2 (OptionalField (Last (Value Text)))
-> FieldType (Field 2 (OptionalField (Last (Value Text))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (OptionalField (Last (Value Text)))
Optional 2 (Value Text)
context
      bVersion :: FieldType (Field 3 (OptionalField (Last (Value Int32))))
bVersion = Field 3 (OptionalField (Last (Value Int32)))
-> FieldType (Field 3 (OptionalField (Last (Value Int32))))
forall a. HasField a => a -> FieldType a
PB.getField Field 3 (OptionalField (Last (Value Int32)))
Optional 3 (Value Int32)
version
  [Fact]
bFacts <- (FactV2 -> Either String Fact) -> [FactV2] -> Either String [Fact]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> FactV2 -> Either String Fact
pbToFact Symbols
s) ([FactV2] -> Either String [Fact])
-> [FactV2] -> Either String [Fact]
forall a b. (a -> b) -> a -> b
$ Repeated 4 (Message FactV2)
-> FieldType (Repeated 4 (Message FactV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 4 (Message FactV2)
facts_v2
  [Rule]
bRules <- (RuleV2 -> Either String Rule) -> [RuleV2] -> Either String [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s) ([RuleV2] -> Either String [Rule])
-> [RuleV2] -> Either String [Rule]
forall a b. (a -> b) -> a -> b
$ Repeated 5 (Message RuleV2)
-> FieldType (Repeated 5 (Message RuleV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 5 (Message RuleV2)
rules_v2
  [Check]
bChecks <- (CheckV2 -> Either String Check)
-> [CheckV2] -> Either String [Check]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> CheckV2 -> Either String Check
pbToCheck Symbols
s) ([CheckV2] -> Either String [Check])
-> [CheckV2] -> Either String [Check]
forall a b. (a -> b) -> a -> b
$ Repeated 6 (Message CheckV2)
-> FieldType (Repeated 6 (Message CheckV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 6 (Message CheckV2)
checks_v2
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int32
bVersion Maybe Int32 -> Maybe Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
2) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"Unsupported biscuit version: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (Int32 -> String) -> Maybe Int32 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"0" Int32 -> String
forall a. Show a => a -> String
show Maybe Int32
bVersion String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Only version 2 is supported"
  Block -> Either String Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block :: forall (ctx :: ParsedAs).
[Rule' ctx]
-> [Predicate' 'InFact ctx]
-> [Check' ctx]
-> Maybe Text
-> Block' ctx
Block{ [Check]
[Rule]
[Fact]
Maybe Text
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bChecks :: [Check]
bRules :: [Rule]
bFacts :: [Fact]
bContext :: Maybe Text
.. }

-- | Turn a biscuit block into a protobuf block, for serialization,
-- along with the newly defined symbols
blockToPb :: Symbols -> Block -> (Symbols, PB.Block)
blockToPb :: Symbols -> Block -> (Symbols, Block)
blockToPb Symbols
existingSymbols b :: Block
b@Block{[Check]
[Rule]
[Fact]
Maybe Text
bContext :: Maybe Text
bChecks :: [Check]
bFacts :: [Fact]
bRules :: [Rule]
bContext :: forall (ctx :: ParsedAs). Block' ctx -> Maybe Text
bChecks :: forall (ctx :: ParsedAs). Block' ctx -> [Check' ctx]
bFacts :: forall (ctx :: ParsedAs). Block' ctx -> [Predicate' 'InFact ctx]
bRules :: forall (ctx :: ParsedAs). Block' ctx -> [Rule' ctx]
..} =
  let
      bSymbols :: Symbols
bSymbols = Symbols -> Block -> Symbols
buildSymbolTable Symbols
existingSymbols Block
b
      s :: ReverseSymbols
s = Symbols -> ReverseSymbols
reverseSymbols (Symbols -> ReverseSymbols) -> Symbols -> ReverseSymbols
forall a b. (a -> b) -> a -> b
$ Symbols
existingSymbols Symbols -> Symbols -> Symbols
forall a. Semigroup a => a -> a -> a
<> Symbols
bSymbols
      symbols :: Repeated 1 (Value Text)
symbols   = FieldType (Repeated 1 (Value Text)) -> Repeated 1 (Value Text)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Value Text)) -> Repeated 1 (Value Text))
-> FieldType (Repeated 1 (Value Text)) -> Repeated 1 (Value Text)
forall a b. (a -> b) -> a -> b
$ Symbols -> [Text]
forall k a. Map k a -> [a]
Map.elems Symbols
bSymbols
      context :: Field 2 (OptionalField (Last (Value Text)))
context   = FieldType (Field 2 (OptionalField (Last (Value Text))))
-> Field 2 (OptionalField (Last (Value Text)))
forall a. HasField a => FieldType a -> a
PB.putField Maybe Text
FieldType (Field 2 (OptionalField (Last (Value Text))))
bContext
      version :: Field 3 (OptionalField (Last (Value Int32)))
version   = FieldType (Field 3 (OptionalField (Last (Value Int32))))
-> Field 3 (OptionalField (Last (Value Int32)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (OptionalField (Last (Value Int32))))
 -> Field 3 (OptionalField (Last (Value Int32))))
-> FieldType (Field 3 (OptionalField (Last (Value Int32))))
-> Field 3 (OptionalField (Last (Value Int32)))
forall a b. (a -> b) -> a -> b
$ Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
2
      facts_v2 :: Repeated 4 (Message FactV2)
facts_v2  = FieldType (Repeated 4 (Message FactV2))
-> Repeated 4 (Message FactV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 4 (Message FactV2))
 -> Repeated 4 (Message FactV2))
-> FieldType (Repeated 4 (Message FactV2))
-> Repeated 4 (Message FactV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Fact -> FactV2
factToPb ReverseSymbols
s (Fact -> FactV2) -> [Fact] -> [FactV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fact]
bFacts
      rules_v2 :: Repeated 5 (Message RuleV2)
rules_v2  = FieldType (Repeated 5 (Message RuleV2))
-> Repeated 5 (Message RuleV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 5 (Message RuleV2))
 -> Repeated 5 (Message RuleV2))
-> FieldType (Repeated 5 (Message RuleV2))
-> Repeated 5 (Message RuleV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s (Rule -> RuleV2) -> [Rule] -> [RuleV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
bRules
      checks_v2 :: Repeated 6 (Message CheckV2)
checks_v2 = FieldType (Repeated 6 (Message CheckV2))
-> Repeated 6 (Message CheckV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 6 (Message CheckV2))
 -> Repeated 6 (Message CheckV2))
-> FieldType (Repeated 6 (Message CheckV2))
-> Repeated 6 (Message CheckV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Check -> CheckV2
checkToPb ReverseSymbols
s (Check -> CheckV2) -> [Check] -> [CheckV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks
   in (Symbols
bSymbols, Block :: Repeated 1 (Value Text)
-> Optional 2 (Value Text)
-> Optional 3 (Value Int32)
-> Repeated 4 (Message FactV2)
-> Repeated 5 (Message RuleV2)
-> Repeated 6 (Message CheckV2)
-> Block
PB.Block {Repeated 1 (Value Text)
Field 2 (OptionalField (Last (Value Text)))
Field 3 (OptionalField (Last (Value Int32)))
Repeated 4 (Message FactV2)
Repeated 5 (Message RuleV2)
Repeated 6 (Message CheckV2)
Optional 2 (Value Text)
Optional 3 (Value Int32)
checks_v2 :: Repeated 6 (Message CheckV2)
rules_v2 :: Repeated 5 (Message RuleV2)
facts_v2 :: Repeated 4 (Message FactV2)
version :: Field 3 (OptionalField (Last (Value Int32)))
context :: Field 2 (OptionalField (Last (Value Text)))
symbols :: Repeated 1 (Value Text)
$sel:checks_v2:Block :: Repeated 6 (Message CheckV2)
$sel:rules_v2:Block :: Repeated 5 (Message RuleV2)
$sel:facts_v2:Block :: Repeated 4 (Message FactV2)
$sel:version:Block :: Optional 3 (Value Int32)
$sel:context:Block :: Optional 2 (Value Text)
$sel:symbols:Block :: Repeated 1 (Value Text)
..})

pbToFact :: Symbols -> PB.FactV2 -> Either String Fact
pbToFact :: Symbols -> FactV2 -> Either String Fact
pbToFact Symbols
s PB.FactV2{Required 1 (Message PredicateV2)
$sel:predicate:FactV2 :: FactV2 -> Required 1 (Message PredicateV2)
predicate :: Required 1 (Message PredicateV2)
predicate} = do
  let pbName :: FieldType (Field 1 (RequiredField (Always (Value Int64))))
pbName  = Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField (Field 1 (RequiredField (Always (Value Int64)))
 -> FieldType (Field 1 (RequiredField (Always (Value Int64)))))
-> Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Required 1 (Value Int64)
PB.name  (PredicateV2 -> Required 1 (Value Int64))
-> PredicateV2 -> Required 1 (Value Int64)
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PredicateV2)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV2))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Message PredicateV2)))
Required 1 (Message PredicateV2)
predicate
      pbTerms :: FieldType (Repeated 2 (Message TermV2))
pbTerms = Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message TermV2)
 -> FieldType (Repeated 2 (Message TermV2)))
-> Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Repeated 2 (Message TermV2)
PB.terms (PredicateV2 -> Repeated 2 (Message TermV2))
-> PredicateV2 -> Repeated 2 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PredicateV2)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV2))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Message PredicateV2)))
Required 1 (Message PredicateV2)
predicate
  Text
name <- Symbols -> Int64 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s Int64
pbName
  [Value]
terms <- (TermV2 -> Either String Value)
-> [TermV2] -> Either String [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> TermV2 -> Either String Value
pbToValue Symbols
s) [TermV2]
pbTerms
  Fact -> Either String Fact
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Text -> [Term' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: [Value]
name :: Text
..}

factToPb :: ReverseSymbols -> Fact -> PB.FactV2
factToPb :: ReverseSymbols -> Fact -> FactV2
factToPb ReverseSymbols
s Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> Text
..} =
  let
      predicate :: PredicateV2
predicate = PredicateV2 :: Required 1 (Value Int64)
-> Repeated 2 (Message TermV2) -> PredicateV2
PB.PredicateV2
        { $sel:name:PredicateV2 :: Required 1 (Value Int64)
name  = FieldType (Field 1 (RequiredField (Always (Value Int64))))
-> Field 1 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Value Int64))))
 -> Field 1 (RequiredField (Always (Value Int64))))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
-> Field 1 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> Int64
forall i. Integral i => ReverseSymbols -> Text -> i
getSymbolCode ReverseSymbols
s Text
name
        , $sel:terms:PredicateV2 :: Repeated 2 (Message TermV2)
terms = FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message TermV2))
 -> Repeated 2 (Message TermV2))
-> FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Value -> TermV2
valueToPb ReverseSymbols
s (Value -> TermV2) -> [Value] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
terms
        }
   in FactV2 :: Required 1 (Message PredicateV2) -> FactV2
PB.FactV2{$sel:predicate:FactV2 :: Required 1 (Message PredicateV2)
predicate = FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
-> Field 1 (RequiredField (Always (Message PredicateV2)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
PredicateV2
predicate}

pbToRule :: Symbols -> PB.RuleV2 -> Either String Rule
pbToRule :: Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s RuleV2
pbRule = do
  let pbHead :: FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
pbHead = Field 1 (RequiredField (Always (Message PredicateV2)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV2))))
forall a. HasField a => a -> FieldType a
PB.getField (Field 1 (RequiredField (Always (Message PredicateV2)))
 -> FieldType
      (Field 1 (RequiredField (Always (Message PredicateV2)))))
-> Field 1 (RequiredField (Always (Message PredicateV2)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV2))))
forall a b. (a -> b) -> a -> b
$ RuleV2 -> Required 1 (Message PredicateV2)
PB.head RuleV2
pbRule
      pbBody :: FieldType (Repeated 2 (Message PredicateV2))
pbBody = Repeated 2 (Message PredicateV2)
-> FieldType (Repeated 2 (Message PredicateV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message PredicateV2)
 -> FieldType (Repeated 2 (Message PredicateV2)))
-> Repeated 2 (Message PredicateV2)
-> FieldType (Repeated 2 (Message PredicateV2))
forall a b. (a -> b) -> a -> b
$ RuleV2 -> Repeated 2 (Message PredicateV2)
PB.body RuleV2
pbRule
      pbExpressions :: FieldType (Repeated 3 (Message ExpressionV2))
pbExpressions = Repeated 3 (Message ExpressionV2)
-> FieldType (Repeated 3 (Message ExpressionV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 3 (Message ExpressionV2)
 -> FieldType (Repeated 3 (Message ExpressionV2)))
-> Repeated 3 (Message ExpressionV2)
-> FieldType (Repeated 3 (Message ExpressionV2))
forall a b. (a -> b) -> a -> b
$ RuleV2 -> Repeated 3 (Message ExpressionV2)
PB.expressions RuleV2
pbRule
  Predicate' 'InPredicate 'RegularString
rhead       <- Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate Symbols
s PredicateV2
pbHead
  [Predicate' 'InPredicate 'RegularString]
body        <- (PredicateV2
 -> Either String (Predicate' 'InPredicate 'RegularString))
-> [PredicateV2]
-> Either String [Predicate' 'InPredicate 'RegularString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate Symbols
s) [PredicateV2]
pbBody
  [Expression]
expressions <- (ExpressionV2 -> Either String Expression)
-> [ExpressionV2] -> Either String [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> ExpressionV2 -> Either String Expression
pbToExpression Symbols
s) [ExpressionV2]
pbExpressions
  Rule -> Either String Rule
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rule :: forall (ctx :: ParsedAs).
Predicate' 'InPredicate ctx
-> [Predicate' 'InPredicate ctx] -> [Expression' ctx] -> Rule' ctx
Rule {[Expression]
[Predicate' 'InPredicate 'RegularString]
Predicate' 'InPredicate 'RegularString
expressions :: [Expression]
body :: [Predicate' 'InPredicate 'RegularString]
rhead :: Predicate' 'InPredicate 'RegularString
expressions :: [Expression]
body :: [Predicate' 'InPredicate 'RegularString]
rhead :: Predicate' 'InPredicate 'RegularString
..}

ruleToPb :: ReverseSymbols -> Rule -> PB.RuleV2
ruleToPb :: ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s Rule{[Expression]
[Predicate' 'InPredicate 'RegularString]
Predicate' 'InPredicate 'RegularString
expressions :: [Expression]
body :: [Predicate' 'InPredicate 'RegularString]
rhead :: Predicate' 'InPredicate 'RegularString
expressions :: forall (ctx :: ParsedAs). Rule' ctx -> [Expression' ctx]
body :: forall (ctx :: ParsedAs).
Rule' ctx -> [Predicate' 'InPredicate ctx]
rhead :: forall (ctx :: ParsedAs). Rule' ctx -> Predicate' 'InPredicate ctx
..} =
  RuleV2 :: Required 1 (Message PredicateV2)
-> Repeated 2 (Message PredicateV2)
-> Repeated 3 (Message ExpressionV2)
-> RuleV2
PB.RuleV2
    { $sel:head:RuleV2 :: Required 1 (Message PredicateV2)
head = FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
-> Field 1 (RequiredField (Always (Message PredicateV2)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Message PredicateV2))))
 -> Field 1 (RequiredField (Always (Message PredicateV2))))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV2))))
-> Field 1 (RequiredField (Always (Message PredicateV2)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'RegularString -> PredicateV2
predicateToPb ReverseSymbols
s Predicate' 'InPredicate 'RegularString
rhead
    , $sel:body:RuleV2 :: Repeated 2 (Message PredicateV2)
body = FieldType (Repeated 2 (Message PredicateV2))
-> Repeated 2 (Message PredicateV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message PredicateV2))
 -> Repeated 2 (Message PredicateV2))
-> FieldType (Repeated 2 (Message PredicateV2))
-> Repeated 2 (Message PredicateV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'RegularString -> PredicateV2
predicateToPb ReverseSymbols
s (Predicate' 'InPredicate 'RegularString -> PredicateV2)
-> [Predicate' 'InPredicate 'RegularString] -> [PredicateV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Predicate' 'InPredicate 'RegularString]
body
    , $sel:expressions:RuleV2 :: Repeated 3 (Message ExpressionV2)
expressions = FieldType (Repeated 3 (Message ExpressionV2))
-> Repeated 3 (Message ExpressionV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 3 (Message ExpressionV2))
 -> Repeated 3 (Message ExpressionV2))
-> FieldType (Repeated 3 (Message ExpressionV2))
-> Repeated 3 (Message ExpressionV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Expression -> ExpressionV2
expressionToPb ReverseSymbols
s (Expression -> ExpressionV2) -> [Expression] -> [ExpressionV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
expressions
    }

pbToCheck :: Symbols -> PB.CheckV2 -> Either String Check
pbToCheck :: Symbols -> CheckV2 -> Either String Check
pbToCheck Symbols
s PB.CheckV2{Repeated 1 (Message RuleV2)
$sel:queries:CheckV2 :: CheckV2 -> Repeated 1 (Message RuleV2)
queries :: Repeated 1 (Message RuleV2)
queries} = do
  let toCheck :: Rule' ctx -> QueryItem' ctx
toCheck Rule{[Predicate' 'InPredicate ctx]
body :: [Predicate' 'InPredicate ctx]
body :: forall (ctx :: ParsedAs).
Rule' ctx -> [Predicate' 'InPredicate ctx]
body,[Expression' ctx]
expressions :: [Expression' ctx]
expressions :: forall (ctx :: ParsedAs). Rule' ctx -> [Expression' ctx]
expressions} = QueryItem :: forall (ctx :: ParsedAs).
[Predicate' 'InPredicate ctx]
-> [Expression' ctx] -> QueryItem' ctx
QueryItem{qBody :: [Predicate' 'InPredicate ctx]
qBody = [Predicate' 'InPredicate ctx]
body, qExpressions :: [Expression' ctx]
qExpressions = [Expression' ctx]
expressions }
  [Rule]
rules <- (RuleV2 -> Either String Rule) -> [RuleV2] -> Either String [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> RuleV2 -> Either String Rule
pbToRule Symbols
s) ([RuleV2] -> Either String [Rule])
-> [RuleV2] -> Either String [Rule]
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message RuleV2)
-> FieldType (Repeated 1 (Message RuleV2))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Message RuleV2)
queries
  Check -> Either String Check
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Check -> Either String Check) -> Check -> Either String Check
forall a b. (a -> b) -> a -> b
$ Rule -> QueryItem' 'RegularString
forall (ctx :: ParsedAs). Rule' ctx -> QueryItem' ctx
toCheck (Rule -> QueryItem' 'RegularString) -> [Rule] -> Check
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
rules

checkToPb :: ReverseSymbols -> Check -> PB.CheckV2
checkToPb :: ReverseSymbols -> Check -> CheckV2
checkToPb ReverseSymbols
s Check
items =
  let dummyHead :: Predicate' pof ctx
dummyHead = Text -> [Term' 'NotWithinSet pof ctx] -> Predicate' pof ctx
forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Text -> [Term' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate Text
"query" []
      toQuery :: QueryItem' 'RegularString -> RuleV2
toQuery QueryItem{[Expression]
[Predicate' 'InPredicate 'RegularString]
qExpressions :: [Expression]
qBody :: [Predicate' 'InPredicate 'RegularString]
qExpressions :: forall (ctx :: ParsedAs). QueryItem' ctx -> [Expression' ctx]
qBody :: forall (ctx :: ParsedAs).
QueryItem' ctx -> [Predicate' 'InPredicate ctx]
..} =
        ReverseSymbols -> Rule -> RuleV2
ruleToPb ReverseSymbols
s (Rule -> RuleV2) -> Rule -> RuleV2
forall a b. (a -> b) -> a -> b
$ Predicate' 'InPredicate 'RegularString
-> [Predicate' 'InPredicate 'RegularString] -> [Expression] -> Rule
forall (ctx :: ParsedAs).
Predicate' 'InPredicate ctx
-> [Predicate' 'InPredicate ctx] -> [Expression' ctx] -> Rule' ctx
Rule Predicate' 'InPredicate 'RegularString
forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx
dummyHead [Predicate' 'InPredicate 'RegularString]
qBody [Expression]
qExpressions
   in CheckV2 :: Repeated 1 (Message RuleV2) -> CheckV2
PB.CheckV2 { $sel:queries:CheckV2 :: Repeated 1 (Message RuleV2)
queries = FieldType (Repeated 1 (Message RuleV2))
-> Repeated 1 (Message RuleV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message RuleV2))
 -> Repeated 1 (Message RuleV2))
-> FieldType (Repeated 1 (Message RuleV2))
-> Repeated 1 (Message RuleV2)
forall a b. (a -> b) -> a -> b
$ QueryItem' 'RegularString -> RuleV2
toQuery (QueryItem' 'RegularString -> RuleV2) -> Check -> [RuleV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check
items }

getSymbol :: (Show i, Integral i) => Symbols -> i -> Either String Text
getSymbol :: Symbols -> i -> Either String Text
getSymbol Symbols
s i
i = String -> Maybe Text -> Either String Text
forall b a. b -> Maybe a -> Either b a
maybeToRight (String
"Missing symbol at id " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> i -> String
forall a. Show a => a -> String
show i
i) (Maybe Text -> Either String Text)
-> Maybe Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Int32 -> Symbols -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (i -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i) Symbols
s

pbToPredicate :: Symbols -> PB.PredicateV2 -> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate :: Symbols
-> PredicateV2
-> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate Symbols
s PredicateV2
pbPredicate = do
  let pbName :: FieldType (Field 1 (RequiredField (Always (Value Int64))))
pbName  = Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField (Field 1 (RequiredField (Always (Value Int64)))
 -> FieldType (Field 1 (RequiredField (Always (Value Int64)))))
-> Field 1 (RequiredField (Always (Value Int64)))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Required 1 (Value Int64)
PB.name  PredicateV2
pbPredicate
      pbTerms :: FieldType (Repeated 2 (Message TermV2))
pbTerms = Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message TermV2)
 -> FieldType (Repeated 2 (Message TermV2)))
-> Repeated 2 (Message TermV2)
-> FieldType (Repeated 2 (Message TermV2))
forall a b. (a -> b) -> a -> b
$ PredicateV2 -> Repeated 2 (Message TermV2)
PB.terms PredicateV2
pbPredicate
  Text
name <- Symbols -> Int64 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s Int64
pbName
  [Term]
terms <- (TermV2 -> Either String Term) -> [TermV2] -> Either String [Term]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s) [TermV2]
pbTerms
  Predicate' 'InPredicate 'RegularString
-> Either String (Predicate' 'InPredicate 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Text -> [Term' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate{[Term]
Text
terms :: [Term]
name :: Text
terms :: [Term]
name :: Text
..}

predicateToPb :: ReverseSymbols -> Predicate -> PB.PredicateV2
predicateToPb :: ReverseSymbols
-> Predicate' 'InPredicate 'RegularString -> PredicateV2
predicateToPb ReverseSymbols
s Predicate{[Term]
Text
terms :: [Term]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> [Term' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> Text
..} =
  PredicateV2 :: Required 1 (Value Int64)
-> Repeated 2 (Message TermV2) -> PredicateV2
PB.PredicateV2
    { $sel:name:PredicateV2 :: Required 1 (Value Int64)
name  = FieldType (Field 1 (RequiredField (Always (Value Int64))))
-> Field 1 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Value Int64))))
 -> Field 1 (RequiredField (Always (Value Int64))))
-> FieldType (Field 1 (RequiredField (Always (Value Int64))))
-> Field 1 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> Int64
forall i. Integral i => ReverseSymbols -> Text -> i
getSymbolCode ReverseSymbols
s Text
name
    , $sel:terms:PredicateV2 :: Repeated 2 (Message TermV2)
terms = FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message TermV2))
 -> Repeated 2 (Message TermV2))
-> FieldType (Repeated 2 (Message TermV2))
-> Repeated 2 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s (Term -> TermV2) -> [Term] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term]
terms
    }

pbTimeToUtcTime :: Int64 -> UTCTime
pbTimeToUtcTime :: Int64 -> UTCTime
pbTimeToUtcTime = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (Int64 -> POSIXTime) -> Int64 -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral

pbToTerm :: Symbols -> PB.TermV2 -> Either String Term
pbToTerm :: Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s = \case
  PB.TermInteger  Required 2 (Value Int64)
f -> Term -> Either String Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ Int -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Int -> Term' inSet pof ctx
LInteger (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Value Int64)))
Required 2 (Value Int64)
f
  PB.TermString   Required 3 (Value Int64)
f ->        Text -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> Term' inSet pof ctx
LString (Text -> Term) -> Either String Text -> Either String Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> Int64 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s (Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 3 (RequiredField (Always (Value Int64)))
Required 3 (Value Int64)
f)
  PB.TermDate     Required 4 (Value Int64)
f -> Term -> Either String Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
UTCTime -> Term' inSet pof ctx
LDate    (UTCTime -> Term) -> UTCTime -> Term
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 4 (RequiredField (Always (Value Int64)))
Required 4 (Value Int64)
f
  PB.TermBytes    Required 5 (Value ByteString)
f -> Term -> Either String Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ ByteString -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
ByteString -> Term' inSet pof ctx
LBytes   (ByteString -> Term) -> ByteString -> Term
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 5 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 5 (RequiredField (Always (Value ByteString)))
Required 5 (Value ByteString)
f
  PB.TermBool     Required 6 (Value Bool)
f -> Term -> Either String Term
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Either String Term) -> Term -> Either String Term
forall a b. (a -> b) -> a -> b
$ Bool -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Bool -> Term' inSet pof ctx
LBool    (Bool -> Term) -> Bool -> Term
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value Bool)))
-> FieldType (Field 6 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (RequiredField (Always (Value Bool)))
Required 6 (Value Bool)
f
  PB.TermVariable Required 1 (Value Int32)
f -> Text -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
VariableType inSet pof -> Term' inSet pof ctx
Variable (Text -> Term) -> Either String Text -> Either String Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> Int32 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s (Field 1 (RequiredField (Always (Value Int32)))
-> FieldType (Field 1 (RequiredField (Always (Value Int32))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Value Int32)))
Required 1 (Value Int32)
f)
  PB.TermTermSet  Required 7 (Message TermSet)
f -> Set (Term' 'WithinSet 'InFact 'RegularString) -> Term
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'RegularString) -> Term)
-> ([Term' 'WithinSet 'InFact 'RegularString]
    -> Set (Term' 'WithinSet 'InFact 'RegularString))
-> [Term' 'WithinSet 'InFact 'RegularString]
-> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'RegularString]
-> Set (Term' 'WithinSet 'InFact 'RegularString)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'RegularString] -> Term)
-> Either String [Term' 'WithinSet 'InFact 'RegularString]
-> Either String Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TermV2 -> Either String (Term' 'WithinSet 'InFact 'RegularString))
-> [TermV2]
-> Either String [Term' 'WithinSet 'InFact 'RegularString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
pbToSetValue Symbols
s) (Repeated 1 (Message TermV2) -> [TermV2]
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Message TermV2) -> [TermV2])
-> (TermSet -> Repeated 1 (Message TermV2)) -> TermSet -> [TermV2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermSet -> Repeated 1 (Message TermV2)
PB.set (TermSet -> [TermV2]) -> TermSet -> [TermV2]
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Message TermSet)))
-> FieldType (Field 7 (RequiredField (Always (Message TermSet))))
forall a. HasField a => a -> FieldType a
PB.getField Field 7 (RequiredField (Always (Message TermSet)))
Required 7 (Message TermSet)
f)

termToPb :: ReverseSymbols -> Term -> PB.TermV2
termToPb :: ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s = \case
  Variable VariableType 'NotWithinSet 'InPredicate
n -> Required 1 (Value Int32) -> TermV2
PB.TermVariable (Required 1 (Value Int32) -> TermV2)
-> Required 1 (Value Int32) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 1 (RequiredField (Always (Value Int32))))
-> Field 1 (RequiredField (Always (Value Int32)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Value Int32))))
 -> Field 1 (RequiredField (Always (Value Int32))))
-> FieldType (Field 1 (RequiredField (Always (Value Int32))))
-> Field 1 (RequiredField (Always (Value Int32)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> Int32
forall i. Integral i => ReverseSymbols -> Text -> i
getSymbolCode ReverseSymbols
s Text
VariableType 'NotWithinSet 'InPredicate
n
  LInteger Int
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger  (Required 2 (Value Int64) -> TermV2)
-> Required 2 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Value Int64))))
 -> Field 2 (RequiredField (Always (Value Int64))))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString   (Required 3 (Value Int64) -> TermV2)
-> Required 3 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 3 (RequiredField (Always (Value Int64))))
-> Field 3 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (RequiredField (Always (Value Int64))))
 -> Field 3 (RequiredField (Always (Value Int64))))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
-> Field 3 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> Int64
forall i. Integral i => ReverseSymbols -> Text -> i
getSymbolCode ReverseSymbols
s Text
v
  LDate    UTCTime
v -> Required 4 (Value Int64) -> TermV2
PB.TermDate     (Required 4 (Value Int64) -> TermV2)
-> Required 4 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 4 (RequiredField (Always (Value Int64))))
-> Field 4 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 4 (RequiredField (Always (Value Int64))))
 -> Field 4 (RequiredField (Always (Value Int64))))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
-> Field 4 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> POSIXTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
  LBytes   ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes    (Required 5 (Value ByteString) -> TermV2)
-> Required 5 (Value ByteString) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
v
  LBool    Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool     (Required 6 (Value Bool) -> TermV2)
-> Required 6 (Value Bool) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value Bool))))
-> Field 6 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 6 (RequiredField (Always (Value Bool))))
v
  TermSet SetType 'NotWithinSet 'RegularString
vs -> Required 7 (Message TermSet) -> TermV2
PB.TermTermSet  (Required 7 (Message TermSet) -> TermV2)
-> Required 7 (Message TermSet) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 7 (RequiredField (Always (Message TermSet))))
-> Field 7 (RequiredField (Always (Message TermSet)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 7 (RequiredField (Always (Message TermSet))))
 -> Field 7 (RequiredField (Always (Message TermSet))))
-> FieldType (Field 7 (RequiredField (Always (Message TermSet))))
-> Field 7 (RequiredField (Always (Message TermSet)))
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message TermV2) -> TermSet
PB.TermSet (Repeated 1 (Message TermV2) -> TermSet)
-> Repeated 1 (Message TermV2) -> TermSet
forall a b. (a -> b) -> a -> b
$ FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message TermV2))
 -> Repeated 1 (Message TermV2))
-> FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term' 'WithinSet 'InFact 'RegularString -> TermV2
setValueToPb ReverseSymbols
s (Term' 'WithinSet 'InFact 'RegularString -> TermV2)
-> [Term' 'WithinSet 'InFact 'RegularString] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Term' 'WithinSet 'InFact 'RegularString)
-> [Term' 'WithinSet 'InFact 'RegularString]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact 'RegularString)
SetType 'NotWithinSet 'RegularString
vs

  Antiquote SliceType 'RegularString
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SliceType 'RegularString
v

pbToValue :: Symbols -> PB.TermV2 -> Either String Value
pbToValue :: Symbols -> TermV2 -> Either String Value
pbToValue Symbols
s = \case
  PB.TermInteger  Required 2 (Value Int64)
f -> Value -> Either String Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Int -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Int -> Term' inSet pof ctx
LInteger (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Value Int64)))
Required 2 (Value Int64)
f
  PB.TermString   Required 3 (Value Int64)
f ->        Text -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> Term' inSet pof ctx
LString (Text -> Value) -> Either String Text -> Either String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> Int64 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s (Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 3 (RequiredField (Always (Value Int64)))
Required 3 (Value Int64)
f)
  PB.TermDate     Required 4 (Value Int64)
f -> Value -> Either String Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ UTCTime -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
UTCTime -> Term' inSet pof ctx
LDate    (UTCTime -> Value) -> UTCTime -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 4 (RequiredField (Always (Value Int64)))
Required 4 (Value Int64)
f
  PB.TermBytes    Required 5 (Value ByteString)
f -> Value -> Either String Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
ByteString -> Term' inSet pof ctx
LBytes   (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 5 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 5 (RequiredField (Always (Value ByteString)))
Required 5 (Value ByteString)
f
  PB.TermBool     Required 6 (Value Bool)
f -> Value -> Either String Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Bool -> Term' inSet pof ctx
LBool    (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value Bool)))
-> FieldType (Field 6 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (RequiredField (Always (Value Bool)))
Required 6 (Value Bool)
f
  PB.TermVariable Required 1 (Value Int32)
_ -> String -> Either String Value
forall a b. a -> Either a b
Left String
"Variables can't appear in facts"
  PB.TermTermSet  Required 7 (Message TermSet)
f -> Set (Term' 'WithinSet 'InFact 'RegularString) -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
SetType inSet ctx -> Term' inSet pof ctx
TermSet (Set (Term' 'WithinSet 'InFact 'RegularString) -> Value)
-> ([Term' 'WithinSet 'InFact 'RegularString]
    -> Set (Term' 'WithinSet 'InFact 'RegularString))
-> [Term' 'WithinSet 'InFact 'RegularString]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Term' 'WithinSet 'InFact 'RegularString]
-> Set (Term' 'WithinSet 'InFact 'RegularString)
forall a. Ord a => [a] -> Set a
Set.fromList ([Term' 'WithinSet 'InFact 'RegularString] -> Value)
-> Either String [Term' 'WithinSet 'InFact 'RegularString]
-> Either String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TermV2 -> Either String (Term' 'WithinSet 'InFact 'RegularString))
-> [TermV2]
-> Either String [Term' 'WithinSet 'InFact 'RegularString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
pbToSetValue Symbols
s) (Repeated 1 (Message TermV2) -> [TermV2]
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Message TermV2) -> [TermV2])
-> (TermSet -> Repeated 1 (Message TermV2)) -> TermSet -> [TermV2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermSet -> Repeated 1 (Message TermV2)
PB.set (TermSet -> [TermV2]) -> TermSet -> [TermV2]
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Message TermSet)))
-> FieldType (Field 7 (RequiredField (Always (Message TermSet))))
forall a. HasField a => a -> FieldType a
PB.getField Field 7 (RequiredField (Always (Message TermSet)))
Required 7 (Message TermSet)
f)

valueToPb :: ReverseSymbols -> Value -> PB.TermV2
valueToPb :: ReverseSymbols -> Value -> TermV2
valueToPb ReverseSymbols
s = \case
  LInteger Int
v -> Required 2 (Value Int64) -> TermV2
PB.TermInteger (Required 2 (Value Int64) -> TermV2)
-> Required 2 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Value Int64))))
 -> Field 2 (RequiredField (Always (Value Int64))))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 3 (Value Int64) -> TermV2
PB.TermString  (Required 3 (Value Int64) -> TermV2)
-> Required 3 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 3 (RequiredField (Always (Value Int64))))
-> Field 3 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (RequiredField (Always (Value Int64))))
 -> Field 3 (RequiredField (Always (Value Int64))))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
-> Field 3 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> Int64
forall i. Integral i => ReverseSymbols -> Text -> i
getSymbolCode ReverseSymbols
s Text
v
  LDate    UTCTime
v -> Required 4 (Value Int64) -> TermV2
PB.TermDate    (Required 4 (Value Int64) -> TermV2)
-> Required 4 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 4 (RequiredField (Always (Value Int64))))
-> Field 4 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 4 (RequiredField (Always (Value Int64))))
 -> Field 4 (RequiredField (Always (Value Int64))))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
-> Field 4 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> POSIXTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
  LBytes   ByteString
v -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes   (Required 5 (Value ByteString) -> TermV2)
-> Required 5 (Value ByteString) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
v
  LBool    Bool
v -> Required 6 (Value Bool) -> TermV2
PB.TermBool    (Required 6 (Value Bool) -> TermV2)
-> Required 6 (Value Bool) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value Bool))))
-> Field 6 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 6 (RequiredField (Always (Value Bool))))
v
  TermSet SetType 'NotWithinSet 'RegularString
vs -> Required 7 (Message TermSet) -> TermV2
PB.TermTermSet (Required 7 (Message TermSet) -> TermV2)
-> Required 7 (Message TermSet) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 7 (RequiredField (Always (Message TermSet))))
-> Field 7 (RequiredField (Always (Message TermSet)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 7 (RequiredField (Always (Message TermSet))))
 -> Field 7 (RequiredField (Always (Message TermSet))))
-> FieldType (Field 7 (RequiredField (Always (Message TermSet))))
-> Field 7 (RequiredField (Always (Message TermSet)))
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message TermV2) -> TermSet
PB.TermSet (Repeated 1 (Message TermV2) -> TermSet)
-> Repeated 1 (Message TermV2) -> TermSet
forall a b. (a -> b) -> a -> b
$ FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message TermV2))
 -> Repeated 1 (Message TermV2))
-> FieldType (Repeated 1 (Message TermV2))
-> Repeated 1 (Message TermV2)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term' 'WithinSet 'InFact 'RegularString -> TermV2
setValueToPb ReverseSymbols
s (Term' 'WithinSet 'InFact 'RegularString -> TermV2)
-> [Term' 'WithinSet 'InFact 'RegularString] -> [TermV2]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Term' 'WithinSet 'InFact 'RegularString)
-> [Term' 'WithinSet 'InFact 'RegularString]
forall a. Set a -> [a]
Set.toList Set (Term' 'WithinSet 'InFact 'RegularString)
SetType 'NotWithinSet 'RegularString
vs

  Variable VariableType 'NotWithinSet 'InFact
v  -> Void -> TermV2
forall a. Void -> a
absurd Void
VariableType 'NotWithinSet 'InFact
v
  Antiquote SliceType 'RegularString
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SliceType 'RegularString
v

pbToSetValue :: Symbols -> PB.TermV2 -> Either String (Term' 'WithinSet 'InFact 'RegularString)
pbToSetValue :: Symbols
-> TermV2
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
pbToSetValue Symbols
s = \case
  PB.TermInteger  Required 2 (Value Int64)
f -> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'RegularString
 -> Either String (Term' 'WithinSet 'InFact 'RegularString))
-> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ Int -> Term' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Int -> Term' inSet pof ctx
LInteger (Int -> Term' 'WithinSet 'InFact 'RegularString)
-> Int -> Term' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Value Int64)))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Value Int64)))
Required 2 (Value Int64)
f
  PB.TermString   Required 3 (Value Int64)
f ->        Text -> Term' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> Term' inSet pof ctx
LString  (Text -> Term' 'WithinSet 'InFact 'RegularString)
-> Either String Text
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> Int64 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s (Field 3 (RequiredField (Always (Value Int64)))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 3 (RequiredField (Always (Value Int64)))
Required 3 (Value Int64)
f)
  PB.TermDate     Required 4 (Value Int64)
f -> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'RegularString
 -> Either String (Term' 'WithinSet 'InFact 'RegularString))
-> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Term' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
UTCTime -> Term' inSet pof ctx
LDate    (UTCTime -> Term' 'WithinSet 'InFact 'RegularString)
-> UTCTime -> Term' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Int64)))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 4 (RequiredField (Always (Value Int64)))
Required 4 (Value Int64)
f
  PB.TermBytes    Required 5 (Value ByteString)
f -> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'RegularString
 -> Either String (Term' 'WithinSet 'InFact 'RegularString))
-> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Term' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
ByteString -> Term' inSet pof ctx
LBytes   (ByteString -> Term' 'WithinSet 'InFact 'RegularString)
-> ByteString -> Term' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 5 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 5 (RequiredField (Always (Value ByteString)))
Required 5 (Value ByteString)
f
  PB.TermBool     Required 6 (Value Bool)
f -> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term' 'WithinSet 'InFact 'RegularString
 -> Either String (Term' 'WithinSet 'InFact 'RegularString))
-> Term' 'WithinSet 'InFact 'RegularString
-> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ Bool -> Term' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Bool -> Term' inSet pof ctx
LBool    (Bool -> Term' 'WithinSet 'InFact 'RegularString)
-> Bool -> Term' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value Bool)))
-> FieldType (Field 6 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (RequiredField (Always (Value Bool)))
Required 6 (Value Bool)
f
  PB.TermVariable Required 1 (Value Int32)
_ -> String -> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall a b. a -> Either a b
Left String
"Variables can't appear in facts or sets"
  PB.TermTermSet  Required 7 (Message TermSet)
_ -> String -> Either String (Term' 'WithinSet 'InFact 'RegularString)
forall a b. a -> Either a b
Left String
"Sets can't be nested"

setValueToPb :: ReverseSymbols -> Term' 'WithinSet 'InFact 'RegularString -> PB.TermV2
setValueToPb :: ReverseSymbols -> Term' 'WithinSet 'InFact 'RegularString -> TermV2
setValueToPb ReverseSymbols
s = \case
  LInteger Int
v  -> Required 2 (Value Int64) -> TermV2
PB.TermInteger (Required 2 (Value Int64) -> TermV2)
-> Required 2 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Value Int64))))
 -> Field 2 (RequiredField (Always (Value Int64))))
-> FieldType (Field 2 (RequiredField (Always (Value Int64))))
-> Field 2 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v  -> Required 3 (Value Int64) -> TermV2
PB.TermString  (Required 3 (Value Int64) -> TermV2)
-> Required 3 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 3 (RequiredField (Always (Value Int64))))
-> Field 3 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (RequiredField (Always (Value Int64))))
 -> Field 3 (RequiredField (Always (Value Int64))))
-> FieldType (Field 3 (RequiredField (Always (Value Int64))))
-> Field 3 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Text -> Int64
forall i. Integral i => ReverseSymbols -> Text -> i
getSymbolCode ReverseSymbols
s Text
v
  LDate    UTCTime
v  -> Required 4 (Value Int64) -> TermV2
PB.TermDate    (Required 4 (Value Int64) -> TermV2)
-> Required 4 (Value Int64) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 4 (RequiredField (Always (Value Int64))))
-> Field 4 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 4 (RequiredField (Always (Value Int64))))
 -> Field 4 (RequiredField (Always (Value Int64))))
-> FieldType (Field 4 (RequiredField (Always (Value Int64))))
-> Field 4 (RequiredField (Always (Value Int64)))
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> POSIXTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
v
  LBytes   ByteString
v  -> Required 5 (Value ByteString) -> TermV2
PB.TermBytes   (Required 5 (Value ByteString) -> TermV2)
-> Required 5 (Value ByteString) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value ByteString))))
-> Field 5 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 5 (RequiredField (Always (Value ByteString))))
v
  LBool    Bool
v  -> Required 6 (Value Bool) -> TermV2
PB.TermBool    (Required 6 (Value Bool) -> TermV2)
-> Required 6 (Value Bool) -> TermV2
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value Bool))))
-> Field 6 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 6 (RequiredField (Always (Value Bool))))
v

  TermSet   SetType 'WithinSet 'RegularString
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SetType 'WithinSet 'RegularString
v
  Variable  VariableType 'WithinSet 'InFact
v -> Void -> TermV2
forall a. Void -> a
absurd Void
VariableType 'WithinSet 'InFact
v
  Antiquote SliceType 'RegularString
v -> Void -> TermV2
forall a. Void -> a
absurd Void
SliceType 'RegularString
v

pbToExpression :: Symbols -> PB.ExpressionV2 -> Either String Expression
pbToExpression :: Symbols -> ExpressionV2 -> Either String Expression
pbToExpression Symbols
s PB.ExpressionV2{Repeated 1 (Message Op)
$sel:ops:ExpressionV2 :: ExpressionV2 -> Repeated 1 (Message Op)
ops :: Repeated 1 (Message Op)
ops} = do
  [Op]
parsedOps <- (Op -> Either String Op) -> [Op] -> Either String [Op]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> Op -> Either String Op
pbToOp Symbols
s) ([Op] -> Either String [Op]) -> [Op] -> Either String [Op]
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message Op) -> FieldType (Repeated 1 (Message Op))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Message Op)
ops
  [Op] -> Either String Expression
fromStack [Op]
parsedOps

expressionToPb :: ReverseSymbols -> Expression -> PB.ExpressionV2
expressionToPb :: ReverseSymbols -> Expression -> ExpressionV2
expressionToPb ReverseSymbols
s Expression
e =
  let ops :: [Op]
ops = ReverseSymbols -> Op -> Op
opToPb ReverseSymbols
s (Op -> Op) -> [Op] -> [Op]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression -> [Op]
toStack Expression
e
   in ExpressionV2 :: Repeated 1 (Message Op) -> ExpressionV2
PB.ExpressionV2 { $sel:ops:ExpressionV2 :: Repeated 1 (Message Op)
ops = FieldType (Repeated 1 (Message Op)) -> Repeated 1 (Message Op)
forall a. HasField a => FieldType a -> a
PB.putField [Op]
FieldType (Repeated 1 (Message Op))
ops }

pbToOp :: Symbols -> PB.Op -> Either String Op
pbToOp :: Symbols -> Op -> Either String Op
pbToOp Symbols
s = \case
  PB.OpVValue Required 1 (Message TermV2)
v  -> Term -> Op
VOp (Term -> Op) -> Either String Term -> Either String Op
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> TermV2 -> Either String Term
pbToTerm Symbols
s (Field 1 (RequiredField (Always (Message TermV2)))
-> FieldType (Field 1 (RequiredField (Always (Message TermV2))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Message TermV2)))
Required 1 (Message TermV2)
v)
  PB.OpVUnary Required 2 (Message OpUnary)
v  -> Op -> Either String Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Op -> Either String Op)
-> (OpUnary -> Op) -> OpUnary -> Either String Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unary -> Op
UOp (Unary -> Op) -> (OpUnary -> Unary) -> OpUnary -> Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpUnary -> Unary
pbToUnary (OpUnary -> Either String Op) -> OpUnary -> Either String Op
forall a b. (a -> b) -> a -> b
$ Field 2 (RequiredField (Always (Message OpUnary)))
-> FieldType (Field 2 (RequiredField (Always (Message OpUnary))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Message OpUnary)))
Required 2 (Message OpUnary)
v
  PB.OpVBinary Required 3 (Message OpBinary)
v -> Op -> Either String Op
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Op -> Either String Op)
-> (OpBinary -> Op) -> OpBinary -> Either String Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binary -> Op
BOp (Binary -> Op) -> (OpBinary -> Binary) -> OpBinary -> Op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpBinary -> Binary
pbToBinary (OpBinary -> Either String Op) -> OpBinary -> Either String Op
forall a b. (a -> b) -> a -> b
$ Field 3 (RequiredField (Always (Message OpBinary)))
-> FieldType (Field 3 (RequiredField (Always (Message OpBinary))))
forall a. HasField a => a -> FieldType a
PB.getField Field 3 (RequiredField (Always (Message OpBinary)))
Required 3 (Message OpBinary)
v

opToPb :: ReverseSymbols -> Op -> PB.Op
opToPb :: ReverseSymbols -> Op -> Op
opToPb ReverseSymbols
s = \case
  VOp Term
t -> Required 1 (Message TermV2) -> Op
PB.OpVValue  (Required 1 (Message TermV2) -> Op)
-> Required 1 (Message TermV2) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Field 1 (RequiredField (Always (Message TermV2))))
-> Field 1 (RequiredField (Always (Message TermV2)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Message TermV2))))
 -> Field 1 (RequiredField (Always (Message TermV2))))
-> FieldType (Field 1 (RequiredField (Always (Message TermV2))))
-> Field 1 (RequiredField (Always (Message TermV2)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Term -> TermV2
termToPb ReverseSymbols
s Term
t
  UOp Unary
o -> Required 2 (Message OpUnary) -> Op
PB.OpVUnary  (Required 2 (Message OpUnary) -> Op)
-> Required 2 (Message OpUnary) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Message OpUnary))))
-> Field 2 (RequiredField (Always (Message OpUnary)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Message OpUnary))))
 -> Field 2 (RequiredField (Always (Message OpUnary))))
-> FieldType (Field 2 (RequiredField (Always (Message OpUnary))))
-> Field 2 (RequiredField (Always (Message OpUnary)))
forall a b. (a -> b) -> a -> b
$ Unary -> OpUnary
unaryToPb Unary
o
  BOp Binary
o -> Required 3 (Message OpBinary) -> Op
PB.OpVBinary (Required 3 (Message OpBinary) -> Op)
-> Required 3 (Message OpBinary) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Field 3 (RequiredField (Always (Message OpBinary))))
-> Field 3 (RequiredField (Always (Message OpBinary)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 3 (RequiredField (Always (Message OpBinary))))
 -> Field 3 (RequiredField (Always (Message OpBinary))))
-> FieldType (Field 3 (RequiredField (Always (Message OpBinary))))
-> Field 3 (RequiredField (Always (Message OpBinary)))
forall a b. (a -> b) -> a -> b
$ Binary -> OpBinary
binaryToPb Binary
o

pbToUnary :: PB.OpUnary -> Unary
pbToUnary :: OpUnary -> Unary
pbToUnary PB.OpUnary{Required 1 (Enumeration UnaryKind)
$sel:kind:OpUnary :: OpUnary -> Required 1 (Enumeration UnaryKind)
kind :: Required 1 (Enumeration UnaryKind)
kind} = case Field 1 (RequiredField (Always (Enumeration UnaryKind)))
-> FieldType
     (Field 1 (RequiredField (Always (Enumeration UnaryKind))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Enumeration UnaryKind)))
Required 1 (Enumeration UnaryKind)
kind of
  FieldType
  (Field 1 (RequiredField (Always (Enumeration UnaryKind))))
PB.Negate -> Unary
Negate
  FieldType
  (Field 1 (RequiredField (Always (Enumeration UnaryKind))))
PB.Parens -> Unary
Parens
  FieldType
  (Field 1 (RequiredField (Always (Enumeration UnaryKind))))
PB.Length -> Unary
Length

unaryToPb ::  Unary -> PB.OpUnary
unaryToPb :: Unary -> OpUnary
unaryToPb = Field 1 (RequiredField (Always (Enumeration UnaryKind))) -> OpUnary
Required 1 (Enumeration UnaryKind) -> OpUnary
PB.OpUnary (Field 1 (RequiredField (Always (Enumeration UnaryKind)))
 -> OpUnary)
-> (Unary
    -> Field 1 (RequiredField (Always (Enumeration UnaryKind))))
-> Unary
-> OpUnary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryKind
-> Field 1 (RequiredField (Always (Enumeration UnaryKind)))
forall a. HasField a => FieldType a -> a
PB.putField (UnaryKind
 -> Field 1 (RequiredField (Always (Enumeration UnaryKind))))
-> (Unary -> UnaryKind)
-> Unary
-> Field 1 (RequiredField (Always (Enumeration UnaryKind)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Unary
Negate -> UnaryKind
PB.Negate
  Unary
Parens -> UnaryKind
PB.Parens
  Unary
Length -> UnaryKind
PB.Length

pbToBinary :: PB.OpBinary -> Binary
pbToBinary :: OpBinary -> Binary
pbToBinary PB.OpBinary{Required 1 (Enumeration BinaryKind)
$sel:kind:OpBinary :: OpBinary -> Required 1 (Enumeration BinaryKind)
kind :: Required 1 (Enumeration BinaryKind)
kind} = case Field 1 (RequiredField (Always (Enumeration BinaryKind)))
-> FieldType
     (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Enumeration BinaryKind)))
Required 1 (Enumeration BinaryKind)
kind of
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.LessThan       -> Binary
LessThan
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.GreaterThan    -> Binary
GreaterThan
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.LessOrEqual    -> Binary
LessOrEqual
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.GreaterOrEqual -> Binary
GreaterOrEqual
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Equal          -> Binary
Equal
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Contains       -> Binary
Contains
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Prefix         -> Binary
Prefix
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Suffix         -> Binary
Suffix
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Regex          -> Binary
Regex
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Add            -> Binary
Add
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Sub            -> Binary
Sub
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Mul            -> Binary
Mul
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Div            -> Binary
Div
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.And            -> Binary
And
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Or             -> Binary
Or
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Intersection   -> Binary
Intersection
  FieldType
  (Field 1 (RequiredField (Always (Enumeration BinaryKind))))
PB.Union          -> Binary
Union

binaryToPb :: Binary -> PB.OpBinary
binaryToPb :: Binary -> OpBinary
binaryToPb = Field 1 (RequiredField (Always (Enumeration BinaryKind)))
-> OpBinary
Required 1 (Enumeration BinaryKind) -> OpBinary
PB.OpBinary (Field 1 (RequiredField (Always (Enumeration BinaryKind)))
 -> OpBinary)
-> (Binary
    -> Field 1 (RequiredField (Always (Enumeration BinaryKind))))
-> Binary
-> OpBinary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryKind
-> Field 1 (RequiredField (Always (Enumeration BinaryKind)))
forall a. HasField a => FieldType a -> a
PB.putField (BinaryKind
 -> Field 1 (RequiredField (Always (Enumeration BinaryKind))))
-> (Binary -> BinaryKind)
-> Binary
-> Field 1 (RequiredField (Always (Enumeration BinaryKind)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  Binary
LessThan       -> BinaryKind
PB.LessThan
  Binary
GreaterThan    -> BinaryKind
PB.GreaterThan
  Binary
LessOrEqual    -> BinaryKind
PB.LessOrEqual
  Binary
GreaterOrEqual -> BinaryKind
PB.GreaterOrEqual
  Binary
Equal          -> BinaryKind
PB.Equal
  Binary
Contains       -> BinaryKind
PB.Contains
  Binary
Prefix         -> BinaryKind
PB.Prefix
  Binary
Suffix         -> BinaryKind
PB.Suffix
  Binary
Regex          -> BinaryKind
PB.Regex
  Binary
Add            -> BinaryKind
PB.Add
  Binary
Sub            -> BinaryKind
PB.Sub
  Binary
Mul            -> BinaryKind
PB.Mul
  Binary
Div            -> BinaryKind
PB.Div
  Binary
And            -> BinaryKind
PB.And
  Binary
Or             -> BinaryKind
PB.Or
  Binary
Intersection   -> BinaryKind
PB.Intersection
  Binary
Union          -> BinaryKind
PB.Union