{-# LANGUAGE StrictData #-}
module Sq.Input
( Input
, runInput
, encode
, input
, BoundInput
, bindInput
, ErrInput (..)
, rawBoundInput
) where
import Control.DeepSeq
import Control.Exception.Safe qualified as Ex
import Data.Bifunctor
import Data.Coerce
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Map.Strict qualified as Map
import Data.String
import Data.Text qualified as T
import Database.SQLite3 qualified as S
import Sq.Encoders
import Sq.Names
newtype Input i = Input (i -> Map.Map BindingName (Either ErrEncode S.SQLData))
deriving newtype
( NonEmpty (Input i) -> Input i
Input i -> Input i -> Input i
(Input i -> Input i -> Input i)
-> (NonEmpty (Input i) -> Input i)
-> (forall b. Integral b => b -> Input i -> Input i)
-> Semigroup (Input i)
forall b. Integral b => b -> Input i -> Input i
forall i. NonEmpty (Input i) -> Input i
forall i. Input i -> Input i -> Input i
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall i b. Integral b => b -> Input i -> Input i
$c<> :: forall i. Input i -> Input i -> Input i
<> :: Input i -> Input i -> Input i
$csconcat :: forall i. NonEmpty (Input i) -> Input i
sconcat :: NonEmpty (Input i) -> Input i
$cstimes :: forall i b. Integral b => b -> Input i -> Input i
stimes :: forall b. Integral b => b -> Input i -> Input i
Semigroup
, Semigroup (Input i)
Input i
Semigroup (Input i) =>
Input i
-> (Input i -> Input i -> Input i)
-> ([Input i] -> Input i)
-> Monoid (Input i)
[Input i] -> Input i
Input i -> Input i -> Input i
forall i. Semigroup (Input i)
forall i. Input i
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall i. [Input i] -> Input i
forall i. Input i -> Input i -> Input i
$cmempty :: forall i. Input i
mempty :: Input i
$cmappend :: forall i. Input i -> Input i -> Input i
mappend :: Input i -> Input i -> Input i
$cmconcat :: forall i. [Input i] -> Input i
mconcat :: [Input i] -> Input i
Monoid
, Input i -> ()
(Input i -> ()) -> NFData (Input i)
forall i. Input i -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall i. Input i -> ()
rnf :: Input i -> ()
NFData
)
deriving
( (forall a' a. (a' -> a) -> Input a -> Input a')
-> (forall b a. b -> Input b -> Input a) -> Contravariant Input
forall b a. b -> Input b -> Input a
forall a' a. (a' -> a) -> Input a -> Input a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall a' a. (a' -> a) -> Input a -> Input a'
contramap :: forall a' a. (a' -> a) -> Input a -> Input a'
$c>$ :: forall b a. b -> Input b -> Input a
>$ :: forall b a. b -> Input b -> Input a
Contravariant
, Contravariant Input
Contravariant Input =>
(forall a b c. (a -> (b, c)) -> Input b -> Input c -> Input a)
-> (forall i. Input i) -> Divisible Input
forall i. Input i
forall a b c. (a -> (b, c)) -> Input b -> Input c -> Input a
forall (f :: * -> *).
Contravariant f =>
(forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a) -> Divisible f
$cdivide :: forall a b c. (a -> (b, c)) -> Input b -> Input c -> Input a
divide :: forall a b c. (a -> (b, c)) -> Input b -> Input c -> Input a
$cconquer :: forall i. Input i
conquer :: forall i. Input i
Divisible
, Divisible Input
Divisible Input =>
(forall a. (a -> Void) -> Input a)
-> (forall a b c.
(a -> Either b c) -> Input b -> Input c -> Input a)
-> Decidable Input
forall a. (a -> Void) -> Input a
forall a b c. (a -> Either b c) -> Input b -> Input c -> Input a
forall (f :: * -> *).
Divisible f =>
(forall a. (a -> Void) -> f a)
-> (forall a b c. (a -> Either b c) -> f b -> f c -> f a)
-> Decidable f
$close :: forall a. (a -> Void) -> Input a
lose :: forall a. (a -> Void) -> Input a
$cchoose :: forall a b c. (a -> Either b c) -> Input b -> Input c -> Input a
choose :: forall a b c. (a -> Either b c) -> Input b -> Input c -> Input a
Decidable
)
via Op (Map.Map BindingName (Either ErrEncode S.SQLData))
runInput :: Input i -> i -> Map.Map BindingName (Either ErrEncode S.SQLData)
runInput :: forall i.
Input i -> i -> Map BindingName (Either ErrEncode SQLData)
runInput = Input i -> i -> Map BindingName (Either ErrEncode SQLData)
forall a b. Coercible a b => a -> b
coerce
{-# INLINE runInput #-}
encode :: Name -> Encode i -> Input i
encode :: forall i. Name -> Encode i -> Input i
encode Name
n (Encode i -> Either ErrEncode SQLData
f) = (i -> Map BindingName (Either ErrEncode SQLData)) -> Input i
forall i.
(i -> Map BindingName (Either ErrEncode SQLData)) -> Input i
Input (BindingName
-> Either ErrEncode SQLData
-> Map BindingName (Either ErrEncode SQLData)
forall k a. k -> a -> Map k a
Map.singleton (Name -> BindingName
bindingName Name
n) (Either ErrEncode SQLData
-> Map BindingName (Either ErrEncode SQLData))
-> (i -> Either ErrEncode SQLData)
-> i
-> Map BindingName (Either ErrEncode SQLData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either ErrEncode SQLData
f)
{-# INLINE encode #-}
input :: Name -> Input i -> Input i
input :: forall i. Name -> Input i -> Input i
input Name
n Input i
ba = (i -> Map BindingName (Either ErrEncode SQLData)) -> Input i
forall i.
(i -> Map BindingName (Either ErrEncode SQLData)) -> Input i
Input \i
s ->
(BindingName -> BindingName)
-> Map BindingName (Either ErrEncode SQLData)
-> Map BindingName (Either ErrEncode SQLData)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic (Name -> BindingName
bindingName Name
n <>) (Input i -> i -> Map BindingName (Either ErrEncode SQLData)
forall i.
Input i -> i -> Map BindingName (Either ErrEncode SQLData)
runInput Input i
ba i
s)
{-# INLINE input #-}
instance (EncodeDefault i) => IsString (Input i) where
fromString :: String -> Input i
fromString String
s = Name -> Encode i -> Input i
forall i. Name -> Encode i -> Input i
encode (String -> Name
forall a. IsString a => String -> a
fromString String
s) Encode i
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
{-# INLINE fromString #-}
newtype BoundInput = BoundInput (Map.Map T.Text S.SQLData)
deriving newtype (BoundInput -> BoundInput -> Bool
(BoundInput -> BoundInput -> Bool)
-> (BoundInput -> BoundInput -> Bool) -> Eq BoundInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundInput -> BoundInput -> Bool
== :: BoundInput -> BoundInput -> Bool
$c/= :: BoundInput -> BoundInput -> Bool
/= :: BoundInput -> BoundInput -> Bool
Eq, Int -> BoundInput -> ShowS
[BoundInput] -> ShowS
BoundInput -> String
(Int -> BoundInput -> ShowS)
-> (BoundInput -> String)
-> ([BoundInput] -> ShowS)
-> Show BoundInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundInput -> ShowS
showsPrec :: Int -> BoundInput -> ShowS
$cshow :: BoundInput -> String
show :: BoundInput -> String
$cshowList :: [BoundInput] -> ShowS
showList :: [BoundInput] -> ShowS
Show)
bindInput :: Input i -> i -> Either ErrInput BoundInput
bindInput :: forall i. Input i -> i -> Either ErrInput BoundInput
bindInput Input i
ii i
i = do
!Map Text SQLData
m <-
(BindingName -> Text)
-> Map BindingName SQLData -> Map Text SQLData
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic BindingName -> Text
renderInputBindingName
(Map BindingName SQLData -> Map Text SQLData)
-> Either ErrInput (Map BindingName SQLData)
-> Either ErrInput (Map Text SQLData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BindingName
-> Either ErrEncode SQLData -> Either ErrInput SQLData)
-> Map BindingName (Either ErrEncode SQLData)
-> Either ErrInput (Map BindingName SQLData)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey ((ErrEncode -> ErrInput)
-> Either ErrEncode SQLData -> Either ErrInput SQLData
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ErrEncode -> ErrInput)
-> Either ErrEncode SQLData -> Either ErrInput SQLData)
-> (BindingName -> ErrEncode -> ErrInput)
-> BindingName
-> Either ErrEncode SQLData
-> Either ErrInput SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindingName -> ErrEncode -> ErrInput
ErrInput) (Input i -> i -> Map BindingName (Either ErrEncode SQLData)
forall i.
Input i -> i -> Map BindingName (Either ErrEncode SQLData)
runInput Input i
ii i
i)
BoundInput -> Either ErrInput BoundInput
forall a. a -> Either ErrInput a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoundInput -> Either ErrInput BoundInput)
-> BoundInput -> Either ErrInput BoundInput
forall a b. (a -> b) -> a -> b
$ Map Text SQLData -> BoundInput
BoundInput Map Text SQLData
m
data ErrInput = ErrInput BindingName ErrEncode
deriving stock (Int -> ErrInput -> ShowS
[ErrInput] -> ShowS
ErrInput -> String
(Int -> ErrInput -> ShowS)
-> (ErrInput -> String) -> ([ErrInput] -> ShowS) -> Show ErrInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrInput -> ShowS
showsPrec :: Int -> ErrInput -> ShowS
$cshow :: ErrInput -> String
show :: ErrInput -> String
$cshowList :: [ErrInput] -> ShowS
showList :: [ErrInput] -> ShowS
Show)
deriving anyclass (Show ErrInput
Typeable ErrInput
(Typeable ErrInput, Show ErrInput) =>
(ErrInput -> SomeException)
-> (SomeException -> Maybe ErrInput)
-> (ErrInput -> String)
-> Exception ErrInput
SomeException -> Maybe ErrInput
ErrInput -> String
ErrInput -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ErrInput -> SomeException
toException :: ErrInput -> SomeException
$cfromException :: SomeException -> Maybe ErrInput
fromException :: SomeException -> Maybe ErrInput
$cdisplayException :: ErrInput -> String
displayException :: ErrInput -> String
Ex.Exception)
rawBoundInput :: BoundInput -> Map.Map T.Text S.SQLData
rawBoundInput :: BoundInput -> Map Text SQLData
rawBoundInput = BoundInput -> Map Text SQLData
forall a b. Coercible a b => a -> b
coerce
{-# INLINE rawBoundInput #-}