{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Knit where

import           Control.DeepSeq (NFData)
import qualified Control.Monad.ST as ST

import           Data.Foldable (Foldable, toList)
import qualified Data.HashTable.Class as HC
import qualified Data.HashTable.ST.Basic as H
import qualified Data.Map as M
import qualified Data.Set as S
import           Data.Maybe (catMaybes)
import           Data.Semigroup ((<>))

import           GHC.Generics (Generic)
import           GHC.TypeLits (KnownSymbol, Symbol, TypeError, ErrorMessage(..), symbolVal)
import qualified Generics.Eot as Eot
import           Generics.Eot (Eot, HasEot, Named (Named), Void, Proxy (..), fromEot, toEot)

import           Unsafe.Coerce (unsafeCoerce)

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

type family Fst a where
  Fst '(a, b) = a

type family Snd a where
  Snd '(a, b) = b

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

type TableName = String
type FieldName = String
type FieldValue = String

data Mode = Resolved | Unresolved | Done

data RecordId t = Id t | Remove t
  deriving (Int -> RecordId t -> ShowS
[RecordId t] -> ShowS
RecordId t -> TableName
(Int -> RecordId t -> ShowS)
-> (RecordId t -> TableName)
-> ([RecordId t] -> ShowS)
-> Show (RecordId t)
forall t. Show t => Int -> RecordId t -> ShowS
forall t. Show t => [RecordId t] -> ShowS
forall t. Show t => RecordId t -> TableName
forall a.
(Int -> a -> ShowS) -> (a -> TableName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> RecordId t -> ShowS
showsPrec :: Int -> RecordId t -> ShowS
$cshow :: forall t. Show t => RecordId t -> TableName
show :: RecordId t -> TableName
$cshowList :: forall t. Show t => [RecordId t] -> ShowS
showList :: [RecordId t] -> ShowS
Show, RecordId t -> RecordId t -> Bool
(RecordId t -> RecordId t -> Bool)
-> (RecordId t -> RecordId t -> Bool) -> Eq (RecordId t)
forall t. Eq t => RecordId t -> RecordId t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => RecordId t -> RecordId t -> Bool
== :: RecordId t -> RecordId t -> Bool
$c/= :: forall t. Eq t => RecordId t -> RecordId t -> Bool
/= :: RecordId t -> RecordId t -> Bool
Eq, Eq (RecordId t)
Eq (RecordId t) =>
(RecordId t -> RecordId t -> Ordering)
-> (RecordId t -> RecordId t -> Bool)
-> (RecordId t -> RecordId t -> Bool)
-> (RecordId t -> RecordId t -> Bool)
-> (RecordId t -> RecordId t -> Bool)
-> (RecordId t -> RecordId t -> RecordId t)
-> (RecordId t -> RecordId t -> RecordId t)
-> Ord (RecordId t)
RecordId t -> RecordId t -> Bool
RecordId t -> RecordId t -> Ordering
RecordId t -> RecordId t -> RecordId t
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 t. Ord t => Eq (RecordId t)
forall t. Ord t => RecordId t -> RecordId t -> Bool
forall t. Ord t => RecordId t -> RecordId t -> Ordering
forall t. Ord t => RecordId t -> RecordId t -> RecordId t
$ccompare :: forall t. Ord t => RecordId t -> RecordId t -> Ordering
compare :: RecordId t -> RecordId t -> Ordering
$c< :: forall t. Ord t => RecordId t -> RecordId t -> Bool
< :: RecordId t -> RecordId t -> Bool
$c<= :: forall t. Ord t => RecordId t -> RecordId t -> Bool
<= :: RecordId t -> RecordId t -> Bool
$c> :: forall t. Ord t => RecordId t -> RecordId t -> Bool
> :: RecordId t -> RecordId t -> Bool
$c>= :: forall t. Ord t => RecordId t -> RecordId t -> Bool
>= :: RecordId t -> RecordId t -> Bool
$cmax :: forall t. Ord t => RecordId t -> RecordId t -> RecordId t
max :: RecordId t -> RecordId t -> RecordId t
$cmin :: forall t. Ord t => RecordId t -> RecordId t -> RecordId t
min :: RecordId t -> RecordId t -> RecordId t
Ord, (forall x. RecordId t -> Rep (RecordId t) x)
-> (forall x. Rep (RecordId t) x -> RecordId t)
-> Generic (RecordId t)
forall x. Rep (RecordId t) x -> RecordId t
forall x. RecordId t -> Rep (RecordId t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (RecordId t) x -> RecordId t
forall t x. RecordId t -> Rep (RecordId t) x
$cfrom :: forall t x. RecordId t -> Rep (RecordId t) x
from :: forall x. RecordId t -> Rep (RecordId t) x
$cto :: forall t x. Rep (RecordId t) x -> RecordId t
to :: forall x. Rep (RecordId t) x -> RecordId t
Generic)

instance NFData t => NFData (RecordId t)

type family Id (tables :: Mode -> *) (recordMode :: Mode) t where
  Id tables 'Done t = RecordId t
  Id tables 'Resolved t = t
  Id tables 'Unresolved t = RecordId t

data Lazy tables a = Lazy
  { forall {k} (tables :: k) (a :: k -> Mode -> *).
Lazy tables a -> a tables 'Resolved
get :: a tables 'Resolved
  }

instance Show (Lazy tables a) where
  show :: Lazy tables a -> TableName
show Lazy tables a
_ = TableName
"Lazy"

newtype ForeignRecordId (table :: Symbol) (field :: Symbol) t = ForeignId t
  deriving (Int -> ForeignRecordId table field t -> ShowS
[ForeignRecordId table field t] -> ShowS
ForeignRecordId table field t -> TableName
(Int -> ForeignRecordId table field t -> ShowS)
-> (ForeignRecordId table field t -> TableName)
-> ([ForeignRecordId table field t] -> ShowS)
-> Show (ForeignRecordId table field t)
forall a.
(Int -> a -> ShowS) -> (a -> TableName) -> ([a] -> ShowS) -> Show a
forall (table :: Symbol) (field :: Symbol) t.
Show t =>
Int -> ForeignRecordId table field t -> ShowS
forall (table :: Symbol) (field :: Symbol) t.
Show t =>
[ForeignRecordId table field t] -> ShowS
forall (table :: Symbol) (field :: Symbol) t.
Show t =>
ForeignRecordId table field t -> TableName
$cshowsPrec :: forall (table :: Symbol) (field :: Symbol) t.
Show t =>
Int -> ForeignRecordId table field t -> ShowS
showsPrec :: Int -> ForeignRecordId table field t -> ShowS
$cshow :: forall (table :: Symbol) (field :: Symbol) t.
Show t =>
ForeignRecordId table field t -> TableName
show :: ForeignRecordId table field t -> TableName
$cshowList :: forall (table :: Symbol) (field :: Symbol) t.
Show t =>
[ForeignRecordId table field t] -> ShowS
showList :: [ForeignRecordId table field t] -> ShowS
Show, ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
(ForeignRecordId table field t
 -> ForeignRecordId table field t -> Bool)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> Bool)
-> Eq (ForeignRecordId table field t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (table :: Symbol) (field :: Symbol) t.
Eq t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
$c== :: forall (table :: Symbol) (field :: Symbol) t.
Eq t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
== :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
$c/= :: forall (table :: Symbol) (field :: Symbol) t.
Eq t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
/= :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
Eq, Eq (ForeignRecordId table field t)
Eq (ForeignRecordId table field t) =>
(ForeignRecordId table field t
 -> ForeignRecordId table field t -> Ordering)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> Bool)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> Bool)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> Bool)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> Bool)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> ForeignRecordId table field t)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> ForeignRecordId table field t)
-> Ord (ForeignRecordId table field t)
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
ForeignRecordId table field t
-> ForeignRecordId table field t -> Ordering
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
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 (table :: Symbol) (field :: Symbol) t.
Ord t =>
Eq (ForeignRecordId table field t)
forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Ordering
forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
$ccompare :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Ordering
compare :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Ordering
$c< :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
< :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
$c<= :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
<= :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
$c> :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
> :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
$c>= :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
>= :: ForeignRecordId table field t
-> ForeignRecordId table field t -> Bool
$cmax :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
max :: ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
$cmin :: forall (table :: Symbol) (field :: Symbol) t.
Ord t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
min :: ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
Ord, Integer -> ForeignRecordId table field t
ForeignRecordId table field t -> ForeignRecordId table field t
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
(ForeignRecordId table field t
 -> ForeignRecordId table field t -> ForeignRecordId table field t)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> ForeignRecordId table field t)
-> (ForeignRecordId table field t
    -> ForeignRecordId table field t -> ForeignRecordId table field t)
-> (ForeignRecordId table field t -> ForeignRecordId table field t)
-> (ForeignRecordId table field t -> ForeignRecordId table field t)
-> (ForeignRecordId table field t -> ForeignRecordId table field t)
-> (Integer -> ForeignRecordId table field t)
-> Num (ForeignRecordId table field t)
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
forall (table :: Symbol) (field :: Symbol) t.
Num t =>
Integer -> ForeignRecordId table field t
forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t -> ForeignRecordId table field t
forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
$c+ :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
+ :: ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
$c- :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
- :: ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
$c* :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
* :: ForeignRecordId table field t
-> ForeignRecordId table field t -> ForeignRecordId table field t
$cnegate :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t -> ForeignRecordId table field t
negate :: ForeignRecordId table field t -> ForeignRecordId table field t
$cabs :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t -> ForeignRecordId table field t
abs :: ForeignRecordId table field t -> ForeignRecordId table field t
$csignum :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
ForeignRecordId table field t -> ForeignRecordId table field t
signum :: ForeignRecordId table field t -> ForeignRecordId table field t
$cfromInteger :: forall (table :: Symbol) (field :: Symbol) t.
Num t =>
Integer -> ForeignRecordId table field t
fromInteger :: Integer -> ForeignRecordId table field t
Num, (forall x.
 ForeignRecordId table field t
 -> Rep (ForeignRecordId table field t) x)
-> (forall x.
    Rep (ForeignRecordId table field t) x
    -> ForeignRecordId table field t)
-> Generic (ForeignRecordId table field t)
forall x.
Rep (ForeignRecordId table field t) x
-> ForeignRecordId table field t
forall x.
ForeignRecordId table field t
-> Rep (ForeignRecordId table field t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (table :: Symbol) (field :: Symbol) t x.
Rep (ForeignRecordId table field t) x
-> ForeignRecordId table field t
forall (table :: Symbol) (field :: Symbol) t x.
ForeignRecordId table field t
-> Rep (ForeignRecordId table field t) x
$cfrom :: forall (table :: Symbol) (field :: Symbol) t x.
ForeignRecordId table field t
-> Rep (ForeignRecordId table field t) x
from :: forall x.
ForeignRecordId table field t
-> Rep (ForeignRecordId table field t) x
$cto :: forall (table :: Symbol) (field :: Symbol) t x.
Rep (ForeignRecordId table field t) x
-> ForeignRecordId table field t
to :: forall x.
Rep (ForeignRecordId table field t) x
-> ForeignRecordId table field t
Generic, ForeignRecordId table field t -> ()
(ForeignRecordId table field t -> ())
-> NFData (ForeignRecordId table field t)
forall a. (a -> ()) -> NFData a
forall (table :: Symbol) (field :: Symbol) t.
NFData t =>
ForeignRecordId table field t -> ()
$crnf :: forall (table :: Symbol) (field :: Symbol) t.
NFData t =>
ForeignRecordId table field t -> ()
rnf :: ForeignRecordId table field t -> ()
NFData)

type family ForeignId (tables :: Mode -> *) (recordMode :: Mode) (table :: Symbol) (field :: Symbol) where
  ForeignId tables 'Done table field = ()
  ForeignId tables 'Unresolved table field = ForeignRecordId
    table
    field
    (LookupFieldType field (Snd (LookupTableType table (Eot (tables 'Unresolved)))))
  ForeignId tables 'Resolved table field = Lazy
    tables
    (Fst (LookupTableType table (Eot (tables 'Resolved))))

-- GatherIds -------------------------------------------------------------------

data EId
  = forall t. Show t => EId TableName FieldName t Dynamic
  | forall t. Show t => ERemove TableName FieldName t Dynamic
  | forall t. Show t => EForeignId TableName FieldName t

deriving instance Show EId

newtype Dynamic = Dynamic ()

instance Show Dynamic where
  show :: Dynamic -> TableName
show Dynamic
_ = TableName
"Dynamic"

toDynamic :: a -> Dynamic
toDynamic :: forall a. a -> Dynamic
toDynamic = () -> Dynamic
Dynamic (() -> Dynamic) -> (a -> ()) -> a -> Dynamic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ()
forall a b. a -> b
unsafeCoerce

fromDynamic :: Dynamic -> a
fromDynamic :: forall a. Dynamic -> a
fromDynamic (Dynamic ()
v) = () -> a
forall a b. a -> b
unsafeCoerce ()
v

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

class GGatherIds u where
  gGatherIds :: TableName -> Dynamic -> u -> [EId]

instance GGatherIds () where
  gGatherIds :: TableName -> Dynamic -> () -> [EId]
gGatherIds TableName
_ Dynamic
_ () = []

instance GGatherIds Void where
  gGatherIds :: TableName -> Dynamic -> Void -> [EId]
gGatherIds TableName
_ Dynamic
_ Void
_ = [EId]
forall a. HasCallStack => a
undefined

instance (GGatherIds u, GGatherIds v) => GGatherIds (Either u v) where
  gGatherIds :: TableName -> Dynamic -> Either u v -> [EId]
gGatherIds TableName
table Dynamic
record (Left u
u) = TableName -> Dynamic -> u -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record u
u
  gGatherIds TableName
table Dynamic
record (Right v
v) = TableName -> Dynamic -> v -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record v
v

instance GGatherIds us => GGatherIds (Named field u, us) where
  gGatherIds :: TableName -> Dynamic -> (Named field u, us) -> [EId]
gGatherIds TableName
table Dynamic
record (Named field u
_, us
us) = TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us

instance {-# OVERLAPPING #-}
  ( Show t
  , GGatherIds us
  , KnownSymbol field
  ) =>
  GGatherIds (Named field (RecordId t), us) where
    gGatherIds :: TableName -> Dynamic -> (Named field (RecordId t), us) -> [EId]
gGatherIds TableName
table Dynamic
record (Named (Id t
k), us
us)
      = TableName -> TableName -> t -> Dynamic -> EId
forall t. Show t => TableName -> TableName -> t -> Dynamic -> EId
EId TableName
table (Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)) t
k Dynamic
recordEId -> [EId] -> [EId]
forall a. a -> [a] -> [a]
:TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us
    gGatherIds TableName
table Dynamic
record (Named (Remove t
k), us
us)
      = TableName -> TableName -> t -> Dynamic -> EId
forall t. Show t => TableName -> TableName -> t -> Dynamic -> EId
ERemove TableName
table (Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)) t
k Dynamic
recordEId -> [EId] -> [EId]
forall a. a -> [a] -> [a]
:TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us

instance {-# OVERLAPPING #-}
  ( Show t

  , GGatherIds us

  , KnownSymbol table
  , KnownSymbol field
  ) =>
  GGatherIds (Named field' (ForeignRecordId table field t), us) where
    gGatherIds :: TableName
-> Dynamic
-> (Named field' (ForeignRecordId table field t), us)
-> [EId]
gGatherIds TableName
table Dynamic
record (Named (ForeignId t
k), us
us)
      = TableName -> TableName -> t -> EId
forall t. Show t => TableName -> TableName -> t -> EId
EForeignId (Proxy table -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy table
forall {k} (t :: k). Proxy t
Proxy :: Proxy table)) (Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)) t
kEId -> [EId] -> [EId]
forall a. a -> [a] -> [a]
:TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us

instance {-# OVERLAPPING #-}
  ( Show t

  , GGatherIds us

  , Foldable f

  , KnownSymbol field
  ) =>
  GGatherIds (Named field (f (RecordId t)), us) where
    gGatherIds :: TableName -> Dynamic -> (Named field (f (RecordId t)), us) -> [EId]
gGatherIds TableName
table Dynamic
record (Named f (RecordId t)
f, us
us) = [EId]
eids [EId] -> [EId] -> [EId]
forall a. Semigroup a => a -> a -> a
<> TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us
      where
        eids :: [EId]
eids =
          [ TableName -> TableName -> t -> Dynamic -> EId
forall t. Show t => TableName -> TableName -> t -> Dynamic -> EId
EId TableName
table (Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)) t
k Dynamic
record
          | Id t
k <- f (RecordId t) -> [RecordId t]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (RecordId t)
f
          ]

instance {-# OVERLAPPING #-}
  ( Show t

  , GGatherIds us

  , Foldable f

  , KnownSymbol table
  , KnownSymbol field
  ) =>
  GGatherIds (Named field' (f (ForeignRecordId table field t)), us) where
    gGatherIds :: TableName
-> Dynamic
-> (Named field' (f (ForeignRecordId table field t)), us)
-> [EId]
gGatherIds TableName
table Dynamic
record (Named f (ForeignRecordId table field t)
f, us
us) = [EId]
eids [EId] -> [EId] -> [EId]
forall a. Semigroup a => a -> a -> a
<> TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us
      where
        eids :: [EId]
eids =
          [ TableName -> TableName -> t -> EId
forall t. Show t => TableName -> TableName -> t -> EId
EForeignId (Proxy table -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy table
forall {k} (t :: k). Proxy t
Proxy :: Proxy table)) (Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)) t
k
          | ForeignId t
k <- f (ForeignRecordId table field t)
-> [ForeignRecordId table field t]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (ForeignRecordId table field t)
f
          ]

instance {-# OVERLAPPING #-}
  ( GGatherIds us
  , KnitRecord tables r
  ) =>
  GGatherIds (Named field (r tables 'Unresolved), us) where
    gGatherIds :: TableName
-> Dynamic -> (Named field (r tables 'Unresolved), us) -> [EId]
gGatherIds TableName
table Dynamic
record (Named r tables 'Unresolved
r, us
us)
      = [EId]
fids [EId] -> [EId] -> [EId]
forall a. Semigroup a => a -> a -> a
<> TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us
      where
        -- only gather foreign ids here, since nested records can't be referenced anyway
        fids :: [EId]
fids =
          [ EId
fid
          | fid :: EId
fid@(EForeignId TableName
_ TableName
_ t
_) <- TableName -> Dynamic -> r tables 'Unresolved -> [EId]
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
TableName -> Dynamic -> u tables 'Unresolved -> [EId]
gatherIds TableName
table (r tables 'Unresolved -> Dynamic
forall a. a -> Dynamic
toDynamic r tables 'Unresolved
r) r tables 'Unresolved
r
          ]

instance {-# OVERLAPPING #-}
  ( GGatherIds us
  , Foldable f
  , KnitRecord tables r
  ) =>
  GGatherIds (Named field (f (r tables 'Unresolved)), us) where
    gGatherIds :: TableName
-> Dynamic -> (Named field (f (r tables 'Unresolved)), us) -> [EId]
gGatherIds TableName
table Dynamic
record (Named f (r tables 'Unresolved)
f, us
us) = [EId]
fids [EId] -> [EId] -> [EId]
forall a. Semigroup a => a -> a -> a
<> TableName -> Dynamic -> us -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record us
us
      where
        -- only gather foreign ids here, since nested records can't be referenced anyway
        fids :: [EId]
fids = [[EId]] -> [EId]
forall a. Monoid a => [a] -> a
mconcat
          [ [ EId
fid
            | fid :: EId
fid@(EForeignId TableName
_ TableName
_ t
_) <- TableName -> Dynamic -> r tables 'Unresolved -> [EId]
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
TableName -> Dynamic -> u tables 'Unresolved -> [EId]
gatherIds TableName
table (r tables 'Unresolved -> Dynamic
forall a. a -> Dynamic
toDynamic r tables 'Unresolved
r) r tables 'Unresolved
r
            ]
          | r tables 'Unresolved
r <- f (r tables 'Unresolved) -> [r tables 'Unresolved]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (r tables 'Unresolved)
f
          ]

-- GatherTableIds --------------------------------------------------------------

class GGatherTableIds t where
  gGatherTableIds :: t -> [(TableName, [[EId]])]

instance GGatherTableIds () where
  gGatherTableIds :: () -> [(TableName, [[EId]])]
gGatherTableIds () = []

instance GGatherTableIds Void where
  gGatherTableIds :: Void -> [(TableName, [[EId]])]
gGatherTableIds Void
_ = [(TableName, [[EId]])]
forall a. HasCallStack => a
undefined

instance (GGatherTableIds t, GGatherTableIds u) => GGatherTableIds (Either t u) where
  gGatherTableIds :: Either t u -> [(TableName, [[EId]])]
gGatherTableIds (Left t
t) = t -> [(TableName, [[EId]])]
forall t. GGatherTableIds t => t -> [(TableName, [[EId]])]
gGatherTableIds t
t
  gGatherTableIds (Right u
u) = u -> [(TableName, [[EId]])]
forall t. GGatherTableIds t => t -> [(TableName, [[EId]])]
gGatherTableIds u
u

instance ( GGatherTableIds ts
         , KnownSymbol table
         ) => GGatherTableIds (Named table a, ts) where
  gGatherTableIds :: (Named table a, ts) -> [(TableName, [[EId]])]
gGatherTableIds (Named table a
_, ts
ts) = ts -> [(TableName, [[EId]])]
forall t. GGatherTableIds t => t -> [(TableName, [[EId]])]
gGatherTableIds ts
ts

instance {-# OVERLAPPING #-}
  ( GGatherTableIds ts
  , KnitRecord tables r
  , KnownSymbol table
  ) => GGatherTableIds (Named table [r tables 'Unresolved], ts) where
  gGatherTableIds :: (Named table [r tables 'Unresolved], ts) -> [(TableName, [[EId]])]
gGatherTableIds (Named [r tables 'Unresolved]
records, ts
ts) = (TableName
table, [[EId]]
eids)(TableName, [[EId]])
-> [(TableName, [[EId]])] -> [(TableName, [[EId]])]
forall a. a -> [a] -> [a]
:ts -> [(TableName, [[EId]])]
forall t. GGatherTableIds t => t -> [(TableName, [[EId]])]
gGatherTableIds ts
ts
    where
      table :: TableName
table = Proxy table -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy table
forall {k} (t :: k). Proxy t
Proxy :: Proxy table)
      eids :: [[EId]]
eids =
        -- TODO: remove table here
        [ TableName -> Dynamic -> r tables 'Unresolved -> [EId]
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
TableName -> Dynamic -> u tables 'Unresolved -> [EId]
gatherIds TableName
table (r tables 'Unresolved -> Dynamic
forall a. a -> Dynamic
toDynamic r tables 'Unresolved
record) r tables 'Unresolved
record
        | r tables 'Unresolved
record <- [r tables 'Unresolved]
records
        ]

-- Resolve ---------------------------------------------------------------------

data ResolveError
  = MissingIds [(TableName, FieldName, FieldValue)]
  | RepeatingIds [(TableName, FieldName, FieldValue)]
  deriving (ResolveError -> ResolveError -> Bool
(ResolveError -> ResolveError -> Bool)
-> (ResolveError -> ResolveError -> Bool) -> Eq ResolveError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResolveError -> ResolveError -> Bool
== :: ResolveError -> ResolveError -> Bool
$c/= :: ResolveError -> ResolveError -> Bool
/= :: ResolveError -> ResolveError -> Bool
Eq, Eq ResolveError
Eq ResolveError =>
(ResolveError -> ResolveError -> Ordering)
-> (ResolveError -> ResolveError -> Bool)
-> (ResolveError -> ResolveError -> Bool)
-> (ResolveError -> ResolveError -> Bool)
-> (ResolveError -> ResolveError -> Bool)
-> (ResolveError -> ResolveError -> ResolveError)
-> (ResolveError -> ResolveError -> ResolveError)
-> Ord ResolveError
ResolveError -> ResolveError -> Bool
ResolveError -> ResolveError -> Ordering
ResolveError -> ResolveError -> ResolveError
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
$ccompare :: ResolveError -> ResolveError -> Ordering
compare :: ResolveError -> ResolveError -> Ordering
$c< :: ResolveError -> ResolveError -> Bool
< :: ResolveError -> ResolveError -> Bool
$c<= :: ResolveError -> ResolveError -> Bool
<= :: ResolveError -> ResolveError -> Bool
$c> :: ResolveError -> ResolveError -> Bool
> :: ResolveError -> ResolveError -> Bool
$c>= :: ResolveError -> ResolveError -> Bool
>= :: ResolveError -> ResolveError -> Bool
$cmax :: ResolveError -> ResolveError -> ResolveError
max :: ResolveError -> ResolveError -> ResolveError
$cmin :: ResolveError -> ResolveError -> ResolveError
min :: ResolveError -> ResolveError -> ResolveError
Ord, (forall x. ResolveError -> Rep ResolveError x)
-> (forall x. Rep ResolveError x -> ResolveError)
-> Generic ResolveError
forall x. Rep ResolveError x -> ResolveError
forall x. ResolveError -> Rep ResolveError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResolveError -> Rep ResolveError x
from :: forall x. ResolveError -> Rep ResolveError x
$cto :: forall x. Rep ResolveError x -> ResolveError
to :: forall x. Rep ResolveError x -> ResolveError
Generic, Int -> ResolveError -> ShowS
[ResolveError] -> ShowS
ResolveError -> TableName
(Int -> ResolveError -> ShowS)
-> (ResolveError -> TableName)
-> ([ResolveError] -> ShowS)
-> Show ResolveError
forall a.
(Int -> a -> ShowS) -> (a -> TableName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResolveError -> ShowS
showsPrec :: Int -> ResolveError -> ShowS
$cshow :: ResolveError -> TableName
show :: ResolveError -> TableName
$cshowList :: [ResolveError] -> ShowS
showList :: [ResolveError] -> ShowS
Show)

instance NFData ResolveError

class GResolve u r where
  gResolve
    :: (TableName -> FieldName -> FieldValue -> Dynamic)
    -> u
    -> r

instance GResolve () () where
  gResolve :: (TableName -> TableName -> TableName -> Dynamic) -> () -> ()
gResolve TableName -> TableName -> TableName -> Dynamic
_ () = ()

instance GResolve Void Void where
  gResolve :: (TableName -> TableName -> TableName -> Dynamic) -> Void -> Void
gResolve TableName -> TableName -> TableName -> Dynamic
_ Void
_ = Void
forall a. HasCallStack => a
undefined

instance (GResolve u r, GResolve t s) => GResolve (Either u t) (Either r s) where
  gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> Either u t -> Either r s
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Left u
u) = r -> Either r s
forall a b. a -> Either a b
Left (r -> Either r s) -> r -> Either r s
forall a b. (a -> b) -> a -> b
$ (TableName -> TableName -> TableName -> Dynamic) -> u -> r
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap u
u 
  gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Right t
u) = s -> Either r s
forall a b. b -> Either a b
Right (s -> Either r s) -> s -> Either r s
forall a b. (a -> b) -> a -> b
$ (TableName -> TableName -> TableName -> Dynamic) -> t -> s
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap t
u 

instance (GResolve us rs) => GResolve (Named x u, us) (Named x u, rs) where
  gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x u, us) -> (Named x u, rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named x u
u, us
us) = (Named x u
u, (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)

instance (GResolve us rs) => GResolve (Named x (RecordId u), us) (Named x u, rs) where
  gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x (RecordId u), us) -> (Named x u, rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named (Id u
u), us
us) = (u -> Named x u
forall (a :: Symbol) field. field -> Named a field
Named u
u, (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)
  gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named (Remove u
_), us
us) = (u -> Named x u
forall (a :: Symbol) field. field -> Named a field
Named (TableName -> u
forall a. HasCallStack => TableName -> a
error TableName
"gResolve: Remove: this is a bug"), (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)

instance (GResolve us rs, Functor f) => GResolve (Named x (f (RecordId u)), us) (Named x (f u), rs) where
  gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x (f (RecordId u)), us) -> (Named x (f u), rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named f (RecordId u)
u', us
us) = (f u -> Named x (f u)
forall (a :: Symbol) field. field -> Named a field
Named (f u -> Named x (f u)) -> f u -> Named x (f u)
forall a b. (a -> b) -> a -> b
$ (RecordId u -> u) -> f (RecordId u) -> f u
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Id u
u) -> u
u) f (RecordId u)
u', (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)

instance
  ( Show u

  , KnitRecord tables r
  , GResolve us rs

  , KnownSymbol table
  , KnownSymbol field
  ) =>
  GResolve (Named x (ForeignRecordId table field u), us) (Named x (Lazy tables r), rs) where
    gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x (ForeignRecordId table field u), us)
-> (Named x (Lazy tables r), rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named (ForeignId u
k), us
us)
      = ( Lazy tables r -> Named x (Lazy tables r)
forall (a :: Symbol) field. field -> Named a field
Named (Lazy tables r -> Named x (Lazy tables r))
-> Lazy tables r -> Named x (Lazy tables r)
forall a b. (a -> b) -> a -> b
$ r tables 'Resolved -> Lazy tables r
forall {k} (tables :: k) (a :: k -> Mode -> *).
a tables 'Resolved -> Lazy tables a
Lazy (r tables 'Resolved -> Lazy tables r)
-> r tables 'Resolved -> Lazy tables r
forall a b. (a -> b) -> a -> b
$ (TableName -> TableName -> TableName -> Dynamic)
-> r tables 'Unresolved -> r tables 'Resolved
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
(TableName -> TableName -> TableName -> Dynamic)
-> u tables 'Unresolved -> u tables 'Resolved
resolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Dynamic -> r tables 'Unresolved
forall a. Dynamic -> a
fromDynamic (Dynamic -> r tables 'Unresolved)
-> Dynamic -> r tables 'Unresolved
forall a b. (a -> b) -> a -> b
$ TableName -> TableName -> TableName -> Dynamic
rsvMap TableName
table TableName
field (u -> TableName
forall a. Show a => a -> TableName
show u
k))
        , (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us
        )
      where
        table :: TableName
table = Proxy table -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy table
forall {k} (t :: k). Proxy t
Proxy :: Proxy table)
        field :: TableName
field = Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)

instance
  ( Show u

  , KnitRecord tables r
  , GResolve us rs

  , Functor f

  , KnownSymbol table
  , KnownSymbol field
  ) =>
  GResolve (Named x (f (ForeignRecordId table field u)), us) (Named x (f (Lazy tables r)), rs) where
    gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x (f (ForeignRecordId table field u)), us)
-> (Named x (f (Lazy tables r)), rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named f (ForeignRecordId table field u)
f, us
us)
      = ( f (Lazy tables r) -> Named x (f (Lazy tables r))
forall (a :: Symbol) field. field -> Named a field
Named (f (Lazy tables r) -> Named x (f (Lazy tables r)))
-> f (Lazy tables r) -> Named x (f (Lazy tables r))
forall a b. (a -> b) -> a -> b
$ ((ForeignRecordId table field u -> Lazy tables r)
 -> f (ForeignRecordId table field u) -> f (Lazy tables r))
-> f (ForeignRecordId table field u)
-> (ForeignRecordId table field u -> Lazy tables r)
-> f (Lazy tables r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ForeignRecordId table field u -> Lazy tables r)
-> f (ForeignRecordId table field u) -> f (Lazy tables r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (ForeignRecordId table field u)
f ((ForeignRecordId table field u -> Lazy tables r)
 -> f (Lazy tables r))
-> (ForeignRecordId table field u -> Lazy tables r)
-> f (Lazy tables r)
forall a b. (a -> b) -> a -> b
$ \(ForeignId u
k) -> r tables 'Resolved -> Lazy tables r
forall {k} (tables :: k) (a :: k -> Mode -> *).
a tables 'Resolved -> Lazy tables a
Lazy (r tables 'Resolved -> Lazy tables r)
-> r tables 'Resolved -> Lazy tables r
forall a b. (a -> b) -> a -> b
$ (TableName -> TableName -> TableName -> Dynamic)
-> r tables 'Unresolved -> r tables 'Resolved
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
(TableName -> TableName -> TableName -> Dynamic)
-> u tables 'Unresolved -> u tables 'Resolved
resolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Dynamic -> r tables 'Unresolved
forall a. Dynamic -> a
fromDynamic (Dynamic -> r tables 'Unresolved)
-> Dynamic -> r tables 'Unresolved
forall a b. (a -> b) -> a -> b
$ TableName -> TableName -> TableName -> Dynamic
rsvMap TableName
table TableName
field (u -> TableName
forall a. Show a => a -> TableName
show u
k))
        , (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us
        )
      where
        table :: TableName
table = Proxy table -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy table
forall {k} (t :: k). Proxy t
Proxy :: Proxy table)
        field :: TableName
field = Proxy field -> TableName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> TableName
symbolVal (Proxy field
forall {k} (t :: k). Proxy t
Proxy :: Proxy field)

instance
  ( KnitRecord tables r
  , GResolve us rs
  ) =>
  GResolve (Named x (r tables 'Unresolved), us) (Named x (r tables 'Resolved), rs) where
    gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x (r tables 'Unresolved), us)
-> (Named x (r tables 'Resolved), rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named r tables 'Unresolved
u, us
us) = (r tables 'Resolved -> Named x (r tables 'Resolved)
forall (a :: Symbol) field. field -> Named a field
Named (r tables 'Resolved -> Named x (r tables 'Resolved))
-> r tables 'Resolved -> Named x (r tables 'Resolved)
forall a b. (a -> b) -> a -> b
$ (TableName -> TableName -> TableName -> Dynamic)
-> r tables 'Unresolved -> r tables 'Resolved
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
(TableName -> TableName -> TableName -> Dynamic)
-> u tables 'Unresolved -> u tables 'Resolved
resolve TableName -> TableName -> TableName -> Dynamic
rsvMap r tables 'Unresolved
u, (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)

instance
  ( KnitRecord tables r
  , GResolve us rs
  , Functor f
  ) =>
  GResolve (Named x (f (r tables 'Unresolved)), us) (Named x (f (r tables 'Resolved)), rs) where
    gResolve :: (TableName -> TableName -> TableName -> Dynamic)
-> (Named x (f (r tables 'Unresolved)), us)
-> (Named x (f (r tables 'Resolved)), rs)
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (Named f (r tables 'Unresolved)
u, us
us) = (f (r tables 'Resolved) -> Named x (f (r tables 'Resolved))
forall (a :: Symbol) field. field -> Named a field
Named (f (r tables 'Resolved) -> Named x (f (r tables 'Resolved)))
-> f (r tables 'Resolved) -> Named x (f (r tables 'Resolved))
forall a b. (a -> b) -> a -> b
$ (r tables 'Unresolved -> r tables 'Resolved)
-> f (r tables 'Unresolved) -> f (r tables 'Resolved)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TableName -> TableName -> TableName -> Dynamic)
-> r tables 'Unresolved -> r tables 'Resolved
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
(TableName -> TableName -> TableName -> Dynamic)
-> u tables 'Unresolved -> u tables 'Resolved
resolve TableName -> TableName -> TableName -> Dynamic
rsvMap) f (r tables 'Unresolved)
u, (TableName -> TableName -> TableName -> Dynamic) -> us -> rs
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)

-- ResolveTables ---------------------------------------------------------------

class GResolveTables u t where
  gResolveTables :: [[Bool]] -> (TableName -> FieldName -> FieldValue -> Dynamic) -> u -> t

instance GResolveTables () () where
  gResolveTables :: [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> () -> ()
gResolveTables [[Bool]]
_ TableName -> TableName -> TableName -> Dynamic
_ () = ()

instance GResolveTables u t => GResolveTables (Either u Void) (Either t Void) where
  gResolveTables :: [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic)
-> Either u Void
-> Either t Void
gResolveTables [[Bool]]
notRemoved TableName -> TableName -> TableName -> Dynamic
rsvMap (Left u
u) = t -> Either t Void
forall a b. a -> Either a b
Left (t -> Either t Void) -> t -> Either t Void
forall a b. (a -> b) -> a -> b
$ [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> u -> t
forall u t.
GResolveTables u t =>
[[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> u -> t
gResolveTables [[Bool]]
notRemoved TableName -> TableName -> TableName -> Dynamic
rsvMap u
u
  gResolveTables [[Bool]]
_ TableName -> TableName -> TableName -> Dynamic
_ Either u Void
_ = Either t Void
forall a. HasCallStack => a
undefined

instance GResolveTables us ts => GResolveTables (Named table a, us) (Named table a, ts) where
  gResolveTables :: [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic)
-> (Named table a, us)
-> (Named table a, ts)
gResolveTables [[Bool]]
nr TableName -> TableName -> TableName -> Dynamic
rsvMap (Named table a
a, us
us) = (Named table a
a, [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> us -> ts
forall u t.
GResolveTables u t =>
[[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> u -> t
gResolveTables [[Bool]]
nr TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)

instance
  ( GResolveTables us ts
  , KnitRecord tables t 
  ) => GResolveTables (Named table [t tables 'Unresolved], us) (Named table [t tables 'Resolved], ts) where
    gResolveTables :: [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic)
-> (Named table [t tables 'Unresolved], us)
-> (Named table [t tables 'Resolved], ts)
gResolveTables ([Bool]
notRemoved:[[Bool]]
notRemoved') TableName -> TableName -> TableName -> Dynamic
rsvMap (Named [t tables 'Unresolved]
ts, us
us)
      = ([t tables 'Resolved] -> Named table [t tables 'Resolved]
forall (a :: Symbol) field. field -> Named a field
Named [t tables 'Resolved]
resolved, [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> us -> ts
forall u t.
GResolveTables u t =>
[[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> u -> t
gResolveTables [[Bool]]
notRemoved' TableName -> TableName -> TableName -> Dynamic
rsvMap us
us)
      where
        resolved :: [t tables 'Resolved]
resolved =
          [ (TableName -> TableName -> TableName -> Dynamic)
-> t tables 'Unresolved -> t tables 'Resolved
forall (tables :: Mode -> *) (u :: (Mode -> *) -> Mode -> *).
KnitRecord tables u =>
(TableName -> TableName -> TableName -> Dynamic)
-> u tables 'Unresolved -> u tables 'Resolved
resolve TableName -> TableName -> TableName -> Dynamic
rsvMap t tables 'Unresolved
t
          | (Bool
nr, t tables 'Unresolved
t) <- [Bool] -> [t tables 'Unresolved] -> [(Bool, t tables 'Unresolved)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Bool]
notRemoved [t tables 'Unresolved]
ts
          , Bool
nr
          ]
    gResolveTables [] TableName -> TableName -> TableName -> Dynamic
_ (Named table [t tables 'Unresolved], us)
_ = TableName -> (Named table [t tables 'Resolved], ts)
forall a. HasCallStack => TableName -> a
error TableName
"gResolveTables: [] (this is a bug)"

-- KnitRecord ------------------------------------------------------------------

class KnitRecord (tables :: Mode -> *) u where
  resolve
    :: (TableName -> FieldName -> FieldValue -> Dynamic)
    -> u tables 'Unresolved
    -> u tables 'Resolved
  default resolve
    :: HasEot (u tables 'Unresolved)
    => HasEot (u tables 'Resolved)
    => GResolve (Eot (u tables 'Unresolved)) (Eot (u tables 'Resolved))

    => (TableName -> FieldName -> FieldValue -> Dynamic)
    -> u tables 'Unresolved
    -> u tables 'Resolved
  resolve TableName -> TableName -> TableName -> Dynamic
rsvMap = EotG (Rep (u tables 'Resolved)) -> u tables 'Resolved
Eot (u tables 'Resolved) -> u tables 'Resolved
forall a. HasEot a => Eot a -> a
fromEot (EotG (Rep (u tables 'Resolved)) -> u tables 'Resolved)
-> (u tables 'Unresolved -> EotG (Rep (u tables 'Resolved)))
-> u tables 'Unresolved
-> u tables 'Resolved
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableName -> TableName -> TableName -> Dynamic)
-> EotG (Rep (u tables 'Unresolved))
-> EotG (Rep (u tables 'Resolved))
forall u r.
GResolve u r =>
(TableName -> TableName -> TableName -> Dynamic) -> u -> r
gResolve TableName -> TableName -> TableName -> Dynamic
rsvMap (EotG (Rep (u tables 'Unresolved))
 -> EotG (Rep (u tables 'Resolved)))
-> (u tables 'Unresolved -> EotG (Rep (u tables 'Unresolved)))
-> u tables 'Unresolved
-> EotG (Rep (u tables 'Resolved))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u tables 'Unresolved -> EotG (Rep (u tables 'Unresolved))
u tables 'Unresolved -> Eot (u tables 'Unresolved)
forall a. HasEot a => a -> Eot a
toEot

  gatherIds :: TableName -> Dynamic -> u tables 'Unresolved -> [EId]
  default gatherIds
    :: HasEot (u tables 'Unresolved)
    => GGatherIds (Eot (u tables 'Unresolved))

    => TableName
    -> Dynamic
    -> u tables 'Unresolved
    -> [EId]
  gatherIds TableName
table Dynamic
record = TableName -> Dynamic -> EotG (Rep (u tables 'Unresolved)) -> [EId]
forall u. GGatherIds u => TableName -> Dynamic -> u -> [EId]
gGatherIds TableName
table Dynamic
record (EotG (Rep (u tables 'Unresolved)) -> [EId])
-> (u tables 'Unresolved -> EotG (Rep (u tables 'Unresolved)))
-> u tables 'Unresolved
-> [EId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u tables 'Unresolved -> EotG (Rep (u tables 'Unresolved))
u tables 'Unresolved -> Eot (u tables 'Unresolved)
forall a. HasEot a => a -> Eot a
toEot

-- KnitTables ------------------------------------------------------------------

class KnitTables t where
  resolveTables
    :: (TableName -> FieldName -> FieldValue -> Dynamic)
    -> t 'Unresolved
    -> Either ResolveError (t 'Resolved)
  default resolveTables
    :: HasEot (t 'Unresolved)
    => HasEot (t 'Resolved)
    => GResolveTables (Eot (t 'Unresolved)) (Eot (t 'Resolved))
    => KnitTables t

    => (TableName -> FieldName -> FieldValue -> Dynamic)
    -> t 'Unresolved
    -> Either ResolveError (t 'Resolved)
  resolveTables TableName -> TableName -> TableName -> Dynamic
extRsvMap t 'Unresolved
u
    -- | trace dbgInfo False = undefined
    | Bool -> Bool
not ([(TableName, TableName, TableName)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TableName, TableName, TableName)]
repeatingIds) = ResolveError -> Either ResolveError (t 'Resolved)
forall a b. a -> Either a b
Left (ResolveError -> Either ResolveError (t 'Resolved))
-> ResolveError -> Either ResolveError (t 'Resolved)
forall a b. (a -> b) -> a -> b
$ [(TableName, TableName, TableName)] -> ResolveError
RepeatingIds [(TableName, TableName, TableName)]
repeatingIds
    | [] <- [(TableName, TableName, TableName)]
missingIds = t 'Resolved -> Either ResolveError (t 'Resolved)
forall a b. b -> Either a b
Right (t 'Resolved -> Either ResolveError (t 'Resolved))
-> t 'Resolved -> Either ResolveError (t 'Resolved)
forall a b. (a -> b) -> a -> b
$ Eot (t 'Resolved) -> t 'Resolved
forall a. HasEot a => Eot a -> a
fromEot (Eot (t 'Resolved) -> t 'Resolved)
-> Eot (t 'Resolved) -> t 'Resolved
forall a b. (a -> b) -> a -> b
$ [[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic)
-> EotG (Rep (t 'Unresolved))
-> EotG (Rep (t 'Resolved))
forall u t.
GResolveTables u t =>
[[Bool]]
-> (TableName -> TableName -> TableName -> Dynamic) -> u -> t
gResolveTables [[Bool]]
notRemovedIds TableName -> TableName -> TableName -> Dynamic
rsv (t 'Unresolved -> Eot (t 'Unresolved)
forall a. HasEot a => a -> Eot a
toEot t 'Unresolved
u)
    | Bool
otherwise = ResolveError -> Either ResolveError (t 'Resolved)
forall a b. a -> Either a b
Left (ResolveError -> Either ResolveError (t 'Resolved))
-> ResolveError -> Either ResolveError (t 'Resolved)
forall a b. (a -> b) -> a -> b
$ [(TableName, TableName, TableName)] -> ResolveError
MissingIds [(TableName, TableName, TableName)]
missingIds
    where
      -- dbgInfo = mconcat
      --   [ "Eids: ", show eids, "\n"
      --   , "Not removed ids: ", show notRemovedIds, "\n"
      --   , "Record map: ", show recordMap, "\n"
      --   , "Reverse map: ", show reverseMap, "\n"
      --   , "Removed records: ", show removedRecords, "\n"
      --   , "Repeating ids: ", show repeatingIds, "\n"
      --   , "Missing ids: ", show missingIds, "\n"
      --   ]

      eids :: [(TableName, [[EId]])]
eids = t 'Unresolved -> [(TableName, [[EId]])]
forall (t :: Mode -> *).
KnitTables t =>
t 'Unresolved -> [(TableName, [[EId]])]
gatherTableIds t 'Unresolved
u

      notRemovedIds :: [[Bool]]
notRemovedIds =
        [ [ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
              [ case EId
eid of
                  EId TableName
table TableName
field t
k Dynamic
_ -> Bool -> Bool
not ((TableName
table, TableName
field, t -> TableName
forall a. Show a => a -> TableName
show t
k) (TableName, TableName, TableName)
-> Set (TableName, TableName, TableName) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (TableName, TableName, TableName)
removedRecords)
                  ERemove TableName
_ TableName
_ t
_ Dynamic
_ -> Bool
False
                  EId
_ -> Bool
True
              | EId
eid <- [EId]
record
              ]
          | [EId]
record <- [[EId]]
records
          ]
        | (TableName
_, [[EId]]
records) <- [(TableName, [[EId]])]
eids
        ]

      recordMap :: Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
recordMap = ([(Dynamic, Bool, [EId])]
 -> [(Dynamic, Bool, [EId])] -> [(Dynamic, Bool, [EId])])
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
-> Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [(Dynamic, Bool, [EId])]
-> [(Dynamic, Bool, [EId])] -> [(Dynamic, Bool, [EId])]
forall a. Semigroup a => a -> a -> a
(<>) ([((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
 -> Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])])
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
-> Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
forall a b. (a -> b) -> a -> b
$ [[((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]]
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
forall a. Monoid a => [a] -> a
mconcat
        [ [[((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]]
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
forall a. Monoid a => [a] -> a
mconcat
            [ case EId
eid of
                EId TableName
table TableName
field t
k Dynamic
r -> [((TableName
table, TableName
field, t -> TableName
forall a. Show a => a -> TableName
show t
k), [(Dynamic
r, Bool
True, [EId]
fids)])]
                ERemove TableName
table TableName
field t
k Dynamic
r -> [((TableName
table, TableName
field, t -> TableName
forall a. Show a => a -> TableName
show t
k), [(Dynamic
r, Bool
False, [EId]
fids)])]
                EId
_ -> []
            | EId
eid <- [EId]
record
            ]
        | (TableName
_, [[EId]]
records) <- [(TableName, [[EId]])]
eids
        , [EId]
record <- [[EId]]
records
        , let fids :: [EId]
fids =
                [ EId
fid
                | fid :: EId
fid@(EForeignId TableName
_ TableName
_ t
_) <- [EId]
record
                ]
        ]

      reverseMap :: Map
  (TableName, TableName, TableName)
  (Set (TableName, TableName, TableName))
reverseMap = (Set (TableName, TableName, TableName)
 -> Set (TableName, TableName, TableName)
 -> Set (TableName, TableName, TableName))
-> [((TableName, TableName, TableName),
     Set (TableName, TableName, TableName))]
-> Map
     (TableName, TableName, TableName)
     (Set (TableName, TableName, TableName))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set (TableName, TableName, TableName)
-> Set (TableName, TableName, TableName)
-> Set (TableName, TableName, TableName)
forall a. Semigroup a => a -> a -> a
(<>) ([((TableName, TableName, TableName),
   Set (TableName, TableName, TableName))]
 -> Map
      (TableName, TableName, TableName)
      (Set (TableName, TableName, TableName)))
-> [((TableName, TableName, TableName),
     Set (TableName, TableName, TableName))]
-> Map
     (TableName, TableName, TableName)
     (Set (TableName, TableName, TableName))
forall a b. (a -> b) -> a -> b
$ [[((TableName, TableName, TableName),
   Set (TableName, TableName, TableName))]]
-> [((TableName, TableName, TableName),
     Set (TableName, TableName, TableName))]
forall a. Monoid a => [a] -> a
mconcat
        [ [ ((TableName
ftable, TableName
ffield, t -> TableName
forall a. Show a => a -> TableName
show t
fk), (TableName, TableName, TableName)
-> Set (TableName, TableName, TableName)
forall a. a -> Set a
S.singleton (TableName
table, TableName
field, TableName
k))
          | EForeignId TableName
ftable TableName
ffield t
fk <- [EId]
fids
          ]
        | ((TableName
table, TableName
field, TableName
k), [(Dynamic
_, Bool
_, [EId]
fids)]) <- Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
forall k a. Map k a -> [(k, a)]
M.toList Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
recordMap
        ]

      removedRecords :: Set (TableName, TableName, TableName)
removedRecords = (forall s. ST s (Set (TableName, TableName, TableName)))
-> Set (TableName, TableName, TableName)
forall a. (forall s. ST s a) -> a
ST.runST ((forall s. ST s (Set (TableName, TableName, TableName)))
 -> Set (TableName, TableName, TableName))
-> (forall s. ST s (Set (TableName, TableName, TableName)))
-> Set (TableName, TableName, TableName)
forall a b. (a -> b) -> a -> b
$ do
        HashTable s (TableName, TableName, TableName) Bool
m <- ST s (HashTable s (TableName, TableName, TableName) Bool)
forall s k v. ST s (HashTable s k v)
H.new

        let markRemoved :: (TableName, TableName, TableName) -> ST s ()
markRemoved (TableName
table, TableName
field, TableName
k) = do
              Maybe Bool
v <- HashTable s (TableName, TableName, TableName) Bool
-> (TableName, TableName, TableName) -> ST s (Maybe Bool)
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> ST s (Maybe v)
H.lookup HashTable s (TableName, TableName, TableName) Bool
m (TableName
table, TableName
field, TableName
k)

              case Maybe Bool
v of
                Maybe Bool
Nothing -> do
                  HashTable s (TableName, TableName, TableName) Bool
-> (TableName, TableName, TableName) -> Bool -> ST s ()
forall k s v.
(Eq k, Hashable k) =>
HashTable s k v -> k -> v -> ST s ()
H.insert HashTable s (TableName, TableName, TableName) Bool
m (TableName
table, TableName
field, TableName
k) Bool
True

                  [ST s ()] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
                    [ (TableName, TableName, TableName) -> ST s ()
markRemoved (TableName
ftable, TableName
ffield, TableName
fk)
                    | Just Set (TableName, TableName, TableName)
fids <- [ (TableName, TableName, TableName)
-> Map
     (TableName, TableName, TableName)
     (Set (TableName, TableName, TableName))
-> Maybe (Set (TableName, TableName, TableName))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (TableName
table, TableName
field, TableName
k) Map
  (TableName, TableName, TableName)
  (Set (TableName, TableName, TableName))
reverseMap ]
                    , (TableName
ftable, TableName
ffield, TableName
fk) <- Set (TableName, TableName, TableName)
-> [(TableName, TableName, TableName)]
forall a. Set a -> [a]
S.toList Set (TableName, TableName, TableName)
fids
                    ]
                Just Bool
_ -> () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        [ST s ()] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
          [ (TableName, TableName, TableName) -> ST s ()
markRemoved (TableName, TableName, TableName)
k
          | ((TableName, TableName, TableName)
k, [(Dynamic
_, Bool
False, [EId]
_)]) <- Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
forall k a. Map k a -> [(k, a)]
M.toList Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
recordMap
          ]

        [(TableName, TableName, TableName)]
-> Set (TableName, TableName, TableName)
forall a. Ord a => [a] -> Set a
S.fromList ([(TableName, TableName, TableName)]
 -> Set (TableName, TableName, TableName))
-> ([((TableName, TableName, TableName), Bool)]
    -> [(TableName, TableName, TableName)])
-> [((TableName, TableName, TableName), Bool)]
-> Set (TableName, TableName, TableName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((TableName, TableName, TableName), Bool)
 -> (TableName, TableName, TableName))
-> [((TableName, TableName, TableName), Bool)]
-> [(TableName, TableName, TableName)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TableName, TableName, TableName), Bool)
-> (TableName, TableName, TableName)
forall a b. (a, b) -> a
fst ([((TableName, TableName, TableName), Bool)]
 -> Set (TableName, TableName, TableName))
-> ST s [((TableName, TableName, TableName), Bool)]
-> ST s (Set (TableName, TableName, TableName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashTable s (TableName, TableName, TableName) Bool
-> ST s [((TableName, TableName, TableName), Bool)]
forall (h :: * -> * -> * -> *) s k v.
HashTable h =>
h s k v -> ST s [(k, v)]
HC.toList HashTable s (TableName, TableName, TableName) Bool
m

      repeatingIds :: [(TableName, TableName, TableName)]
repeatingIds = [[(TableName, TableName, TableName)]]
-> [(TableName, TableName, TableName)]
forall a. Monoid a => [a] -> a
mconcat
        [ if [(Dynamic, Bool, [EId])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Dynamic, Bool, [EId])]
records Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
            then [(TableName
table, TableName
field, TableName
k)]
            else []
        | ((TableName
table, TableName
field, TableName
k), [(Dynamic, Bool, [EId])]
records) <- Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
-> [((TableName, TableName, TableName), [(Dynamic, Bool, [EId])])]
forall k a. Map k a -> [(k, a)]
M.toList Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
recordMap
        ]

      missingIds :: [(TableName, TableName, TableName)]
missingIds = [Maybe (TableName, TableName, TableName)]
-> [(TableName, TableName, TableName)]
forall a. [Maybe a] -> [a]
catMaybes
        [ case (TableName, TableName, TableName)
-> Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
-> Maybe [(Dynamic, Bool, [EId])]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (TableName
table, TableName
field, t -> TableName
forall a. Show a => a -> TableName
show t
k) Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
recordMap of
            Maybe [(Dynamic, Bool, [EId])]
Nothing -> (TableName, TableName, TableName)
-> Maybe (TableName, TableName, TableName)
forall a. a -> Maybe a
Just (TableName
table, TableName
field, t -> TableName
forall a. Show a => a -> TableName
show t
k)
            Just [(Dynamic, Bool, [EId])]
_ -> Maybe (TableName, TableName, TableName)
forall a. Maybe a
Nothing
        | (TableName
_, [[EId]]
records) <- [(TableName, [[EId]])]
eids
        , [EId]
record <- [[EId]]
records
        , let fids :: [EId]
fids =
                [ EId
fid
                | fid :: EId
fid@(EForeignId TableName
_ TableName
_ t
_) <- [EId]
record
                ]
        , EForeignId TableName
table TableName
field t
k <- [EId]
fids
        ]

      rsvRecord :: TableName
-> TableName -> TableName -> Maybe [(Dynamic, Bool, [EId])]
rsvRecord TableName
table TableName
field TableName
value = (TableName, TableName, TableName)
-> Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
-> Maybe [(Dynamic, Bool, [EId])]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (TableName
table, TableName
field, TableName
value) Map (TableName, TableName, TableName) [(Dynamic, Bool, [EId])]
recordMap

      rsv :: TableName -> TableName -> TableName -> Dynamic
rsv TableName
table TableName
field TableName
value = case TableName
-> TableName -> TableName -> Maybe [(Dynamic, Bool, [EId])]
rsvRecord TableName
table TableName
field TableName
value of
        Maybe [(Dynamic, Bool, [EId])]
Nothing -> TableName -> TableName -> TableName -> Dynamic
extRsvMap TableName
table TableName
field TableName
value
        Just [(Dynamic
record, Bool
_, [EId]
_)] -> Dynamic
record
        Maybe [(Dynamic, Bool, [EId])]
_ -> TableName -> Dynamic
forall a. HasCallStack => TableName -> a
error TableName
"resolveTables: repeating ids (this is a bug, the consistency check should have caught this)"

  gatherTableIds :: t 'Unresolved -> [(TableName, [[EId]])]
  default gatherTableIds
    :: HasEot (t 'Unresolved)
    => GGatherTableIds (Eot (t 'Unresolved))
    => t 'Unresolved
    -> [(TableName, [[EId]])]
  gatherTableIds = EotG (Rep (t 'Unresolved)) -> [(TableName, [[EId]])]
forall t. GGatherTableIds t => t -> [(TableName, [[EId]])]
gGatherTableIds (EotG (Rep (t 'Unresolved)) -> [(TableName, [[EId]])])
-> (t 'Unresolved -> EotG (Rep (t 'Unresolved)))
-> t 'Unresolved
-> [(TableName, [[EId]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t 'Unresolved -> EotG (Rep (t 'Unresolved))
t 'Unresolved -> Eot (t 'Unresolved)
forall a. HasEot a => a -> Eot a
toEot

-- Expand ----------------------------------------------------------------------

type family ExpandRecord (parent :: Symbol) (record :: *) where
  ExpandRecord parent () = ()
  ExpandRecord parent (Either fields Eot.Void) = ExpandRecord parent fields
  ExpandRecord parent (Eot.Named name (RecordId a), fields) = (Eot.Named name a, ExpandRecord parent fields)
  ExpandRecord parent (Eot.Named name (f (RecordId a)), fields) = (Eot.Named name (f a), ExpandRecord parent fields)
  ExpandRecord parent (a, fields) = ExpandRecord parent fields

type family LookupTableType (table :: Symbol) (eot :: *) :: (((Mode -> *) -> Mode -> *), *) where
  LookupTableType name (Either records Eot.Void) = LookupTableType name records
  LookupTableType name (Eot.Named name [record tables recordMode], records)
    = '(record, ExpandRecord name (Eot (record tables 'Done)))
  LookupTableType name (Eot.Named otherName a, records)
    = LookupTableType name records

  LookupTableType name eot = TypeError ('Text "Can't lookup table type")

type family LookupFieldType (field :: Symbol) (eot :: *) :: * where
  LookupFieldType name (Either records Eot.Void) = LookupFieldType name records
  LookupFieldType name (Eot.Named name (Maybe field), fields) = field
  LookupFieldType name (Eot.Named name field, fields) = field
  LookupFieldType name (Eot.Named otherName field, fields) = LookupFieldType name fields
  LookupFieldType name eot = TypeError ('Text "Can't lookup field type")

-- Table -----------------------------------------------------------------------

type family Table (tables :: Mode -> *) (c :: Mode) table where
  Table tables r table = [table tables r]

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

knit :: KnitTables t => t 'Unresolved -> Either ResolveError (t 'Resolved)
knit :: forall (t :: Mode -> *).
KnitTables t =>
t 'Unresolved -> Either ResolveError (t 'Resolved)
knit = (TableName -> TableName -> TableName -> Dynamic)
-> t 'Unresolved -> Either ResolveError (t 'Resolved)
forall (t :: Mode -> *).
KnitTables t =>
(TableName -> TableName -> TableName -> Dynamic)
-> t 'Unresolved -> Either ResolveError (t 'Resolved)
resolveTables
  (\TableName
tbl TableName
k TableName
v -> TableName -> Dynamic
forall a. HasCallStack => TableName -> a
error (TableName -> Dynamic) -> TableName -> Dynamic
forall a b. (a -> b) -> a -> b
$ TableName
"knit: inconsistent record (this is a bug, the consistency check should have caught this: " TableName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> TableName
show TableName
tbl TableName -> ShowS
forall a. Semigroup a => a -> a -> a
<> TableName
", " TableName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> TableName
show TableName
k TableName -> ShowS
forall a. Semigroup a => a -> a -> a
<> TableName
", " TableName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> TableName
show TableName
v)