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

--------------------------------------------------------------------------------

-- | How to encode all the input to a single 'Sq.Statement'.
--
-- * Construct with 'encode', 'IsString'.
--
-- * Nest with 'input'.
--
-- * Compose with 'Contravariant', 'Divisible', 'Decidable' and 'Monoid' tools.
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
        -- ^ Left-biased in case of overlapping 'BindingName's.
      , 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
        -- ^ Left-biased in case of overlapping 'BindingName's.
      , 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 a single input parameter. The value will be reachable from the 'SQL'
-- query through the specified 'Name', with a @$@ prefix.
--
-- @
-- 'Sq.writeStatement'
--         ('encode' \"foo\" 'encodeDefault')
--         'mempty'
--         \"INSERT INTO t (a) VALUES ($foo)\"
--    :: ('EncodeDefault' x)
--    => 'Sq.Statement' 'Sq.Write' x ()
-- @
--
-- Note that by design, this library doesn't support positional 'Input'
-- parameters. You must always pick a 'Name'.
--
-- Multiple 'Input's can be composed with 'Contravariant', 'Divisible', 'Decidable'
-- and 'Monoid' tools.
--
-- @
-- 'Sq.writeStatement'
--         ('divided' ('encode' \"foo\" 'encodeDefault')
--                  ('encode' \"bar\" 'encodeDefault'))
--         'mempty'
--         \"INSERT INTO t (a, b) VALUES ($foo, $bar)\"
--    :: ('EncodeDefault' x, 'EncodeDefault' y)
--    => 'Sq.Statement' 'Sq.Write' (x, y) ()
-- @
--
-- Pro-tip: Consider using the 'IsString' instance for 'Input'.
-- For example, @\"foo\"@ means @'encode' \"foo\" 'encodeDefault'@.
-- That is, the last example could be written as follows:
--
-- @
-- 'Sq.writeStatement'
--         ('divided' \"foo\" \"bar\")
--         'mempty'
--         \"INSERT INTO t (a, b) VALUES ($foo, $bar)\"
--    :: ('EncodeDefault' x, 'EncodeDefault' y)
--    => 'Sq.Statement' 'Sq.Write' (x, y) ()
-- @
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 #-}

-- | Add a prefix 'Name' to parameters names in the given 'Input',
-- separated by @\__@
--
-- This is useful for making reusable 'Input's. For example,
-- consider the following.
--
-- @
-- data Point = Point { x :: 'Int', y :: 'Int' }
--
-- pointInput :: 'Input' Point
-- pointInput = 'contramap' (\\case Point x _ -> x) \"x\" <>
--              'contramap' (\\case Point _ y -> y) \"y\"
-- @
--
-- After 'input':
--
-- @
-- 'Sq.writeStatement'
--         ('divided' ('input' \"p1\" pointInput)
--                  ('input' \"p2\" pointInput))
--         'mempty'
--         ['Sq.sql'|
--           INSERT INTO vectors (ax, ay, bx, by)
--           VALUES ($p1\__x, $p1\__y, $p2\__x, $p2\__y) |]
--    :: 'Sq.Statement' 'Sq.Write' (Point, Point) ()
-- @
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 #-}

-- |
-- @
-- 'Sq.writeStatement'
--         \"a\"
--         'mempty'
--         \"INSERT INTO t (x) VALUES ($a)\"
--    :: ('EncodeDefault' a)
--    => 'Sq.Statement' 'Sq.Write' a ()
-- @
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

-- | See v'Encode'.
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 #-}