module Hasql.Codecs.RequestingOid.LookingUp where

import Control.Applicative
import Witherable
import Prelude

data LookingUp k v a
  = LookingUp
      -- | Keys requested to be available for lookup.
      [k]
      -- | Continuation that looks up values by keys.
      ((k -> v) -> a)

type role LookingUp _ _ representational

deriving stock instance Functor (LookingUp k v)

instance Applicative (LookingUp k v) where
  pure :: forall a. a -> LookingUp k v a
pure a
a =
    [k] -> ((k -> v) -> a) -> LookingUp k v a
forall k v a. [k] -> ((k -> v) -> a) -> LookingUp k v a
LookingUp [] (\k -> v
_ -> a
a)
  LookingUp [k]
lKeys (k -> v) -> a -> b
lUse <*> :: forall a b.
LookingUp k v (a -> b) -> LookingUp k v a -> LookingUp k v b
<*> LookingUp [k]
rKeys (k -> v) -> a
rUse =
    [k] -> ((k -> v) -> b) -> LookingUp k v b
forall k v a. [k] -> ((k -> v) -> a) -> LookingUp k v a
LookingUp
      ([k]
lKeys [k] -> [k] -> [k]
forall a. Semigroup a => a -> a -> a
<> [k]
rKeys)
      (\k -> v
lookup -> (k -> v) -> a -> b
lUse k -> v
lookup ((k -> v) -> a
rUse k -> v
lookup))

lookup :: k -> LookingUp k v v
lookup :: forall k v. k -> LookingUp k v v
lookup k
key =
  [k] -> ((k -> v) -> v) -> LookingUp k v v
forall k v a. [k] -> ((k -> v) -> a) -> LookingUp k v a
LookingUp [k
key] (\k -> v
lookupFn -> k -> v
lookupFn k
key)

lift :: a -> LookingUp k v a
lift :: forall a k v. a -> LookingUp k v a
lift a
fa =
  [k] -> ((k -> v) -> a) -> LookingUp k v a
forall k v a. [k] -> ((k -> v) -> a) -> LookingUp k v a
LookingUp [] (a -> (k -> v) -> a
forall a b. a -> b -> a
const a
fa)

lookingUp :: k -> (v -> a) -> LookingUp k v a
lookingUp :: forall k v a. k -> (v -> a) -> LookingUp k v a
lookingUp k
key v -> a
cont =
  [k] -> ((k -> v) -> a) -> LookingUp k v a
forall k v a. [k] -> ((k -> v) -> a) -> LookingUp k v a
LookingUp [k
key] (\k -> v
lookupFn -> v -> a
cont (k -> v
lookupFn k
key))

hoistLookingUp :: k -> (v -> a -> b) -> LookingUp k v a -> LookingUp k v b
hoistLookingUp :: forall k v a b.
k -> (v -> a -> b) -> LookingUp k v a -> LookingUp k v b
hoistLookingUp k
k v -> a -> b
tx (LookingUp [k]
keys (k -> v) -> a
use) =
  [k] -> ((k -> v) -> b) -> LookingUp k v b
forall k v a. [k] -> ((k -> v) -> a) -> LookingUp k v a
LookingUp (k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
keys) (\k -> v
lookupFn -> v -> a -> b
tx (k -> v
lookupFn k
k) ((k -> v) -> a
use k -> v
lookupFn))