{-# 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
  ) where

import           Control.Monad            (when)
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           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 2 (Value Text) -> [Text]
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Value Text) -> [Text])
-> (Block -> Repeated 2 (Value Text)) -> Block -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Repeated 2 (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.!)

-- | 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 2 (Value Text)
Repeated 8 (Message FactV1)
Repeated 9 (Message RuleV1)
Repeated 10 (Message CheckV1)
Optional 6 (Value Text)
Optional 7 (Value Int32)
Required 1 (Value Int32)
$sel:checks_v1:Block :: Block -> Repeated 10 (Message CheckV1)
$sel:rules_v1:Block :: Block -> Repeated 9 (Message RuleV1)
$sel:facts_v1:Block :: Block -> Repeated 8 (Message FactV1)
$sel:version:Block :: Block -> Optional 7 (Value Int32)
$sel:context:Block :: Block -> Optional 6 (Value Text)
$sel:index:Block :: Block -> Required 1 (Value Int32)
checks_v1 :: Repeated 10 (Message CheckV1)
rules_v1 :: Repeated 9 (Message RuleV1)
facts_v1 :: Repeated 8 (Message FactV1)
version :: Optional 7 (Value Int32)
context :: Optional 6 (Value Text)
symbols :: Repeated 2 (Value Text)
index :: Required 1 (Value Int32)
$sel:symbols:Block :: Block -> Repeated 2 (Value Text)
..} = do
  let bContext :: FieldType (Field 6 (OptionalField (Last (Value Text))))
bContext = Field 6 (OptionalField (Last (Value Text)))
-> FieldType (Field 6 (OptionalField (Last (Value Text))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (OptionalField (Last (Value Text)))
Optional 6 (Value Text)
context
      bVersion :: FieldType (Field 7 (OptionalField (Last (Value Int32))))
bVersion = Field 7 (OptionalField (Last (Value Int32)))
-> FieldType (Field 7 (OptionalField (Last (Value Int32))))
forall a. HasField a => a -> FieldType a
PB.getField Field 7 (OptionalField (Last (Value Int32)))
Optional 7 (Value Int32)
version
  [Fact]
bFacts <- (FactV1 -> Either String Fact) -> [FactV1] -> Either String [Fact]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> FactV1 -> Either String Fact
pbToFact Symbols
s) ([FactV1] -> Either String [Fact])
-> [FactV1] -> Either String [Fact]
forall a b. (a -> b) -> a -> b
$ Repeated 8 (Message FactV1)
-> FieldType (Repeated 8 (Message FactV1))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 8 (Message FactV1)
facts_v1
  [Rule]
bRules <- (RuleV1 -> Either String Rule) -> [RuleV1] -> Either String [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> RuleV1 -> Either String Rule
pbToRule Symbols
s) ([RuleV1] -> Either String [Rule])
-> [RuleV1] -> Either String [Rule]
forall a b. (a -> b) -> a -> b
$ Repeated 9 (Message RuleV1)
-> FieldType (Repeated 9 (Message RuleV1))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 9 (Message RuleV1)
rules_v1
  [Check]
bChecks <- (CheckV1 -> Either String Check)
-> [CheckV1] -> Either String [Check]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> CheckV1 -> Either String Check
pbToCheck Symbols
s) ([CheckV1] -> Either String [Check])
-> [CheckV1] -> Either String [Check]
forall a b. (a -> b) -> a -> b
$ Repeated 10 (Message CheckV1)
-> FieldType (Repeated 10 (Message CheckV1))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 10 (Message CheckV1)
checks_v1
  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
1) (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 1 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 -> Int -> Block -> (Symbols, PB.Block)
blockToPb :: Symbols -> Int -> Block -> (Symbols, Block)
blockToPb Symbols
existingSymbols Int
bIndex 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
      index :: Field 1 (RequiredField (Always (Value Int32)))
index     = 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
$ Int -> FieldType (Field 1 (RequiredField (Always (Value Int32))))
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bIndex
      symbols :: Repeated 2 (Value Text)
symbols   = FieldType (Repeated 2 (Value Text)) -> Repeated 2 (Value Text)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Value Text)) -> Repeated 2 (Value Text))
-> FieldType (Repeated 2 (Value Text)) -> Repeated 2 (Value Text)
forall a b. (a -> b) -> a -> b
$ Symbols -> [Text]
forall k a. Map k a -> [a]
Map.elems Symbols
bSymbols
      context :: Field 6 (OptionalField (Last (Value Text)))
context   = FieldType (Field 6 (OptionalField (Last (Value Text))))
-> Field 6 (OptionalField (Last (Value Text)))
forall a. HasField a => FieldType a -> a
PB.putField Maybe Text
FieldType (Field 6 (OptionalField (Last (Value Text))))
bContext
      version :: Field 7 (OptionalField (Last (Value Int32)))
version   = FieldType (Field 7 (OptionalField (Last (Value Int32))))
-> Field 7 (OptionalField (Last (Value Int32)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 7 (OptionalField (Last (Value Int32))))
 -> Field 7 (OptionalField (Last (Value Int32))))
-> FieldType (Field 7 (OptionalField (Last (Value Int32))))
-> Field 7 (OptionalField (Last (Value Int32)))
forall a b. (a -> b) -> a -> b
$ Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
1
      facts_v1 :: Repeated 8 (Message FactV1)
facts_v1  = FieldType (Repeated 8 (Message FactV1))
-> Repeated 8 (Message FactV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 8 (Message FactV1))
 -> Repeated 8 (Message FactV1))
-> FieldType (Repeated 8 (Message FactV1))
-> Repeated 8 (Message FactV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Fact -> FactV1
factToPb ReverseSymbols
s (Fact -> FactV1) -> [Fact] -> [FactV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Fact]
bFacts
      rules_v1 :: Repeated 9 (Message RuleV1)
rules_v1  = FieldType (Repeated 9 (Message RuleV1))
-> Repeated 9 (Message RuleV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 9 (Message RuleV1))
 -> Repeated 9 (Message RuleV1))
-> FieldType (Repeated 9 (Message RuleV1))
-> Repeated 9 (Message RuleV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Rule -> RuleV1
ruleToPb ReverseSymbols
s (Rule -> RuleV1) -> [Rule] -> [RuleV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rule]
bRules
      checks_v1 :: Repeated 10 (Message CheckV1)
checks_v1 = FieldType (Repeated 10 (Message CheckV1))
-> Repeated 10 (Message CheckV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 10 (Message CheckV1))
 -> Repeated 10 (Message CheckV1))
-> FieldType (Repeated 10 (Message CheckV1))
-> Repeated 10 (Message CheckV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Check -> CheckV1
checkToPb ReverseSymbols
s (Check -> CheckV1) -> [Check] -> [CheckV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Check]
bChecks
   in (Symbols
bSymbols, Block :: Required 1 (Value Int32)
-> Repeated 2 (Value Text)
-> Optional 6 (Value Text)
-> Optional 7 (Value Int32)
-> Repeated 8 (Message FactV1)
-> Repeated 9 (Message RuleV1)
-> Repeated 10 (Message CheckV1)
-> Block
PB.Block {Field 1 (RequiredField (Always (Value Int32)))
Repeated 2 (Value Text)
Field 6 (OptionalField (Last (Value Text)))
Field 7 (OptionalField (Last (Value Int32)))
Repeated 8 (Message FactV1)
Repeated 9 (Message RuleV1)
Repeated 10 (Message CheckV1)
Optional 6 (Value Text)
Optional 7 (Value Int32)
Required 1 (Value Int32)
checks_v1 :: Repeated 10 (Message CheckV1)
rules_v1 :: Repeated 9 (Message RuleV1)
facts_v1 :: Repeated 8 (Message FactV1)
version :: Field 7 (OptionalField (Last (Value Int32)))
context :: Field 6 (OptionalField (Last (Value Text)))
symbols :: Repeated 2 (Value Text)
index :: Field 1 (RequiredField (Always (Value Int32)))
$sel:checks_v1:Block :: Repeated 10 (Message CheckV1)
$sel:rules_v1:Block :: Repeated 9 (Message RuleV1)
$sel:facts_v1:Block :: Repeated 8 (Message FactV1)
$sel:version:Block :: Optional 7 (Value Int32)
$sel:context:Block :: Optional 6 (Value Text)
$sel:index:Block :: Required 1 (Value Int32)
$sel:symbols:Block :: Repeated 2 (Value Text)
..})

pbToFact :: Symbols -> PB.FactV1 -> Either String Fact
pbToFact :: Symbols -> FactV1 -> Either String Fact
pbToFact Symbols
s PB.FactV1{Required 1 (Message PredicateV1)
$sel:predicate:FactV1 :: FactV1 -> Required 1 (Message PredicateV1)
predicate :: Required 1 (Message PredicateV1)
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
$ PredicateV1 -> Required 1 (Value Int64)
PB.name (PredicateV1 -> Required 1 (Value Int64))
-> PredicateV1 -> Required 1 (Value Int64)
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PredicateV1)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV1))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Message PredicateV1)))
Required 1 (Message PredicateV1)
predicate
      pbIds :: FieldType (Repeated 2 (Message IDV1))
pbIds  = Repeated 2 (Message IDV1) -> FieldType (Repeated 2 (Message IDV1))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message IDV1)
 -> FieldType (Repeated 2 (Message IDV1)))
-> Repeated 2 (Message IDV1)
-> FieldType (Repeated 2 (Message IDV1))
forall a b. (a -> b) -> a -> b
$ PredicateV1 -> Repeated 2 (Message IDV1)
PB.ids  (PredicateV1 -> Repeated 2 (Message IDV1))
-> PredicateV1 -> Repeated 2 (Message IDV1)
forall a b. (a -> b) -> a -> b
$ Field 1 (RequiredField (Always (Message PredicateV1)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV1))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Message PredicateV1)))
Required 1 (Message PredicateV1)
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 <- (IDV1 -> Either String Value) -> [IDV1] -> Either String [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> IDV1 -> Either String Value
pbToValue Symbols
s) [IDV1]
pbIds
  Fact -> Either String Fact
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Text -> [ID' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: [Value]
name :: Text
..}

factToPb :: ReverseSymbols -> Fact -> PB.FactV1
factToPb :: ReverseSymbols -> Fact -> FactV1
factToPb ReverseSymbols
s Predicate{[Value]
Text
terms :: [Value]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> [ID' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> Text
..} =
  let
      predicate :: PredicateV1
predicate = PredicateV1 :: Required 1 (Value Int64)
-> Repeated 2 (Message IDV1) -> PredicateV1
PB.PredicateV1
        { $sel:name:PredicateV1 :: 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:ids:PredicateV1 :: Repeated 2 (Message IDV1)
ids  = FieldType (Repeated 2 (Message IDV1)) -> Repeated 2 (Message IDV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message IDV1))
 -> Repeated 2 (Message IDV1))
-> FieldType (Repeated 2 (Message IDV1))
-> Repeated 2 (Message IDV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Value -> IDV1
valueToPb ReverseSymbols
s (Value -> IDV1) -> [Value] -> [IDV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
terms
        }
   in FactV1 :: Required 1 (Message PredicateV1) -> FactV1
PB.FactV1{$sel:predicate:FactV1 :: Required 1 (Message PredicateV1)
predicate = FieldType (Field 1 (RequiredField (Always (Message PredicateV1))))
-> Field 1 (RequiredField (Always (Message PredicateV1)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType (Field 1 (RequiredField (Always (Message PredicateV1))))
PredicateV1
predicate}

pbToRule :: Symbols -> PB.RuleV1 -> Either String Rule
pbToRule :: Symbols -> RuleV1 -> Either String Rule
pbToRule Symbols
s RuleV1
pbRule = do
  let pbHead :: FieldType (Field 1 (RequiredField (Always (Message PredicateV1))))
pbHead = Field 1 (RequiredField (Always (Message PredicateV1)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV1))))
forall a. HasField a => a -> FieldType a
PB.getField (Field 1 (RequiredField (Always (Message PredicateV1)))
 -> FieldType
      (Field 1 (RequiredField (Always (Message PredicateV1)))))
-> Field 1 (RequiredField (Always (Message PredicateV1)))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV1))))
forall a b. (a -> b) -> a -> b
$ RuleV1 -> Required 1 (Message PredicateV1)
PB.head RuleV1
pbRule
      pbBody :: FieldType (Repeated 2 (Message PredicateV1))
pbBody = Repeated 2 (Message PredicateV1)
-> FieldType (Repeated 2 (Message PredicateV1))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message PredicateV1)
 -> FieldType (Repeated 2 (Message PredicateV1)))
-> Repeated 2 (Message PredicateV1)
-> FieldType (Repeated 2 (Message PredicateV1))
forall a b. (a -> b) -> a -> b
$ RuleV1 -> Repeated 2 (Message PredicateV1)
PB.body RuleV1
pbRule
      pbExpressions :: FieldType (Repeated 3 (Message ExpressionV1))
pbExpressions = Repeated 3 (Message ExpressionV1)
-> FieldType (Repeated 3 (Message ExpressionV1))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 3 (Message ExpressionV1)
 -> FieldType (Repeated 3 (Message ExpressionV1)))
-> Repeated 3 (Message ExpressionV1)
-> FieldType (Repeated 3 (Message ExpressionV1))
forall a b. (a -> b) -> a -> b
$ RuleV1 -> Repeated 3 (Message ExpressionV1)
PB.expressions RuleV1
pbRule
  Predicate' 'InPredicate 'RegularString
rhead       <- Symbols
-> PredicateV1
-> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate Symbols
s PredicateV1
pbHead
  [Predicate' 'InPredicate 'RegularString]
body        <- (PredicateV1
 -> Either String (Predicate' 'InPredicate 'RegularString))
-> [PredicateV1]
-> Either String [Predicate' 'InPredicate 'RegularString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> PredicateV1
-> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate Symbols
s) [PredicateV1]
pbBody
  [Expression]
expressions <- (ExpressionV1 -> Either String Expression)
-> [ExpressionV1] -> Either String [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> ExpressionV1 -> Either String Expression
pbToExpression Symbols
s) [ExpressionV1]
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.RuleV1
ruleToPb :: ReverseSymbols -> Rule -> RuleV1
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
..} =
  RuleV1 :: Required 1 (Message PredicateV1)
-> Repeated 2 (Message PredicateV1)
-> Repeated 3 (Message ExpressionV1)
-> RuleV1
PB.RuleV1
    { $sel:head:RuleV1 :: Required 1 (Message PredicateV1)
head = FieldType (Field 1 (RequiredField (Always (Message PredicateV1))))
-> Field 1 (RequiredField (Always (Message PredicateV1)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Message PredicateV1))))
 -> Field 1 (RequiredField (Always (Message PredicateV1))))
-> FieldType
     (Field 1 (RequiredField (Always (Message PredicateV1))))
-> Field 1 (RequiredField (Always (Message PredicateV1)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'RegularString -> PredicateV1
predicateToPb ReverseSymbols
s Predicate' 'InPredicate 'RegularString
rhead
    , $sel:body:RuleV1 :: Repeated 2 (Message PredicateV1)
body = FieldType (Repeated 2 (Message PredicateV1))
-> Repeated 2 (Message PredicateV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message PredicateV1))
 -> Repeated 2 (Message PredicateV1))
-> FieldType (Repeated 2 (Message PredicateV1))
-> Repeated 2 (Message PredicateV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols
-> Predicate' 'InPredicate 'RegularString -> PredicateV1
predicateToPb ReverseSymbols
s (Predicate' 'InPredicate 'RegularString -> PredicateV1)
-> [Predicate' 'InPredicate 'RegularString] -> [PredicateV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Predicate' 'InPredicate 'RegularString]
body
    , $sel:expressions:RuleV1 :: Repeated 3 (Message ExpressionV1)
expressions = FieldType (Repeated 3 (Message ExpressionV1))
-> Repeated 3 (Message ExpressionV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 3 (Message ExpressionV1))
 -> Repeated 3 (Message ExpressionV1))
-> FieldType (Repeated 3 (Message ExpressionV1))
-> Repeated 3 (Message ExpressionV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> Expression -> ExpressionV1
expressionToPb ReverseSymbols
s (Expression -> ExpressionV1) -> [Expression] -> [ExpressionV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression]
expressions
    }

pbToCheck :: Symbols -> PB.CheckV1 -> Either String Check
pbToCheck :: Symbols -> CheckV1 -> Either String Check
pbToCheck Symbols
s PB.CheckV1{Repeated 1 (Message RuleV1)
$sel:queries:CheckV1 :: CheckV1 -> Repeated 1 (Message RuleV1)
queries :: Repeated 1 (Message RuleV1)
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 <- (RuleV1 -> Either String Rule) -> [RuleV1] -> Either String [Rule]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> RuleV1 -> Either String Rule
pbToRule Symbols
s) ([RuleV1] -> Either String [Rule])
-> [RuleV1] -> Either String [Rule]
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message RuleV1)
-> FieldType (Repeated 1 (Message RuleV1))
forall a. HasField a => a -> FieldType a
PB.getField Repeated 1 (Message RuleV1)
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.CheckV1
checkToPb :: ReverseSymbols -> Check -> CheckV1
checkToPb ReverseSymbols
s Check
items =
  let dummyHead :: Predicate' pof ctx
dummyHead = Text -> [ID' 'NotWithinSet pof ctx] -> Predicate' pof ctx
forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Text -> [ID' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate Text
"query" []
      toQuery :: QueryItem' 'RegularString -> RuleV1
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 -> RuleV1
ruleToPb ReverseSymbols
s (Rule -> RuleV1) -> Rule -> RuleV1
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 CheckV1 :: Repeated 1 (Message RuleV1) -> CheckV1
PB.CheckV1 { $sel:queries:CheckV1 :: Repeated 1 (Message RuleV1)
queries = FieldType (Repeated 1 (Message RuleV1))
-> Repeated 1 (Message RuleV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message RuleV1))
 -> Repeated 1 (Message RuleV1))
-> FieldType (Repeated 1 (Message RuleV1))
-> Repeated 1 (Message RuleV1)
forall a b. (a -> b) -> a -> b
$ QueryItem' 'RegularString -> RuleV1
toQuery (QueryItem' 'RegularString -> RuleV1) -> Check -> [RuleV1]
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.PredicateV1 -> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate :: Symbols
-> PredicateV1
-> Either String (Predicate' 'InPredicate 'RegularString)
pbToPredicate Symbols
s PredicateV1
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
$ PredicateV1 -> Required 1 (Value Int64)
PB.name PredicateV1
pbPredicate
      pbIds :: FieldType (Repeated 2 (Message IDV1))
pbIds  = Repeated 2 (Message IDV1) -> FieldType (Repeated 2 (Message IDV1))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 2 (Message IDV1)
 -> FieldType (Repeated 2 (Message IDV1)))
-> Repeated 2 (Message IDV1)
-> FieldType (Repeated 2 (Message IDV1))
forall a b. (a -> b) -> a -> b
$ PredicateV1 -> Repeated 2 (Message IDV1)
PB.ids  PredicateV1
pbPredicate
  Text
name <- Symbols -> Int64 -> Either String Text
forall i.
(Show i, Integral i) =>
Symbols -> i -> Either String Text
getSymbol Symbols
s Int64
pbName
  [ID]
terms <- (IDV1 -> Either String ID) -> [IDV1] -> Either String [ID]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols -> IDV1 -> Either String ID
pbToTerm Symbols
s) [IDV1]
pbIds
  Predicate' 'InPredicate 'RegularString
-> Either String (Predicate' 'InPredicate 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Predicate :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Text -> [ID' 'NotWithinSet pof ctx] -> Predicate' pof ctx
Predicate{[ID]
Text
terms :: [ID]
name :: Text
terms :: [ID]
name :: Text
..}

predicateToPb :: ReverseSymbols -> Predicate -> PB.PredicateV1
predicateToPb :: ReverseSymbols
-> Predicate' 'InPredicate 'RegularString -> PredicateV1
predicateToPb ReverseSymbols
s Predicate{[ID]
Text
terms :: [ID]
name :: Text
terms :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> [ID' 'NotWithinSet pof ctx]
name :: forall (pof :: PredicateOrFact) (ctx :: ParsedAs).
Predicate' pof ctx -> Text
..} =
  PredicateV1 :: Required 1 (Value Int64)
-> Repeated 2 (Message IDV1) -> PredicateV1
PB.PredicateV1
    { $sel:name:PredicateV1 :: 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:ids:PredicateV1 :: Repeated 2 (Message IDV1)
ids  = FieldType (Repeated 2 (Message IDV1)) -> Repeated 2 (Message IDV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 2 (Message IDV1))
 -> Repeated 2 (Message IDV1))
-> FieldType (Repeated 2 (Message IDV1))
-> Repeated 2 (Message IDV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> ID -> IDV1
termToPb ReverseSymbols
s (ID -> IDV1) -> [ID] -> [IDV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ID]
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.IDV1 -> Either String ID
pbToTerm :: Symbols -> IDV1 -> Either String ID
pbToTerm Symbols
s = \case
  PB.IDSymbol   Required 1 (Value Int64)
f ->        Text -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> ID' inSet pof ctx
Symbol  (Text -> ID) -> Either String Text -> Either String ID
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 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)))
Required 1 (Value Int64)
f)
  PB.IDInteger  Required 3 (Value Int64)
f -> ID -> Either String ID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID -> Either String ID) -> ID -> Either String ID
forall a b. (a -> b) -> a -> b
$ Int -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Int -> ID' inSet pof ctx
LInteger (Int -> ID) -> Int -> ID
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 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.IDString   Required 4 (Value Text)
f -> ID -> Either String ID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID -> Either String ID) -> ID -> Either String ID
forall a b. (a -> b) -> a -> b
$ Text -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> ID' inSet pof ctx
LString  (Text -> ID) -> Text -> ID
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Text)))
-> FieldType (Field 4 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
PB.getField Field 4 (RequiredField (Always (Value Text)))
Required 4 (Value Text)
f
  PB.IDDate     Required 5 (Value Int64)
f -> ID -> Either String ID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID -> Either String ID) -> ID -> Either String ID
forall a b. (a -> b) -> a -> b
$ UTCTime -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
UTCTime -> ID' inSet pof ctx
LDate    (UTCTime -> ID) -> UTCTime -> ID
forall a b. (a -> b) -> a -> b
$ Int64 -> UTCTime
pbTimeToUtcTime (Int64 -> UTCTime) -> Int64 -> UTCTime
forall a b. (a -> b) -> a -> b
$ Field 5 (RequiredField (Always (Value Int64)))
-> FieldType (Field 5 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 5 (RequiredField (Always (Value Int64)))
Required 5 (Value Int64)
f
  PB.IDBytes    Required 6 (Value ByteString)
f -> ID -> Either String ID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID -> Either String ID) -> ID -> Either String ID
forall a b. (a -> b) -> a -> b
$ ByteString -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
ByteString -> ID' inSet pof ctx
LBytes   (ByteString -> ID) -> ByteString -> ID
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 6 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (RequiredField (Always (Value ByteString)))
Required 6 (Value ByteString)
f
  PB.IDBool     Required 7 (Value Bool)
f -> ID -> Either String ID
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID -> Either String ID) -> ID -> Either String ID
forall a b. (a -> b) -> a -> b
$ Bool -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Bool -> ID' inSet pof ctx
LBool    (Bool -> ID) -> Bool -> ID
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Value Bool)))
-> FieldType (Field 7 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Field 7 (RequiredField (Always (Value Bool)))
Required 7 (Value Bool)
f
  PB.IDVariable Required 2 (Value Int32)
f -> Text -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
VariableType inSet pof -> ID' inSet pof ctx
Variable (Text -> ID) -> Either String Text -> Either String ID
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 2 (RequiredField (Always (Value Int32)))
-> FieldType (Field 2 (RequiredField (Always (Value Int32))))
forall a. HasField a => a -> FieldType a
PB.getField Field 2 (RequiredField (Always (Value Int32)))
Required 2 (Value Int32)
f)
  PB.IDIDSet    Required 8 (Message IDSet)
f -> Set (ID' 'WithinSet 'InFact 'RegularString) -> ID
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
SetType inSet ctx -> ID' inSet pof ctx
TermSet (Set (ID' 'WithinSet 'InFact 'RegularString) -> ID)
-> ([ID' 'WithinSet 'InFact 'RegularString]
    -> Set (ID' 'WithinSet 'InFact 'RegularString))
-> [ID' 'WithinSet 'InFact 'RegularString]
-> ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ID' 'WithinSet 'InFact 'RegularString]
-> Set (ID' 'WithinSet 'InFact 'RegularString)
forall a. Ord a => [a] -> Set a
Set.fromList ([ID' 'WithinSet 'InFact 'RegularString] -> ID)
-> Either String [ID' 'WithinSet 'InFact 'RegularString]
-> Either String ID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IDV1 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> [IDV1] -> Either String [ID' 'WithinSet 'InFact 'RegularString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> IDV1 -> Either String (ID' 'WithinSet 'InFact 'RegularString)
pbToSetValue Symbols
s) (Repeated 1 (Message IDV1) -> [IDV1]
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Message IDV1) -> [IDV1])
-> (IDSet -> Repeated 1 (Message IDV1)) -> IDSet -> [IDV1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDSet -> Repeated 1 (Message IDV1)
PB.set (IDSet -> [IDV1]) -> IDSet -> [IDV1]
forall a b. (a -> b) -> a -> b
$ Field 8 (RequiredField (Always (Message IDSet)))
-> FieldType (Field 8 (RequiredField (Always (Message IDSet))))
forall a. HasField a => a -> FieldType a
PB.getField Field 8 (RequiredField (Always (Message IDSet)))
Required 8 (Message IDSet)
f)

termToPb :: ReverseSymbols -> ID -> PB.IDV1
termToPb :: ReverseSymbols -> ID -> IDV1
termToPb ReverseSymbols
s = \case
  Variable VariableType 'NotWithinSet 'InPredicate
n -> Required 2 (Value Int32) -> IDV1
PB.IDVariable (Required 2 (Value Int32) -> IDV1)
-> Required 2 (Value Int32) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value Int32))))
-> Field 2 (RequiredField (Always (Value Int32)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 2 (RequiredField (Always (Value Int32))))
 -> Field 2 (RequiredField (Always (Value Int32))))
-> FieldType (Field 2 (RequiredField (Always (Value Int32))))
-> Field 2 (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
  Symbol   Text
n -> Required 1 (Value Int64) -> IDV1
PB.IDSymbol   (Required 1 (Value Int64) -> IDV1)
-> Required 1 (Value Int64) -> IDV1
forall a b. (a -> b) -> a -> b
$ 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
n
  LInteger Int
v -> Required 3 (Value Int64) -> IDV1
PB.IDInteger  (Required 3 (Value Int64) -> IDV1)
-> Required 3 (Value Int64) -> IDV1
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
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 4 (Value Text) -> IDV1
PB.IDString   (Required 4 (Value Text) -> IDV1)
-> Required 4 (Value Text) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 4 (RequiredField (Always (Value Text))))
-> Field 4 (RequiredField (Always (Value Text)))
forall a. HasField a => FieldType a -> a
PB.putField Text
FieldType (Field 4 (RequiredField (Always (Value Text))))
v
  LDate    UTCTime
v -> Required 5 (Value Int64) -> IDV1
PB.IDDate     (Required 5 (Value Int64) -> IDV1)
-> Required 5 (Value Int64) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value Int64))))
-> Field 5 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 5 (RequiredField (Always (Value Int64))))
 -> Field 5 (RequiredField (Always (Value Int64))))
-> FieldType (Field 5 (RequiredField (Always (Value Int64))))
-> Field 5 (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 6 (Value ByteString) -> IDV1
PB.IDBytes    (Required 6 (Value ByteString) -> IDV1)
-> Required 6 (Value ByteString) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value ByteString))))
-> Field 6 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 6 (RequiredField (Always (Value ByteString))))
v
  LBool    Bool
v -> Required 7 (Value Bool) -> IDV1
PB.IDBool     (Required 7 (Value Bool) -> IDV1)
-> Required 7 (Value Bool) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 7 (RequiredField (Always (Value Bool))))
-> Field 7 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 7 (RequiredField (Always (Value Bool))))
v
  TermSet SetType 'NotWithinSet 'RegularString
vs -> Required 8 (Message IDSet) -> IDV1
PB.IDIDSet    (Required 8 (Message IDSet) -> IDV1)
-> Required 8 (Message IDSet) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 8 (RequiredField (Always (Message IDSet))))
-> Field 8 (RequiredField (Always (Message IDSet)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 8 (RequiredField (Always (Message IDSet))))
 -> Field 8 (RequiredField (Always (Message IDSet))))
-> FieldType (Field 8 (RequiredField (Always (Message IDSet))))
-> Field 8 (RequiredField (Always (Message IDSet)))
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message IDV1) -> IDSet
PB.IDSet (Repeated 1 (Message IDV1) -> IDSet)
-> Repeated 1 (Message IDV1) -> IDSet
forall a b. (a -> b) -> a -> b
$ FieldType (Repeated 1 (Message IDV1)) -> Repeated 1 (Message IDV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message IDV1))
 -> Repeated 1 (Message IDV1))
-> FieldType (Repeated 1 (Message IDV1))
-> Repeated 1 (Message IDV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> ID' 'WithinSet 'InFact 'RegularString -> IDV1
setValueToPb ReverseSymbols
s (ID' 'WithinSet 'InFact 'RegularString -> IDV1)
-> [ID' 'WithinSet 'InFact 'RegularString] -> [IDV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (ID' 'WithinSet 'InFact 'RegularString)
-> [ID' 'WithinSet 'InFact 'RegularString]
forall a. Set a -> [a]
Set.toList Set (ID' 'WithinSet 'InFact 'RegularString)
SetType 'NotWithinSet 'RegularString
vs

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

pbToValue :: Symbols -> PB.IDV1 -> Either String Value
pbToValue :: Symbols -> IDV1 -> Either String Value
pbToValue Symbols
s = \case
  PB.IDSymbol   Required 1 (Value Int64)
f ->        Text -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> ID' inSet pof ctx
Symbol  (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 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)))
Required 1 (Value Int64)
f)
  PB.IDInteger  Required 3 (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 -> ID' 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 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.IDString   Required 4 (Value Text)
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
$ Text -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> ID' inSet pof ctx
LString  (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Text)))
-> FieldType (Field 4 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
PB.getField Field 4 (RequiredField (Always (Value Text)))
Required 4 (Value Text)
f
  PB.IDDate     Required 5 (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 -> ID' 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 5 (RequiredField (Always (Value Int64)))
-> FieldType (Field 5 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 5 (RequiredField (Always (Value Int64)))
Required 5 (Value Int64)
f
  PB.IDBytes    Required 6 (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 -> ID' inSet pof ctx
LBytes   (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 6 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (RequiredField (Always (Value ByteString)))
Required 6 (Value ByteString)
f
  PB.IDBool     Required 7 (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 -> ID' inSet pof ctx
LBool    (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Value Bool)))
-> FieldType (Field 7 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Field 7 (RequiredField (Always (Value Bool)))
Required 7 (Value Bool)
f
  PB.IDVariable Required 2 (Value Int32)
_ -> String -> Either String Value
forall a b. a -> Either a b
Left String
"Variables can't appear in facts"
  PB.IDIDSet    Required 8 (Message IDSet)
f -> Set (ID' 'WithinSet 'InFact 'RegularString) -> Value
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
SetType inSet ctx -> ID' inSet pof ctx
TermSet (Set (ID' 'WithinSet 'InFact 'RegularString) -> Value)
-> ([ID' 'WithinSet 'InFact 'RegularString]
    -> Set (ID' 'WithinSet 'InFact 'RegularString))
-> [ID' 'WithinSet 'InFact 'RegularString]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ID' 'WithinSet 'InFact 'RegularString]
-> Set (ID' 'WithinSet 'InFact 'RegularString)
forall a. Ord a => [a] -> Set a
Set.fromList ([ID' 'WithinSet 'InFact 'RegularString] -> Value)
-> Either String [ID' 'WithinSet 'InFact 'RegularString]
-> Either String Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IDV1 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> [IDV1] -> Either String [ID' 'WithinSet 'InFact 'RegularString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbols
-> IDV1 -> Either String (ID' 'WithinSet 'InFact 'RegularString)
pbToSetValue Symbols
s) (Repeated 1 (Message IDV1) -> [IDV1]
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 1 (Message IDV1) -> [IDV1])
-> (IDSet -> Repeated 1 (Message IDV1)) -> IDSet -> [IDV1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDSet -> Repeated 1 (Message IDV1)
PB.set (IDSet -> [IDV1]) -> IDSet -> [IDV1]
forall a b. (a -> b) -> a -> b
$ Field 8 (RequiredField (Always (Message IDSet)))
-> FieldType (Field 8 (RequiredField (Always (Message IDSet))))
forall a. HasField a => a -> FieldType a
PB.getField Field 8 (RequiredField (Always (Message IDSet)))
Required 8 (Message IDSet)
f)

valueToPb :: ReverseSymbols -> Value -> PB.IDV1
valueToPb :: ReverseSymbols -> Value -> IDV1
valueToPb ReverseSymbols
s = \case
  Symbol   Text
n -> Required 1 (Value Int64) -> IDV1
PB.IDSymbol  (Required 1 (Value Int64) -> IDV1)
-> Required 1 (Value Int64) -> IDV1
forall a b. (a -> b) -> a -> b
$ 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
n
  LInteger Int
v -> Required 3 (Value Int64) -> IDV1
PB.IDInteger (Required 3 (Value Int64) -> IDV1)
-> Required 3 (Value Int64) -> IDV1
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
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 4 (Value Text) -> IDV1
PB.IDString  (Required 4 (Value Text) -> IDV1)
-> Required 4 (Value Text) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 4 (RequiredField (Always (Value Text))))
-> Field 4 (RequiredField (Always (Value Text)))
forall a. HasField a => FieldType a -> a
PB.putField Text
FieldType (Field 4 (RequiredField (Always (Value Text))))
v
  LDate    UTCTime
v -> Required 5 (Value Int64) -> IDV1
PB.IDDate    (Required 5 (Value Int64) -> IDV1)
-> Required 5 (Value Int64) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value Int64))))
-> Field 5 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 5 (RequiredField (Always (Value Int64))))
 -> Field 5 (RequiredField (Always (Value Int64))))
-> FieldType (Field 5 (RequiredField (Always (Value Int64))))
-> Field 5 (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 6 (Value ByteString) -> IDV1
PB.IDBytes   (Required 6 (Value ByteString) -> IDV1)
-> Required 6 (Value ByteString) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value ByteString))))
-> Field 6 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 6 (RequiredField (Always (Value ByteString))))
v
  LBool    Bool
v -> Required 7 (Value Bool) -> IDV1
PB.IDBool    (Required 7 (Value Bool) -> IDV1)
-> Required 7 (Value Bool) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 7 (RequiredField (Always (Value Bool))))
-> Field 7 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 7 (RequiredField (Always (Value Bool))))
v
  TermSet SetType 'NotWithinSet 'RegularString
vs -> Required 8 (Message IDSet) -> IDV1
PB.IDIDSet   (Required 8 (Message IDSet) -> IDV1)
-> Required 8 (Message IDSet) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 8 (RequiredField (Always (Message IDSet))))
-> Field 8 (RequiredField (Always (Message IDSet)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 8 (RequiredField (Always (Message IDSet))))
 -> Field 8 (RequiredField (Always (Message IDSet))))
-> FieldType (Field 8 (RequiredField (Always (Message IDSet))))
-> Field 8 (RequiredField (Always (Message IDSet)))
forall a b. (a -> b) -> a -> b
$ Repeated 1 (Message IDV1) -> IDSet
PB.IDSet (Repeated 1 (Message IDV1) -> IDSet)
-> Repeated 1 (Message IDV1) -> IDSet
forall a b. (a -> b) -> a -> b
$ FieldType (Repeated 1 (Message IDV1)) -> Repeated 1 (Message IDV1)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 1 (Message IDV1))
 -> Repeated 1 (Message IDV1))
-> FieldType (Repeated 1 (Message IDV1))
-> Repeated 1 (Message IDV1)
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> ID' 'WithinSet 'InFact 'RegularString -> IDV1
setValueToPb ReverseSymbols
s (ID' 'WithinSet 'InFact 'RegularString -> IDV1)
-> [ID' 'WithinSet 'InFact 'RegularString] -> [IDV1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (ID' 'WithinSet 'InFact 'RegularString)
-> [ID' 'WithinSet 'InFact 'RegularString]
forall a. Set a -> [a]
Set.toList Set (ID' 'WithinSet 'InFact 'RegularString)
SetType 'NotWithinSet 'RegularString
vs

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

pbToSetValue :: Symbols -> PB.IDV1 -> Either String (ID' 'WithinSet 'InFact 'RegularString)
pbToSetValue :: Symbols
-> IDV1 -> Either String (ID' 'WithinSet 'InFact 'RegularString)
pbToSetValue Symbols
s = \case
  PB.IDSymbol   Required 1 (Value Int64)
f ->        Text -> ID' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> ID' inSet pof ctx
Symbol   (Text -> ID' 'WithinSet 'InFact 'RegularString)
-> Either String Text
-> Either String (ID' '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 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)))
Required 1 (Value Int64)
f)
  PB.IDInteger  Required 3 (Value Int64)
f -> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID' 'WithinSet 'InFact 'RegularString
 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ Int -> ID' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Int -> ID' inSet pof ctx
LInteger (Int -> ID' 'WithinSet 'InFact 'RegularString)
-> Int -> ID' '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 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.IDString   Required 4 (Value Text)
f -> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID' 'WithinSet 'InFact 'RegularString
 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ Text -> ID' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Text -> ID' inSet pof ctx
LString  (Text -> ID' 'WithinSet 'InFact 'RegularString)
-> Text -> ID' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Field 4 (RequiredField (Always (Value Text)))
-> FieldType (Field 4 (RequiredField (Always (Value Text))))
forall a. HasField a => a -> FieldType a
PB.getField Field 4 (RequiredField (Always (Value Text)))
Required 4 (Value Text)
f
  PB.IDDate     Required 5 (Value Int64)
f -> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID' 'WithinSet 'InFact 'RegularString
 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ UTCTime -> ID' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
UTCTime -> ID' inSet pof ctx
LDate    (UTCTime -> ID' 'WithinSet 'InFact 'RegularString)
-> UTCTime -> ID' '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 5 (RequiredField (Always (Value Int64)))
-> FieldType (Field 5 (RequiredField (Always (Value Int64))))
forall a. HasField a => a -> FieldType a
PB.getField Field 5 (RequiredField (Always (Value Int64)))
Required 5 (Value Int64)
f
  PB.IDBytes    Required 6 (Value ByteString)
f -> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID' 'WithinSet 'InFact 'RegularString
 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ID' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
ByteString -> ID' inSet pof ctx
LBytes   (ByteString -> ID' 'WithinSet 'InFact 'RegularString)
-> ByteString -> ID' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Field 6 (RequiredField (Always (Value ByteString)))
-> FieldType (Field 6 (RequiredField (Always (Value ByteString))))
forall a. HasField a => a -> FieldType a
PB.getField Field 6 (RequiredField (Always (Value ByteString)))
Required 6 (Value ByteString)
f
  PB.IDBool     Required 7 (Value Bool)
f -> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ID' 'WithinSet 'InFact 'RegularString
 -> Either String (ID' 'WithinSet 'InFact 'RegularString))
-> ID' 'WithinSet 'InFact 'RegularString
-> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. (a -> b) -> a -> b
$ Bool -> ID' 'WithinSet 'InFact 'RegularString
forall (inSet :: IsWithinSet) (pof :: PredicateOrFact)
       (ctx :: ParsedAs).
Bool -> ID' inSet pof ctx
LBool    (Bool -> ID' 'WithinSet 'InFact 'RegularString)
-> Bool -> ID' 'WithinSet 'InFact 'RegularString
forall a b. (a -> b) -> a -> b
$ Field 7 (RequiredField (Always (Value Bool)))
-> FieldType (Field 7 (RequiredField (Always (Value Bool))))
forall a. HasField a => a -> FieldType a
PB.getField Field 7 (RequiredField (Always (Value Bool)))
Required 7 (Value Bool)
f
  PB.IDVariable Required 2 (Value Int32)
_ -> String -> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. a -> Either a b
Left String
"Variables can't appear in facts or sets"
  PB.IDIDSet    Required 8 (Message IDSet)
_ -> String -> Either String (ID' 'WithinSet 'InFact 'RegularString)
forall a b. a -> Either a b
Left String
"Sets can't be nested"

setValueToPb :: ReverseSymbols -> ID' 'WithinSet 'InFact 'RegularString -> PB.IDV1
setValueToPb :: ReverseSymbols -> ID' 'WithinSet 'InFact 'RegularString -> IDV1
setValueToPb ReverseSymbols
s = \case
  Symbol   Text
n -> Required 1 (Value Int64) -> IDV1
PB.IDSymbol  (Required 1 (Value Int64) -> IDV1)
-> Required 1 (Value Int64) -> IDV1
forall a b. (a -> b) -> a -> b
$ 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
n
  LInteger Int
v -> Required 3 (Value Int64) -> IDV1
PB.IDInteger (Required 3 (Value Int64) -> IDV1)
-> Required 3 (Value Int64) -> IDV1
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
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v
  LString  Text
v -> Required 4 (Value Text) -> IDV1
PB.IDString  (Required 4 (Value Text) -> IDV1)
-> Required 4 (Value Text) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 4 (RequiredField (Always (Value Text))))
-> Field 4 (RequiredField (Always (Value Text)))
forall a. HasField a => FieldType a -> a
PB.putField Text
FieldType (Field 4 (RequiredField (Always (Value Text))))
v
  LDate    UTCTime
v -> Required 5 (Value Int64) -> IDV1
PB.IDDate    (Required 5 (Value Int64) -> IDV1)
-> Required 5 (Value Int64) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 5 (RequiredField (Always (Value Int64))))
-> Field 5 (RequiredField (Always (Value Int64)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 5 (RequiredField (Always (Value Int64))))
 -> Field 5 (RequiredField (Always (Value Int64))))
-> FieldType (Field 5 (RequiredField (Always (Value Int64))))
-> Field 5 (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 6 (Value ByteString) -> IDV1
PB.IDBytes   (Required 6 (Value ByteString) -> IDV1)
-> Required 6 (Value ByteString) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 6 (RequiredField (Always (Value ByteString))))
-> Field 6 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField ByteString
FieldType (Field 6 (RequiredField (Always (Value ByteString))))
v
  LBool    Bool
v -> Required 7 (Value Bool) -> IDV1
PB.IDBool    (Required 7 (Value Bool) -> IDV1)
-> Required 7 (Value Bool) -> IDV1
forall a b. (a -> b) -> a -> b
$ FieldType (Field 7 (RequiredField (Always (Value Bool))))
-> Field 7 (RequiredField (Always (Value Bool)))
forall a. HasField a => FieldType a -> a
PB.putField Bool
FieldType (Field 7 (RequiredField (Always (Value Bool))))
v

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

pbToExpression :: Symbols -> PB.ExpressionV1 -> Either String Expression
pbToExpression :: Symbols -> ExpressionV1 -> Either String Expression
pbToExpression Symbols
s PB.ExpressionV1{Repeated 1 (Message Op)
$sel:ops:ExpressionV1 :: ExpressionV1 -> 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.ExpressionV1
expressionToPb :: ReverseSymbols -> Expression -> ExpressionV1
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 ExpressionV1 :: Repeated 1 (Message Op) -> ExpressionV1
PB.ExpressionV1 { $sel:ops:ExpressionV1 :: 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 IDV1)
v -> ID -> Op
VOp (ID -> Op) -> Either String ID -> Either String Op
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbols -> IDV1 -> Either String ID
pbToTerm Symbols
s (Field 1 (RequiredField (Always (Message IDV1)))
-> FieldType (Field 1 (RequiredField (Always (Message IDV1))))
forall a. HasField a => a -> FieldType a
PB.getField Field 1 (RequiredField (Always (Message IDV1)))
Required 1 (Message IDV1)
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 ID
t -> Required 1 (Message IDV1) -> Op
PB.OpVValue  (Required 1 (Message IDV1) -> Op)
-> Required 1 (Message IDV1) -> Op
forall a b. (a -> b) -> a -> b
$ FieldType (Field 1 (RequiredField (Always (Message IDV1))))
-> Field 1 (RequiredField (Always (Message IDV1)))
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Field 1 (RequiredField (Always (Message IDV1))))
 -> Field 1 (RequiredField (Always (Message IDV1))))
-> FieldType (Field 1 (RequiredField (Always (Message IDV1))))
-> Field 1 (RequiredField (Always (Message IDV1)))
forall a b. (a -> b) -> a -> b
$ ReverseSymbols -> ID -> IDV1
termToPb ReverseSymbols
s ID
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