{-# LANGUAGE LambdaCase, TypeFamilies, TemplateHaskell #-}
------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Nullable
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
------------------------------------------------------------------------
module Data.Extensible.Nullable (
  vacancy
  , coinclusion
  , wrench
  , retrench
  , Nullable(..)
  , mapNullable
  , fromNullable
  , coinclusionAssoc
  , wrenchAssoc
  , retrenchAssoc) where

import Control.DeepSeq (NFData)
import Data.Extensible.Class
import Data.Extensible.Product
import Data.Extensible.Sum
import Data.Extensible.Inclusion
import Data.Extensible.Internal.Rig
import Data.Hashable
import Data.Typeable (Typeable)
import Data.Extensible.Wrapper
import qualified Data.Extensible.Struct as S
import Data.Profunctor.Unsafe
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import Language.Haskell.TH.Lift
import Test.QuickCheck.Arbitrary

-- | Wrapped Maybe
newtype Nullable h x = Nullable { forall {k} (h :: k -> Type) (x :: k). Nullable h x -> Maybe (h x)
getNullable :: Maybe (h x) }
  deriving (Int -> Nullable h x -> ShowS
[Nullable h x] -> ShowS
Nullable h x -> String
(Int -> Nullable h x -> ShowS)
-> (Nullable h x -> String)
-> ([Nullable h x] -> ShowS)
-> Show (Nullable h x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (h :: k -> Type) (x :: k).
Show (h x) =>
Int -> Nullable h x -> ShowS
forall k (h :: k -> Type) (x :: k).
Show (h x) =>
[Nullable h x] -> ShowS
forall k (h :: k -> Type) (x :: k).
Show (h x) =>
Nullable h x -> String
$cshowsPrec :: forall k (h :: k -> Type) (x :: k).
Show (h x) =>
Int -> Nullable h x -> ShowS
showsPrec :: Int -> Nullable h x -> ShowS
$cshow :: forall k (h :: k -> Type) (x :: k).
Show (h x) =>
Nullable h x -> String
show :: Nullable h x -> String
$cshowList :: forall k (h :: k -> Type) (x :: k).
Show (h x) =>
[Nullable h x] -> ShowS
showList :: [Nullable h x] -> ShowS
Show, Nullable h x -> Nullable h x -> Bool
(Nullable h x -> Nullable h x -> Bool)
-> (Nullable h x -> Nullable h x -> Bool) -> Eq (Nullable h x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (h :: k -> Type) (x :: k).
Eq (h x) =>
Nullable h x -> Nullable h x -> Bool
$c== :: forall k (h :: k -> Type) (x :: k).
Eq (h x) =>
Nullable h x -> Nullable h x -> Bool
== :: Nullable h x -> Nullable h x -> Bool
$c/= :: forall k (h :: k -> Type) (x :: k).
Eq (h x) =>
Nullable h x -> Nullable h x -> Bool
/= :: Nullable h x -> Nullable h x -> Bool
Eq, Eq (Nullable h x)
Eq (Nullable h x) =>
(Nullable h x -> Nullable h x -> Ordering)
-> (Nullable h x -> Nullable h x -> Bool)
-> (Nullable h x -> Nullable h x -> Bool)
-> (Nullable h x -> Nullable h x -> Bool)
-> (Nullable h x -> Nullable h x -> Bool)
-> (Nullable h x -> Nullable h x -> Nullable h x)
-> (Nullable h x -> Nullable h x -> Nullable h x)
-> Ord (Nullable h x)
Nullable h x -> Nullable h x -> Bool
Nullable h x -> Nullable h x -> Ordering
Nullable h x -> Nullable h x -> Nullable h x
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (h :: k -> Type) (x :: k). Ord (h x) => Eq (Nullable h x)
forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Bool
forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Ordering
forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Nullable h x
$ccompare :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Ordering
compare :: Nullable h x -> Nullable h x -> Ordering
$c< :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Bool
< :: Nullable h x -> Nullable h x -> Bool
$c<= :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Bool
<= :: Nullable h x -> Nullable h x -> Bool
$c> :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Bool
> :: Nullable h x -> Nullable h x -> Bool
$c>= :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Bool
>= :: Nullable h x -> Nullable h x -> Bool
$cmax :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Nullable h x
max :: Nullable h x -> Nullable h x -> Nullable h x
$cmin :: forall k (h :: k -> Type) (x :: k).
Ord (h x) =>
Nullable h x -> Nullable h x -> Nullable h x
min :: Nullable h x -> Nullable h x -> Nullable h x
Ord, Typeable, (forall x. Nullable h x -> Rep (Nullable h x) x)
-> (forall x. Rep (Nullable h x) x -> Nullable h x)
-> Generic (Nullable h x)
forall x. Rep (Nullable h x) x -> Nullable h x
forall x. Nullable h x -> Rep (Nullable h x) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (h :: k -> Type) (x :: k) x.
Rep (Nullable h x) x -> Nullable h x
forall k (h :: k -> Type) (x :: k) x.
Nullable h x -> Rep (Nullable h x) x
$cfrom :: forall k (h :: k -> Type) (x :: k) x.
Nullable h x -> Rep (Nullable h x) x
from :: forall x. Nullable h x -> Rep (Nullable h x) x
$cto :: forall k (h :: k -> Type) (x :: k) x.
Rep (Nullable h x) x -> Nullable h x
to :: forall x. Rep (Nullable h x) x -> Nullable h x
Generic, Nullable h x -> ()
(Nullable h x -> ()) -> NFData (Nullable h x)
forall a. (a -> ()) -> NFData a
forall k (h :: k -> Type) (x :: k).
NFData (h x) =>
Nullable h x -> ()
$crnf :: forall k (h :: k -> Type) (x :: k).
NFData (h x) =>
Nullable h x -> ()
rnf :: Nullable h x -> ()
NFData, Gen (Nullable h x)
Gen (Nullable h x)
-> (Nullable h x -> [Nullable h x]) -> Arbitrary (Nullable h x)
Nullable h x -> [Nullable h x]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall k (h :: k -> Type) (x :: k).
Arbitrary (h x) =>
Gen (Nullable h x)
forall k (h :: k -> Type) (x :: k).
Arbitrary (h x) =>
Nullable h x -> [Nullable h x]
$carbitrary :: forall k (h :: k -> Type) (x :: k).
Arbitrary (h x) =>
Gen (Nullable h x)
arbitrary :: Gen (Nullable h x)
$cshrink :: forall k (h :: k -> Type) (x :: k).
Arbitrary (h x) =>
Nullable h x -> [Nullable h x]
shrink :: Nullable h x -> [Nullable h x]
Arbitrary, Eq (Nullable h x)
Eq (Nullable h x) =>
(Int -> Nullable h x -> Int)
-> (Nullable h x -> Int) -> Hashable (Nullable h x)
Int -> Nullable h x -> Int
Nullable h x -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall k (h :: k -> Type) (x :: k).
Hashable (h x) =>
Eq (Nullable h x)
forall k (h :: k -> Type) (x :: k).
Hashable (h x) =>
Int -> Nullable h x -> Int
forall k (h :: k -> Type) (x :: k).
Hashable (h x) =>
Nullable h x -> Int
$chashWithSalt :: forall k (h :: k -> Type) (x :: k).
Hashable (h x) =>
Int -> Nullable h x -> Int
hashWithSalt :: Int -> Nullable h x -> Int
$chash :: forall k (h :: k -> Type) (x :: k).
Hashable (h x) =>
Nullable h x -> Int
hash :: Nullable h x -> Int
Hashable, (forall (m :: Type -> Type). Quote m => Nullable h x -> m Exp)
-> (forall (m :: Type -> Type).
    Quote m =>
    Nullable h x -> Code m (Nullable h x))
-> Lift (Nullable h x)
forall k (h :: k -> Type) (x :: k) (m :: Type -> Type).
(Lift (h x), Quote m) =>
Nullable h x -> m Exp
forall k (h :: k -> Type) (x :: k) (m :: Type -> Type).
(Lift (h x), Quote m) =>
Nullable h x -> Code m (Nullable h x)
forall t.
(forall (m :: Type -> Type). Quote m => t -> m Exp)
-> (forall (m :: Type -> Type). Quote m => t -> Code m t) -> Lift t
forall (m :: Type -> Type). Quote m => Nullable h x -> m Exp
forall (m :: Type -> Type).
Quote m =>
Nullable h x -> Code m (Nullable h x)
$clift :: forall k (h :: k -> Type) (x :: k) (m :: Type -> Type).
(Lift (h x), Quote m) =>
Nullable h x -> m Exp
lift :: forall (m :: Type -> Type). Quote m => Nullable h x -> m Exp
$cliftTyped :: forall k (h :: k -> Type) (x :: k) (m :: Type -> Type).
(Lift (h x), Quote m) =>
Nullable h x -> Code m (Nullable h x)
liftTyped :: forall (m :: Type -> Type).
Quote m =>
Nullable h x -> Code m (Nullable h x)
Lift)

instance Wrapper h => Wrapper (Nullable h) where
  type Repr (Nullable h) x = Maybe (Repr h x)
  _Wrapper :: forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: k).
(Functor f, Profunctor p) =>
Optic' p f (Nullable h v) (Repr (Nullable h) v)
_Wrapper = Optic
  (Exchange (Repr h v) (Repr h v))
  Identity
  (h v)
  (h v)
  (Repr h v)
  (Repr h v)
-> ((h v -> Repr h v)
    -> (Repr h v -> h v)
    -> Optic' p f (Nullable h v) (Repr (Nullable h) v))
-> Optic' p f (Nullable h v) (Repr (Nullable h) v)
forall a b s t r.
Optic (Exchange a b) Identity s t a b
-> ((s -> a) -> (b -> t) -> r) -> r
withIso Optic
  (Exchange (Repr h v) (Repr h v))
  Identity
  (h v)
  (h v)
  (Repr h v)
  (Repr h v)
forall k (h :: k -> Type) (f :: Type -> Type)
       (p :: Type -> Type -> Type) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
forall (f :: Type -> Type) (p :: Type -> Type -> Type) (v :: k).
(Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper (((h v -> Repr h v)
  -> (Repr h v -> h v)
  -> Optic' p f (Nullable h v) (Repr (Nullable h) v))
 -> Optic' p f (Nullable h v) (Repr (Nullable h) v))
-> ((h v -> Repr h v)
    -> (Repr h v -> h v)
    -> Optic' p f (Nullable h v) (Repr (Nullable h) v))
-> Optic' p f (Nullable h v) (Repr (Nullable h) v)
forall a b. (a -> b) -> a -> b
$ \h v -> Repr h v
f Repr h v -> h v
g -> (Nullable h v -> Maybe (Repr h v))
-> (f (Maybe (Repr h v)) -> f (Nullable h v))
-> p (Maybe (Repr h v)) (f (Maybe (Repr h v)))
-> p (Nullable h v) (f (Nullable h v))
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: Type -> Type -> Type) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((h v -> Repr h v) -> Maybe (h v) -> Maybe (Repr h v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap h v -> Repr h v
f (Maybe (h v) -> Maybe (Repr h v))
-> (Nullable h v -> Maybe (h v))
-> Nullable h v
-> Maybe (Repr h v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullable h v -> Maybe (h v)
forall {k} (h :: k -> Type) (x :: k). Nullable h x -> Maybe (h x)
getNullable) ((Maybe (Repr h v) -> Nullable h v)
-> f (Maybe (Repr h v)) -> f (Nullable h v)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (h v) -> Nullable h v
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable (Maybe (h v) -> Nullable h v)
-> (Maybe (Repr h v) -> Maybe (h v))
-> Maybe (Repr h v)
-> Nullable h v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repr h v -> h v) -> Maybe (Repr h v) -> Maybe (h v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr h v -> h v
g))

instance Semigroup (h x) => Semigroup (Nullable h x) where
  Nullable (Just h x
a) <> :: Nullable h x -> Nullable h x -> Nullable h x
<> Nullable (Just h x
b) = Maybe (h x) -> Nullable h x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable (h x -> Maybe (h x)
forall a. a -> Maybe a
Just (h x
a h x -> h x -> h x
forall a. Semigroup a => a -> a -> a
<> h x
b))
  a :: Nullable h x
a@(Nullable (Just h x
_)) <> Nullable h x
_ = Nullable h x
a
  Nullable h x
_ <> Nullable h x
b = Nullable h x
b

instance Semigroup (h x) => Monoid (Nullable h x) where
  mempty :: Nullable h x
mempty = Maybe (h x) -> Nullable h x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable Maybe (h x)
forall a. Maybe a
Nothing
  mappend :: Nullable h x -> Nullable h x -> Nullable h x
mappend = Nullable h x -> Nullable h x -> Nullable h x
forall a. Semigroup a => a -> a -> a
(<>)

-- | Apply a function to its content.
mapNullable :: (g x -> h y) -> Nullable g x -> Nullable h y
mapNullable :: forall {k} {k} (g :: k -> Type) (x :: k) (h :: k -> Type) (y :: k).
(g x -> h y) -> Nullable g x -> Nullable h y
mapNullable g x -> h y
f = Maybe (h y) -> Nullable h y
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable (Maybe (h y) -> Nullable h y)
-> (Maybe (g x) -> Maybe (h y)) -> Maybe (g x) -> Nullable h y
forall a b c (q :: Type -> Type -> Type).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: Type -> Type -> Type) a b c
       (q :: Type -> Type -> Type).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (g x -> h y) -> Maybe (g x) -> Maybe (h y)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap g x -> h y
f (Maybe (g x) -> Nullable h y)
-> (Nullable g x -> Maybe (g x)) -> Nullable g x -> Nullable h y
forall a b c (q :: Type -> Type -> Type).
Coercible b a =>
(b -> c) -> q a b -> a -> c
forall (p :: Type -> Type -> Type) a b c
       (q :: Type -> Type -> Type).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Nullable g x -> Maybe (g x)
forall {k} (h :: k -> Type) (x :: k). Nullable h x -> Maybe (h x)
getNullable
{-# INLINE mapNullable #-}

-- | The inverse of 'inclusion'.
coinclusion :: (Include ys xs, Generate ys) => ys :& Nullable (Membership xs)
coinclusion :: forall {k} (ys :: [k]) (xs :: [k]).
(Include ys xs, Generate ys) =>
ys :& Nullable (Membership xs)
coinclusion = (forall s. ST s (Struct s (Nullable (Membership xs)) ys))
-> ys :& Nullable (Membership xs)
forall {k} (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
S.hfrozen ((forall s. ST s (Struct s (Nullable (Membership xs)) ys))
 -> ys :& Nullable (Membership xs))
-> (forall s. ST s (Struct s (Nullable (Membership xs)) ys))
-> ys :& Nullable (Membership xs)
forall a b. (a -> b) -> a -> b
$ do
  Struct s (Nullable (Membership xs)) ys
s <- (forall (x :: k). Nullable (Membership xs) x)
-> ST s (Struct (PrimState (ST s)) (Nullable (Membership xs)) ys)
forall {k} (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
S.newRepeat ((forall (x :: k). Nullable (Membership xs) x)
 -> ST s (Struct (PrimState (ST s)) (Nullable (Membership xs)) ys))
-> (forall (x :: k). Nullable (Membership xs) x)
-> ST s (Struct (PrimState (ST s)) (Nullable (Membership xs)) ys)
forall a b. (a -> b) -> a -> b
$ Maybe (Membership xs x) -> Nullable (Membership xs) x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable Maybe (Membership xs x)
forall a. Maybe a
Nothing
  (forall (x :: k).
 Membership xs x
 -> Membership ys x
 -> ST s (Struct s (Nullable (Membership xs)) ys)
 -> ST s (Struct s (Nullable (Membership xs)) ys))
-> ST s (Struct s (Nullable (Membership xs)) ys)
-> (xs :& Membership ys)
-> ST s (Struct s (Nullable (Membership xs)) ys)
forall {k} (xs :: [k]) (h :: k -> Type) r.
(forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex
    (\Membership xs x
i Membership ys x
m ST s (Struct s (Nullable (Membership xs)) ys)
cont -> Struct (PrimState (ST s)) (Nullable (Membership xs)) ys
-> Membership ys x -> Nullable (Membership xs) x -> ST s ()
forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k])
       (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
S.set Struct s (Nullable (Membership xs)) ys
Struct (PrimState (ST s)) (Nullable (Membership xs)) ys
s Membership ys x
m (Maybe (Membership xs x) -> Nullable (Membership xs) x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable (Maybe (Membership xs x) -> Nullable (Membership xs) x)
-> Maybe (Membership xs x) -> Nullable (Membership xs) x
forall a b. (a -> b) -> a -> b
$ Membership xs x -> Maybe (Membership xs x)
forall a. a -> Maybe a
Just Membership xs x
i) ST s ()
-> ST s (Struct s (Nullable (Membership xs)) ys)
-> ST s (Struct s (Nullable (Membership xs)) ys)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ST s (Struct s (Nullable (Membership xs)) ys)
cont) (Struct s (Nullable (Membership xs)) ys
-> ST s (Struct s (Nullable (Membership xs)) ys)
forall a. a -> ST s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Struct s (Nullable (Membership xs)) ys
s) xs :& Membership ys
forall {k} (xs :: [k]) (ys :: [k]).
Include ys xs =>
xs :& Membership ys
inclusion

-- | A product filled with @'Nullable' 'Nothing'@
vacancy :: Generate xs => xs :& Nullable h
vacancy :: forall {k} (xs :: [k]) (h :: k -> Type).
Generate xs =>
xs :& Nullable h
vacancy = (forall (x :: k). Nullable h x) -> xs :& Nullable h
forall {k} (xs :: [k]) (h :: k -> Type).
Generate xs =>
(forall (x :: k). h x) -> xs :& h
hrepeat ((forall (x :: k). Nullable h x) -> xs :& Nullable h)
-> (forall (x :: k). Nullable h x) -> xs :& Nullable h
forall a b. (a -> b) -> a -> b
$ Maybe (h x) -> Nullable h x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable Maybe (h x)
forall a. Maybe a
Nothing

-- | Extend a product and fill missing fields by 'Null'.
wrench :: (Generate ys, xs ⊆ ys) => xs :& h -> ys :& Nullable h
wrench :: forall {k} (ys :: [k]) (xs :: [k]) (h :: k -> Type).
(Generate ys, xs ⊆ ys) =>
(xs :& h) -> ys :& Nullable h
wrench xs :& h
xs = (Membership xs x -> h x)
-> Nullable (Membership xs) x -> Nullable h x
forall {k} {k} (g :: k -> Type) (x :: k) (h :: k -> Type) (y :: k).
(g x -> h y) -> Nullable g x -> Nullable h y
mapNullable ((Membership xs x -> (xs :& h) -> h x)
-> (xs :& h) -> Membership xs x -> h x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Membership xs x -> (xs :& h) -> h x
forall {k} (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup xs :& h
xs) (forall {x :: k}. Nullable (Membership xs) x -> Nullable h x)
-> (ys :& Nullable (Membership xs)) -> ys :& Nullable h
forall {k} (g :: k -> Type) (h :: k -> Type) (xs :: [k]).
(forall (x :: k). g x -> h x) -> (xs :& g) -> xs :& h
`hmap` ys :& Nullable (Membership xs)
forall {k} (ys :: [k]) (xs :: [k]).
(Include ys xs, Generate ys) =>
ys :& Nullable (Membership xs)
coinclusion
{-# INLINE wrench #-}

-- | Narrow the range of the sum, if possible.
retrench :: (Generate ys, xs ⊆ ys) => ys :/ h -> Nullable ((:/) xs) h
retrench :: forall {k} (ys :: [k]) (xs :: [k]) (h :: k -> Type).
(Generate ys, xs ⊆ ys) =>
(ys :/ h) -> Nullable ((:/) xs) h
retrench (EmbedAt Membership ys x
i h x
h) = Optic'
  (->)
  (Const (Nullable ((:/) xs) h))
  (ys :& Nullable (Membership xs))
  (Nullable (Membership xs) x)
-> (Nullable (Membership xs) x -> Nullable ((:/) xs) h)
-> (ys :& Nullable (Membership xs))
-> Nullable ((:/) xs) h
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership ys x
-> Optic'
     (->)
     (Const (Nullable ((:/) xs) h))
     (ys :& Nullable (Membership xs))
     (Nullable (Membership xs) x)
forall (xs :: [k]) (h :: k -> Type) (x :: k).
ExtensibleConstr (:&) xs h x =>
Membership xs x
-> Optic' (->) (Const (Nullable ((:/) xs) h)) (xs :& h) (h x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership ys x
i) ((Membership xs x -> xs :/ h)
-> Nullable (Membership xs) x -> Nullable ((:/) xs) h
forall {k} {k} (g :: k -> Type) (x :: k) (h :: k -> Type) (y :: k).
(g x -> h y) -> Nullable g x -> Nullable h y
mapNullable (Membership xs x -> h x -> xs :/ h
forall {k} (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> h x -> xs :/ h
`EmbedAt`h x
h)) ys :& Nullable (Membership xs)
forall {k} (ys :: [k]) (xs :: [k]).
(Include ys xs, Generate ys) =>
ys :& Nullable (Membership xs)
coinclusion
{-# INLINE retrench #-}

-- | 'fromMaybe' for 'Nullable'.
fromNullable :: h x -> Nullable h x -> h x
fromNullable :: forall {k} (h :: k -> Type) (x :: k). h x -> Nullable h x -> h x
fromNullable h x
def = h x -> Maybe (h x) -> h x
forall a. a -> Maybe a -> a
fromMaybe h x
def (Maybe (h x) -> h x)
-> (Nullable h x -> Maybe (h x)) -> Nullable h x -> h x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nullable h x -> Maybe (h x)
forall {k} (h :: k -> Type) (x :: k). Nullable h x -> Maybe (h x)
getNullable
{-# INLINE fromNullable #-}

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

-- | The inverse of 'inclusionAssoc'.
coinclusionAssoc :: (IncludeAssoc ys xs, Generate ys) => ys :& Nullable (Membership xs)
coinclusionAssoc :: forall {k} {v} (ys :: [Assoc k v]) (xs :: [Assoc k v]).
(IncludeAssoc ys xs, Generate ys) =>
ys :& Nullable (Membership xs)
coinclusionAssoc = (forall s. ST s (Struct s (Nullable (Membership xs)) ys))
-> ys :& Nullable (Membership xs)
forall {k} (h :: k -> Type) (xs :: [k]).
(forall s. ST s (Struct s h xs)) -> xs :& h
S.hfrozen ((forall s. ST s (Struct s (Nullable (Membership xs)) ys))
 -> ys :& Nullable (Membership xs))
-> (forall s. ST s (Struct s (Nullable (Membership xs)) ys))
-> ys :& Nullable (Membership xs)
forall a b. (a -> b) -> a -> b
$ do
  Struct s (Nullable (Membership xs)) ys
s <- (forall (x :: Assoc k v). Nullable (Membership xs) x)
-> ST s (Struct (PrimState (ST s)) (Nullable (Membership xs)) ys)
forall {k} (h :: k -> Type) (m :: Type -> Type) (xs :: [k]).
(PrimMonad m, Generate xs) =>
(forall (x :: k). h x) -> m (Struct (PrimState m) h xs)
S.newRepeat ((forall (x :: Assoc k v). Nullable (Membership xs) x)
 -> ST s (Struct (PrimState (ST s)) (Nullable (Membership xs)) ys))
-> (forall (x :: Assoc k v). Nullable (Membership xs) x)
-> ST s (Struct (PrimState (ST s)) (Nullable (Membership xs)) ys)
forall a b. (a -> b) -> a -> b
$ Maybe (Membership xs x) -> Nullable (Membership xs) x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable Maybe (Membership xs x)
forall a. Maybe a
Nothing
  (forall (x :: Assoc k v).
 Membership xs x
 -> Membership ys x
 -> ST s (Struct s (Nullable (Membership xs)) ys)
 -> ST s (Struct s (Nullable (Membership xs)) ys))
-> ST s (Struct s (Nullable (Membership xs)) ys)
-> (xs :& Membership ys)
-> ST s (Struct s (Nullable (Membership xs)) ys)
forall {k} (xs :: [k]) (h :: k -> Type) r.
(forall (x :: k). Membership xs x -> h x -> r -> r)
-> r -> (xs :& h) -> r
hfoldrWithIndex
    (\Membership xs x
i Membership ys x
m ST s (Struct s (Nullable (Membership xs)) ys)
cont -> Struct (PrimState (ST s)) (Nullable (Membership xs)) ys
-> Membership ys x -> Nullable (Membership xs) x -> ST s ()
forall {k} (m :: Type -> Type) (h :: k -> Type) (xs :: [k])
       (x :: k).
PrimMonad m =>
Struct (PrimState m) h xs -> Membership xs x -> h x -> m ()
S.set Struct s (Nullable (Membership xs)) ys
Struct (PrimState (ST s)) (Nullable (Membership xs)) ys
s Membership ys x
m (Maybe (Membership xs x) -> Nullable (Membership xs) x
forall {k} (h :: k -> Type) (x :: k). Maybe (h x) -> Nullable h x
Nullable (Maybe (Membership xs x) -> Nullable (Membership xs) x)
-> Maybe (Membership xs x) -> Nullable (Membership xs) x
forall a b. (a -> b) -> a -> b
$ Membership xs x -> Maybe (Membership xs x)
forall a. a -> Maybe a
Just Membership xs x
i) ST s ()
-> ST s (Struct s (Nullable (Membership xs)) ys)
-> ST s (Struct s (Nullable (Membership xs)) ys)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ST s (Struct s (Nullable (Membership xs)) ys)
cont) (Struct s (Nullable (Membership xs)) ys
-> ST s (Struct s (Nullable (Membership xs)) ys)
forall a. a -> ST s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Struct s (Nullable (Membership xs)) ys
s) xs :& Membership ys
forall {k} {v} (xs :: [Assoc k v]) (ys :: [Assoc k v]).
IncludeAssoc ys xs =>
xs :& Membership ys
inclusionAssoc

-- | Extend a product and fill missing fields by 'Null'.
wrenchAssoc :: (Generate ys, IncludeAssoc ys xs) => xs :& h -> ys :& Nullable h
wrenchAssoc :: forall {k} {v} (ys :: [Assoc k v]) (xs :: [Assoc k v])
       (h :: Assoc k v -> Type).
(Generate ys, IncludeAssoc ys xs) =>
(xs :& h) -> ys :& Nullable h
wrenchAssoc xs :& h
xs = (Membership xs x -> h x)
-> Nullable (Membership xs) x -> Nullable h x
forall {k} {k} (g :: k -> Type) (x :: k) (h :: k -> Type) (y :: k).
(g x -> h y) -> Nullable g x -> Nullable h y
mapNullable ((Membership xs x -> (xs :& h) -> h x)
-> (xs :& h) -> Membership xs x -> h x
forall a b c. (a -> b -> c) -> b -> a -> c
flip Membership xs x -> (xs :& h) -> h x
forall {k} (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> (xs :& h) -> h x
hlookup xs :& h
xs) (forall {x :: Assoc k v}.
 Nullable (Membership xs) x -> Nullable h x)
-> (ys :& Nullable (Membership xs)) -> ys :& Nullable h
forall {k} (g :: k -> Type) (h :: k -> Type) (xs :: [k]).
(forall (x :: k). g x -> h x) -> (xs :& g) -> xs :& h
`hmap` ys :& Nullable (Membership xs)
forall {k} {v} (ys :: [Assoc k v]) (xs :: [Assoc k v]).
(IncludeAssoc ys xs, Generate ys) =>
ys :& Nullable (Membership xs)
coinclusionAssoc
{-# INLINE wrenchAssoc #-}

-- | Narrow the range of the sum, if possible.
retrenchAssoc :: (Generate ys, IncludeAssoc ys xs) => ys :/ h -> Nullable ((:/) xs) h
retrenchAssoc :: forall {k} {v} (ys :: [Assoc k v]) (xs :: [Assoc k v])
       (h :: Assoc k v -> Type).
(Generate ys, IncludeAssoc ys xs) =>
(ys :/ h) -> Nullable ((:/) xs) h
retrenchAssoc (EmbedAt Membership ys x
i h x
h) = Optic'
  (->)
  (Const (Nullable ((:/) xs) h))
  (ys :& Nullable (Membership xs))
  (Nullable (Membership xs) x)
-> (Nullable (Membership xs) x -> Nullable ((:/) xs) h)
-> (ys :& Nullable (Membership xs))
-> Nullable ((:/) xs) h
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views (Membership ys x
-> Optic'
     (->)
     (Const (Nullable ((:/) xs) h))
     (ys :& Nullable (Membership xs))
     (Nullable (Membership xs) x)
forall (xs :: [Assoc k v]) (h :: Assoc k v -> Type)
       (x :: Assoc k v).
ExtensibleConstr (:&) xs h x =>
Membership xs x
-> Optic' (->) (Const (Nullable ((:/) xs) h)) (xs :& h) (h x)
forall k (f :: Type -> Type) (p :: Type -> Type -> Type)
       (t :: [k] -> (k -> Type) -> Type) (xs :: [k]) (h :: k -> Type)
       (x :: k).
(Extensible f p t, ExtensibleConstr t xs h x) =>
Membership xs x -> Optic' p f (t xs h) (h x)
pieceAt Membership ys x
i) ((Membership xs x -> xs :/ h)
-> Nullable (Membership xs) x -> Nullable ((:/) xs) h
forall {k} {k} (g :: k -> Type) (x :: k) (h :: k -> Type) (y :: k).
(g x -> h y) -> Nullable g x -> Nullable h y
mapNullable (Membership xs x -> h x -> xs :/ h
forall {k} (xs :: [k]) (x :: k) (h :: k -> Type).
Membership xs x -> h x -> xs :/ h
`EmbedAt`h x
h)) ys :& Nullable (Membership xs)
forall {k} {v} (ys :: [Assoc k v]) (xs :: [Assoc k v]).
(IncludeAssoc ys xs, Generate ys) =>
ys :& Nullable (Membership xs)
coinclusionAssoc
{-# INLINE retrenchAssoc #-}