{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Graphula.Dependencies
( HasDependencies (..)
, Only (..)
, only
, KeySourceType (..)
, KeySourceTypeM
, KeyForInsert
, KeyRequirementForInsert
, InsertWithPossiblyRequiredKey (..)
, Required (..)
, Optional (..)
, GenerateKey
, generateKey
) where
import Prelude
import Data.Kind (Constraint, Type)
import Data.Proxy (Proxy (..))
import Database.Persist (Entity (..), Key, PersistEntity, PersistEntityBackend)
import Database.Persist.Sql (SqlBackend)
import GHC.Generics (Generic)
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Generics.Eot (Eot, HasEot, fromEot, toEot)
import Graphula.Class (GraphulaSafeToInsert, MonadGraphulaFrontend)
import qualified Graphula.Class as MonadGraphulaFrontend
( MonadGraphulaFrontend (..)
)
import Graphula.Dependencies.Generic
import Graphula.NoConstraint
import Test.QuickCheck.Arbitrary (Arbitrary (..))
import Test.QuickCheck.Gen (Gen)
class HasDependencies a where
type Dependencies a
type Dependencies _a = ()
type KeySource a :: KeySourceType
type KeySource _a = 'SourceDefault
dependsOn :: a -> Dependencies a -> a
default dependsOn
:: ( HasEot a
, HasEot (Dependencies a)
, GHasDependencies
(Proxy a)
(Proxy (Dependencies a))
(Eot a)
(Eot (Dependencies a))
)
=> a
-> Dependencies a
-> a
dependsOn a
a Dependencies a
dependencies =
Eot a -> a
forall a. HasEot a => Eot a -> a
fromEot (Eot a -> a) -> Eot a -> a
forall a b. (a -> b) -> a -> b
$
Proxy a
-> Proxy (Dependencies a)
-> EotG (Rep a)
-> EotG (Rep (Dependencies a))
-> EotG (Rep a)
forall nodeTyProxy depsTyProxy node deps.
GHasDependencies nodeTyProxy depsTyProxy node deps =>
nodeTyProxy -> depsTyProxy -> node -> deps -> node
genericDependsOn
(Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
(Proxy (Dependencies a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Dependencies a))
(a -> Eot a
forall a. HasEot a => a -> Eot a
toEot a
a)
(Dependencies a -> Eot (Dependencies a)
forall a. HasEot a => a -> Eot a
toEot Dependencies a
dependencies)
newtype Only a = Only {forall a. Only a -> a
fromOnly :: a}
deriving stock (Only a -> Only a -> Bool
(Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool) -> Eq (Only a)
forall a. Eq a => Only a -> Only a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Only a -> Only a -> Bool
== :: Only a -> Only a -> Bool
$c/= :: forall a. Eq a => Only a -> Only a -> Bool
/= :: Only a -> Only a -> Bool
Eq, Int -> Only a -> ShowS
[Only a] -> ShowS
Only a -> String
(Int -> Only a -> ShowS)
-> (Only a -> String) -> ([Only a] -> ShowS) -> Show (Only a)
forall a. Show a => Int -> Only a -> ShowS
forall a. Show a => [Only a] -> ShowS
forall a. Show a => Only a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Only a -> ShowS
showsPrec :: Int -> Only a -> ShowS
$cshow :: forall a. Show a => Only a -> String
show :: Only a -> String
$cshowList :: forall a. Show a => [Only a] -> ShowS
showList :: [Only a] -> ShowS
Show, Eq (Only a)
Eq (Only a) =>
(Only a -> Only a -> Ordering)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Bool)
-> (Only a -> Only a -> Only a)
-> (Only a -> Only a -> Only a)
-> Ord (Only a)
Only a -> Only a -> Bool
Only a -> Only a -> Ordering
Only a -> Only a -> Only a
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 a. Ord a => Eq (Only a)
forall a. Ord a => Only a -> Only a -> Bool
forall a. Ord a => Only a -> Only a -> Ordering
forall a. Ord a => Only a -> Only a -> Only a
$ccompare :: forall a. Ord a => Only a -> Only a -> Ordering
compare :: Only a -> Only a -> Ordering
$c< :: forall a. Ord a => Only a -> Only a -> Bool
< :: Only a -> Only a -> Bool
$c<= :: forall a. Ord a => Only a -> Only a -> Bool
<= :: Only a -> Only a -> Bool
$c> :: forall a. Ord a => Only a -> Only a -> Bool
> :: Only a -> Only a -> Bool
$c>= :: forall a. Ord a => Only a -> Only a -> Bool
>= :: Only a -> Only a -> Bool
$cmax :: forall a. Ord a => Only a -> Only a -> Only a
max :: Only a -> Only a -> Only a
$cmin :: forall a. Ord a => Only a -> Only a -> Only a
min :: Only a -> Only a -> Only a
Ord, (forall x. Only a -> Rep (Only a) x)
-> (forall x. Rep (Only a) x -> Only a) -> Generic (Only a)
forall x. Rep (Only a) x -> Only a
forall x. Only a -> Rep (Only a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Only a) x -> Only a
forall a x. Only a -> Rep (Only a) x
$cfrom :: forall a x. Only a -> Rep (Only a) x
from :: forall x. Only a -> Rep (Only a) x
$cto :: forall a x. Rep (Only a) x -> Only a
to :: forall x. Rep (Only a) x -> Only a
Generic, (forall a b. (a -> b) -> Only a -> Only b)
-> (forall a b. a -> Only b -> Only a) -> Functor Only
forall a b. a -> Only b -> Only a
forall a b. (a -> b) -> Only a -> Only b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Only a -> Only b
fmap :: forall a b. (a -> b) -> Only a -> Only b
$c<$ :: forall a b. a -> Only b -> Only a
<$ :: forall a b. a -> Only b -> Only a
Functor, (forall m. Monoid m => Only m -> m)
-> (forall m a. Monoid m => (a -> m) -> Only a -> m)
-> (forall m a. Monoid m => (a -> m) -> Only a -> m)
-> (forall a b. (a -> b -> b) -> b -> Only a -> b)
-> (forall a b. (a -> b -> b) -> b -> Only a -> b)
-> (forall b a. (b -> a -> b) -> b -> Only a -> b)
-> (forall b a. (b -> a -> b) -> b -> Only a -> b)
-> (forall a. (a -> a -> a) -> Only a -> a)
-> (forall a. (a -> a -> a) -> Only a -> a)
-> (forall a. Only a -> [a])
-> (forall a. Only a -> Bool)
-> (forall a. Only a -> Int)
-> (forall a. Eq a => a -> Only a -> Bool)
-> (forall a. Ord a => Only a -> a)
-> (forall a. Ord a => Only a -> a)
-> (forall a. Num a => Only a -> a)
-> (forall a. Num a => Only a -> a)
-> Foldable Only
forall a. Eq a => a -> Only a -> Bool
forall a. Num a => Only a -> a
forall a. Ord a => Only a -> a
forall m. Monoid m => Only m -> m
forall a. Only a -> Bool
forall a. Only a -> Int
forall a. Only a -> [a]
forall a. (a -> a -> a) -> Only a -> a
forall m a. Monoid m => (a -> m) -> Only a -> m
forall b a. (b -> a -> b) -> b -> Only a -> b
forall a b. (a -> b -> b) -> b -> Only a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Only m -> m
fold :: forall m. Monoid m => Only m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Only a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Only a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Only a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Only a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Only a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Only a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Only a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Only a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Only a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Only a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Only a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Only a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Only a -> a
foldr1 :: forall a. (a -> a -> a) -> Only a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Only a -> a
foldl1 :: forall a. (a -> a -> a) -> Only a -> a
$ctoList :: forall a. Only a -> [a]
toList :: forall a. Only a -> [a]
$cnull :: forall a. Only a -> Bool
null :: forall a. Only a -> Bool
$clength :: forall a. Only a -> Int
length :: forall a. Only a -> Int
$celem :: forall a. Eq a => a -> Only a -> Bool
elem :: forall a. Eq a => a -> Only a -> Bool
$cmaximum :: forall a. Ord a => Only a -> a
maximum :: forall a. Ord a => Only a -> a
$cminimum :: forall a. Ord a => Only a -> a
minimum :: forall a. Ord a => Only a -> a
$csum :: forall a. Num a => Only a -> a
sum :: forall a. Num a => Only a -> a
$cproduct :: forall a. Num a => Only a -> a
product :: forall a. Num a => Only a -> a
Foldable, Functor Only
Foldable Only
(Functor Only, Foldable Only) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b))
-> (forall (f :: * -> *) a.
Applicative f =>
Only (f a) -> f (Only a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b))
-> (forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a))
-> Traversable Only
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a)
forall (f :: * -> *) a. Applicative f => Only (f a) -> f (Only a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Only (f a) -> f (Only a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Only (f a) -> f (Only a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
$csequence :: forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a)
sequence :: forall (m :: * -> *) a. Monad m => Only (m a) -> m (Only a)
Traversable)
only :: a -> Only a
only :: forall a. a -> Only a
only = a -> Only a
forall a. a -> Only a
Only
data KeySourceType
=
SourceDefault
|
SourceArbitrary
|
SourceExternal
newtype Required a = Required a
newtype Optional a = Optional (Maybe a)
type family KeySourceTypeM (t :: KeySourceType) :: Type -> Type where
KeySourceTypeM 'SourceExternal = Required
KeySourceTypeM _ = Optional
type KeyRequirementForInsert record = KeySourceTypeM (KeySource record)
type family KeySourceTypeInternalM (t :: KeySourceType) :: Type -> Type where
KeySourceTypeInternalM 'SourceDefault = Optional
KeySourceTypeInternalM _ = Required
type KeyRequirementForInsertInternal record =
KeySourceTypeInternalM (KeySource record)
type KeyForInsert record = KeyRequirementForInsertInternal record (Key record)
class InsertWithPossiblyRequiredKey (requirement :: Type -> Type) where
type InsertConstraint requirement :: Type -> Constraint
insertWithPossiblyRequiredKey
:: ( PersistEntityBackend record ~ SqlBackend
, PersistEntity record
, Monad m
, MonadGraphulaFrontend m
, InsertConstraint requirement record
)
=> requirement (Key record)
-> record
-> m (Maybe (Entity record))
justKey :: key -> requirement key
instance InsertWithPossiblyRequiredKey Optional where
type InsertConstraint Optional = GraphulaSafeToInsert
insertWithPossiblyRequiredKey :: forall record (m :: * -> *).
(PersistEntityBackend record ~ SqlBackend, PersistEntity record,
Monad m, MonadGraphulaFrontend m,
InsertConstraint Optional record) =>
Optional (Key record) -> record -> m (Maybe (Entity record))
insertWithPossiblyRequiredKey (Optional Maybe (Key record)
key) = Maybe (Key record) -> record -> m (Maybe (Entity record))
forall a.
(PersistEntityBackend a ~ SqlBackend, PersistEntity a, Monad m,
GraphulaSafeToInsert a) =>
Maybe (Key a) -> a -> m (Maybe (Entity a))
forall (m :: * -> *) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
PersistEntity a, Monad m, GraphulaSafeToInsert a) =>
Maybe (Key a) -> a -> m (Maybe (Entity a))
MonadGraphulaFrontend.insert Maybe (Key record)
key
justKey :: forall key. key -> Optional key
justKey = Maybe key -> Optional key
forall a. Maybe a -> Optional a
Optional (Maybe key -> Optional key)
-> (key -> Maybe key) -> key -> Optional key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key -> Maybe key
forall a. a -> Maybe a
Just
instance InsertWithPossiblyRequiredKey Required where
type InsertConstraint Required = NoConstraint
insertWithPossiblyRequiredKey :: forall record (m :: * -> *).
(PersistEntityBackend record ~ SqlBackend, PersistEntity record,
Monad m, MonadGraphulaFrontend m,
InsertConstraint Required record) =>
Required (Key record) -> record -> m (Maybe (Entity record))
insertWithPossiblyRequiredKey (Required Key record
key) = Key record -> record -> m (Maybe (Entity record))
forall a.
(PersistEntityBackend a ~ SqlBackend, PersistEntity a, Monad m) =>
Key a -> a -> m (Maybe (Entity a))
forall (m :: * -> *) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
PersistEntity a, Monad m) =>
Key a -> a -> m (Maybe (Entity a))
MonadGraphulaFrontend.insertKeyed Key record
key
justKey :: forall key. key -> Required key
justKey = key -> Required key
forall key. key -> Required key
Required
class
( GenerateKeyInternal (KeySource a) a
, KeyConstraint (KeySource a) a
, InsertWithPossiblyRequiredKey (KeySourceTypeInternalM (KeySource a))
, InsertConstraint (KeySourceTypeInternalM (KeySource a)) a
) =>
GenerateKey a
instance
( GenerateKeyInternal (KeySource a) a
, KeyConstraint (KeySource a) a
, InsertWithPossiblyRequiredKey (KeySourceTypeInternalM (KeySource a))
, InsertConstraint (KeySourceTypeInternalM (KeySource a)) a
)
=> GenerateKey a
class GenerateKeyInternal (s :: KeySourceType) a where
type KeyConstraint s a :: Constraint
generateKey :: KeyConstraint s a => Gen (KeySourceTypeInternalM s (Key a))
instance GenerateKeyInternal 'SourceDefault a where
type KeyConstraint 'SourceDefault a = GraphulaSafeToInsert a
generateKey :: KeyConstraint 'SourceDefault a =>
Gen (KeySourceTypeInternalM 'SourceDefault (Key a))
generateKey = Optional (Key a) -> Gen (Optional (Key a))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Key a) -> Optional (Key a)
forall a. Maybe a -> Optional a
Optional Maybe (Key a)
forall a. Maybe a
Nothing)
instance GenerateKeyInternal 'SourceArbitrary a where
type KeyConstraint 'SourceArbitrary a = Arbitrary (Key a)
generateKey :: KeyConstraint 'SourceArbitrary a =>
Gen (KeySourceTypeInternalM 'SourceArbitrary (Key a))
generateKey = Key a -> Required (Key a)
forall key. key -> Required key
Required (Key a -> Required (Key a))
-> Gen (Key a) -> Gen (Required (Key a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Key a)
forall a. Arbitrary a => Gen a
arbitrary
instance
TypeError
( 'Text "Cannot generate a value of type "
':<>: Quote ('ShowType a)
':<>: 'Text " using "
':<>: Quote ('Text "node")
':<>: 'Text " since"
':$$: 'Text ""
':$$: 'Text " instance HasDependencies "
':<>: 'ShowType a
':<>: 'Text " where"
':$$: 'Text " "
':<>: 'Text "type KeySource "
':<>: 'ShowType a
':<>: 'Text " = "
':<>: 'ShowType 'SourceExternal
':$$: 'Text ""
':$$: 'Text "Possible fixes include:"
':$$: 'Text "• Use "
':<>: Quote ('Text "nodeKeyed")
':<>: 'Text " instead of "
':<>: Quote ('Text "node")
':$$: 'Text "• Change "
':<>: Quote ('Text "KeySource " ':<>: 'ShowType a)
':<>: 'Text " to "
':<>: 'Text "'SourceDefault"
':<>: 'Text " or "
':<>: 'Text "'SourceArbitrary"
)
=> GenerateKeyInternal 'SourceExternal a
where
type KeyConstraint 'SourceExternal a = NoConstraint a
generateKey :: KeyConstraint 'SourceExternal a =>
Gen (KeySourceTypeInternalM 'SourceExternal (Key a))
generateKey = String -> Gen (Required (Key a))
forall a. HasCallStack => String -> a
error String
"unreachable"
type family Quote t where
Quote t = 'Text "‘" ':<>: t ':<>: 'Text "’"