{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

-- |
--
-- Graphula is a compact interface for generating data and linking its
-- dependencies. You can use this interface to generate fixtures for automated
-- testing.
--
-- The interface is extensible and supports pluggable front-ends.
--
-- @
-- runGraphIdentity . runGraphulaT $ do
--   -- Compose dependencies at the value level
--   Identity vet <- node @Veterinarian () mempty
--   Identity owner <- node @Owner (only vet) mempty
--   -- TypeApplications is not necessary, but recommended for clarity.
--   Identity dog <- node @Dog (owner, vet) $ edit $ \d -> d { name = "fido" }
-- @
--
module Graphula
  ( -- * Graph Declaration
    node
  , nodeKeyed
  , GraphulaNode
  , GraphulaContext
    -- ** Node options
  , NodeOptions
  , edit
  , ensure
    -- * Declaring Dependencies and key source
  , HasDependencies(..)
  , KeySourceType(..)
    -- * Abstract over how keys are generated using 'SourceDefault' or
    -- 'SourceArbitrary'
  , GenerateKey
    -- ** Singular Dependencies
  , Only(..)
  , only
    -- * The Graph Monad
    -- ** Type Classes
  , MonadGraphula
  , MonadGraphulaBackend(..)
  , MonadGraphulaFrontend(..)
    -- ** Backends
  , runGraphulaT
  , GraphulaT
  , runGraphulaLoggedT
  , runGraphulaLoggedWithFileT
  , GraphulaLoggedT
    -- ** Frontends
  , runGraphulaIdempotentT
  , GraphulaIdempotentT
    -- * Extras
  , NoConstraint
    -- * Exceptions
  , GenerationFailure(..)
  )
where

import Prelude hiding (readFile)

import Control.Monad (guard, (<=<))
import Control.Monad.IO.Unlift
import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)
import Control.Monad.Trans (MonadTrans, lift)
import Data.Foldable (for_, traverse_)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Kind (Constraint, Type)
import Data.Proxy (Proxy(..))
import Data.Semigroup.Generic (gmappend, gmempty)
import Data.Sequence (Seq, empty, (|>))
import Data.Text (Text, pack)
import qualified Data.Text.IO as T
import Data.Traversable (for)
import Data.Typeable (TypeRep, Typeable, typeRep)
import Database.Persist
  ( Entity(..)
  , Key
  , PersistEntity
  , PersistEntityBackend
  , checkUnique
  , delete
  , entityKey
  , get
  , getEntity
  , insertKey
  , insertUnique
  )
import Database.Persist.Sql (SqlBackend)
import Generics.Eot (Eot, HasEot, fromEot, toEot)
import GHC.Generics (Generic)
import Graphula.Arbitrary (generate)
import Graphula.Internal
import System.Directory (createDirectoryIfMissing, getTemporaryDirectory)
import System.IO (Handle, IOMode(..), hClose, openFile)
import System.IO.Temp (openTempFile)
import System.Random (randomIO)
import Test.HUnit.Lang
  (FailureReason(..), HUnitFailure(..), formatFailureReason)
import Test.QuickCheck (Arbitrary(..))
import Test.QuickCheck.Random (QCGen, mkQCGen)
import UnliftIO.Exception
  (Exception, SomeException, bracket, catch, mask, throwIO)

type MonadGraphula m
  = (Monad m, MonadGraphulaBackend m, MonadGraphulaFrontend m, MonadIO m)

-- | A constraint over lists of nodes for 'MonadGraphula', and 'GraphulaNode'.
--
-- Helpful for defining utility functions over many nodes.
--
-- @
-- mkABC :: (GraphulaContext m '[A, B, C]) => m (Node m C)
-- mkABC = do
--   a <- node @A () mempty
--   b <- node @B (only a) mempty
--   node @C (a, b) $ edit $ \n ->
--     n { cc = "spanish" }
-- @
--
type family GraphulaContext (m :: Type -> Type) (ts :: [Type]) :: Constraint where
   GraphulaContext m '[] = MonadGraphula m
   GraphulaContext m (t ': ts) = (GraphulaNode m t, GraphulaContext m ts)

class MonadGraphulaFrontend m where
  insert
    :: (PersistEntityBackend a ~ SqlBackend, PersistEntity a, Monad m)
    => Maybe (Key a) -> a -> m (Maybe (Entity a))
  remove :: (PersistEntityBackend a ~ SqlBackend, PersistEntity a, Monad m) => Key a -> m ()

data Args backend n m = Args
  { Args backend n m -> RunDB backend n m
dbRunner :: RunDB backend n m
  , Args backend n m -> IORef QCGen
gen :: IORef QCGen
  }

newtype RunDB backend n m = RunDB (forall b. ReaderT backend n b -> m b)

newtype GraphulaT n m a =
  GraphulaT { GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
runGraphulaT' :: ReaderT (Args SqlBackend n m) m a }
  deriving newtype (a -> GraphulaT n m b -> GraphulaT n m a
(a -> b) -> GraphulaT n m a -> GraphulaT n m b
(forall a b. (a -> b) -> GraphulaT n m a -> GraphulaT n m b)
-> (forall a b. a -> GraphulaT n m b -> GraphulaT n m a)
-> Functor (GraphulaT n m)
forall a b. a -> GraphulaT n m b -> GraphulaT n m a
forall a b. (a -> b) -> GraphulaT n m a -> GraphulaT n m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaT n m b -> GraphulaT n m a
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaT n m a -> GraphulaT n m b
<$ :: a -> GraphulaT n m b -> GraphulaT n m a
$c<$ :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaT n m b -> GraphulaT n m a
fmap :: (a -> b) -> GraphulaT n m a -> GraphulaT n m b
$cfmap :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaT n m a -> GraphulaT n m b
Functor, Functor (GraphulaT n m)
a -> GraphulaT n m a
Functor (GraphulaT n m)
-> (forall a. a -> GraphulaT n m a)
-> (forall a b.
    GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b)
-> (forall a b c.
    (a -> b -> c)
    -> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c)
-> (forall a b.
    GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b)
-> (forall a b.
    GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a)
-> Applicative (GraphulaT n m)
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
forall a. a -> GraphulaT n m a
forall a b. GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
forall a b. GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall a b.
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
forall a b c.
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (n :: Type -> Type) (m :: Type -> Type).
Applicative m =>
Functor (GraphulaT n m)
forall (n :: Type -> Type) (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaT n m a
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Applicative m =>
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
forall (n :: Type -> Type) (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
<* :: GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
$c<* :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
*> :: GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
$c*> :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
liftA2 :: (a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
$cliftA2 :: forall (n :: Type -> Type) (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
<*> :: GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
$c<*> :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Applicative m =>
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
pure :: a -> GraphulaT n m a
$cpure :: forall (n :: Type -> Type) (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaT n m a
$cp1Applicative :: forall (n :: Type -> Type) (m :: Type -> Type).
Applicative m =>
Functor (GraphulaT n m)
Applicative, Applicative (GraphulaT n m)
a -> GraphulaT n m a
Applicative (GraphulaT n m)
-> (forall a b.
    GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b)
-> (forall a b.
    GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b)
-> (forall a. a -> GraphulaT n m a)
-> Monad (GraphulaT n m)
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall a. a -> GraphulaT n m a
forall a b. GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall a b.
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (n :: Type -> Type) (m :: Type -> Type).
Monad m =>
Applicative (GraphulaT n m)
forall (n :: Type -> Type) (m :: Type -> Type) a.
Monad m =>
a -> GraphulaT n m a
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Monad m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall (n :: Type -> Type) (m :: Type -> Type) a b.
Monad m =>
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
return :: a -> GraphulaT n m a
$creturn :: forall (n :: Type -> Type) (m :: Type -> Type) a.
Monad m =>
a -> GraphulaT n m a
>> :: GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
$c>> :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Monad m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
>>= :: GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
$c>>= :: forall (n :: Type -> Type) (m :: Type -> Type) a b.
Monad m =>
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
$cp1Monad :: forall (n :: Type -> Type) (m :: Type -> Type).
Monad m =>
Applicative (GraphulaT n m)
Monad, Monad (GraphulaT n m)
Monad (GraphulaT n m)
-> (forall a. IO a -> GraphulaT n m a) -> MonadIO (GraphulaT n m)
IO a -> GraphulaT n m a
forall a. IO a -> GraphulaT n m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (n :: Type -> Type) (m :: Type -> Type).
MonadIO m =>
Monad (GraphulaT n m)
forall (n :: Type -> Type) (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaT n m a
liftIO :: IO a -> GraphulaT n m a
$cliftIO :: forall (n :: Type -> Type) (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaT n m a
$cp1MonadIO :: forall (n :: Type -> Type) (m :: Type -> Type).
MonadIO m =>
Monad (GraphulaT n m)
MonadIO, MonadReader (Args SqlBackend n m))

instance MonadTrans (GraphulaT n) where
  lift :: m a -> GraphulaT n m a
lift = ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a
forall (n :: Type -> Type) (m :: Type -> Type) a.
ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a
GraphulaT (ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a)
-> (m a -> ReaderT (Args SqlBackend n m) m a)
-> m a
-> GraphulaT n m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (Args SqlBackend n m) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadUnliftIO m => MonadUnliftIO (GraphulaT n m) where
  {-# INLINE withRunInIO #-}
  withRunInIO :: ((forall a. GraphulaT n m a -> IO a) -> IO b) -> GraphulaT n m b
withRunInIO (forall a. GraphulaT n m a -> IO a) -> IO b
inner =
    ReaderT (Args SqlBackend n m) m b -> GraphulaT n m b
forall (n :: Type -> Type) (m :: Type -> Type) a.
ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a
GraphulaT (ReaderT (Args SqlBackend n m) m b -> GraphulaT n m b)
-> ReaderT (Args SqlBackend n m) m b -> GraphulaT n m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT (Args SqlBackend n m) m a -> IO a) -> IO b)
-> ReaderT (Args SqlBackend n m) m b
forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT (Args SqlBackend n m) m a -> IO a) -> IO b)
 -> ReaderT (Args SqlBackend n m) m b)
-> ((forall a. ReaderT (Args SqlBackend n m) m a -> IO a) -> IO b)
-> ReaderT (Args SqlBackend n m) m b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT (Args SqlBackend n m) m a -> IO a
run -> (forall a. GraphulaT n m a -> IO a) -> IO b
inner ((forall a. GraphulaT n m a -> IO a) -> IO b)
-> (forall a. GraphulaT n m a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ ReaderT (Args SqlBackend n m) m a -> IO a
forall a. ReaderT (Args SqlBackend n m) m a -> IO a
run (ReaderT (Args SqlBackend n m) m a -> IO a)
-> (GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a)
-> GraphulaT n m a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
forall (n :: Type -> Type) (m :: Type -> Type) a.
GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
runGraphulaT'

instance MonadIO m => MonadGraphulaBackend (GraphulaT n m) where
  type Logging (GraphulaT n m) = NoConstraint
  askGen :: GraphulaT n m (IORef QCGen)
askGen = (Args SqlBackend n m -> IORef QCGen) -> GraphulaT n m (IORef QCGen)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks Args SqlBackend n m -> IORef QCGen
forall backend (n :: Type -> Type) (m :: Type -> Type).
Args backend n m -> IORef QCGen
gen
  logNode :: a -> GraphulaT n m ()
logNode a
_ = () -> GraphulaT n m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

instance (MonadIO m, Applicative n, MonadIO n) => MonadGraphulaFrontend (GraphulaT n m) where
  insert :: Maybe (Key a) -> a -> GraphulaT n m (Maybe (Entity a))
insert Maybe (Key a)
mKey a
n = do
    RunDB forall b. ReaderT SqlBackend n b -> m b
runDB <- (Args SqlBackend n m -> RunDB SqlBackend n m)
-> GraphulaT n m (RunDB SqlBackend n m)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks Args SqlBackend n m -> RunDB SqlBackend n m
forall backend (n :: Type -> Type) (m :: Type -> Type).
Args backend n m -> RunDB backend n m
dbRunner
    m (Maybe (Entity a)) -> GraphulaT n m (Maybe (Entity a))
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Entity a)) -> GraphulaT n m (Maybe (Entity a)))
-> (ReaderT SqlBackend n (Maybe (Entity a))
    -> m (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> GraphulaT n m (Maybe (Entity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend n (Maybe (Entity a)) -> m (Maybe (Entity a))
forall b. ReaderT SqlBackend n b -> m b
runDB (ReaderT SqlBackend n (Maybe (Entity a))
 -> GraphulaT n m (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> GraphulaT n m (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ case Maybe (Key a)
mKey of
      Maybe (Key a)
Nothing -> a -> ReaderT SqlBackend n (Maybe (Key a))
forall backend record (m :: Type -> Type).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique a
n ReaderT SqlBackend n (Maybe (Key a))
-> (Maybe (Key a) -> ReaderT SqlBackend n (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Key a)
Nothing -> Maybe (Entity a) -> ReaderT SqlBackend n (Maybe (Entity a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Entity a)
forall a. Maybe a
Nothing
        Just Key a
key -> Key a -> ReaderT SqlBackend n (Maybe (Entity a))
forall e backend (m :: Type -> Type).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
getEntity Key a
key
      Just Key a
key -> do
        Maybe a
existingKey <- Key a -> ReaderT SqlBackend n (Maybe a)
forall backend record (m :: Type -> Type).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key a
key
        Maybe a
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall (m :: Type -> Type) a b.
Applicative m =>
Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing Maybe a
existingKey (ReaderT SqlBackend n (Maybe (Entity a))
 -> ReaderT SqlBackend n (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ do
          Maybe (Unique a)
existingUnique <- a -> ReaderT SqlBackend n (Maybe (Unique a))
forall record backend (m :: Type -> Type).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
checkUnique a
n
          Maybe (Unique a)
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall (m :: Type -> Type) a b.
Applicative m =>
Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing Maybe (Unique a)
existingUnique (ReaderT SqlBackend n (Maybe (Entity a))
 -> ReaderT SqlBackend n (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ do
            Key a -> a -> ReaderT SqlBackend n ()
forall backend record (m :: Type -> Type).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key a
key a
n
            Key a -> ReaderT SqlBackend n (Maybe (Entity a))
forall e backend (m :: Type -> Type).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
getEntity Key a
key

  remove :: Key a -> GraphulaT n m ()
remove Key a
key = do
    RunDB forall b. ReaderT SqlBackend n b -> m b
runDB <- (Args SqlBackend n m -> RunDB SqlBackend n m)
-> GraphulaT n m (RunDB SqlBackend n m)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks Args SqlBackend n m -> RunDB SqlBackend n m
forall backend (n :: Type -> Type) (m :: Type -> Type).
Args backend n m -> RunDB backend n m
dbRunner
    m () -> GraphulaT n m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GraphulaT n m ())
-> (ReaderT SqlBackend n () -> m ())
-> ReaderT SqlBackend n ()
-> GraphulaT n m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend n () -> m ()
forall b. ReaderT SqlBackend n b -> m b
runDB (ReaderT SqlBackend n () -> GraphulaT n m ())
-> ReaderT SqlBackend n () -> GraphulaT n m ()
forall a b. (a -> b) -> a -> b
$ Key a -> ReaderT SqlBackend n ()
forall backend record (m :: Type -> Type).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key a
key

whenNothing :: Applicative m => Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing :: Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing Maybe a
Nothing m (Maybe b)
f = m (Maybe b)
f
whenNothing (Just a
_) m (Maybe b)
_ = Maybe b -> m (Maybe b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing

runGraphulaT
  :: (MonadUnliftIO m)
  => Maybe Int -- ^ Optional seed
  -> (forall b . ReaderT SqlBackend n b -> m b) -- ^ Database runner
  -> GraphulaT n m a
  -> m a
runGraphulaT :: Maybe Int
-> (forall b. ReaderT SqlBackend n b -> m b)
-> GraphulaT n m a
-> m a
runGraphulaT Maybe Int
mSeed forall b. ReaderT SqlBackend n b -> m b
runDB GraphulaT n m a
action = do
  Int
seed <- m Int -> (Int -> m Int) -> Maybe Int -> m Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO Int -> m Int
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO Int
forall a (m :: Type -> Type). (Random a, MonadIO m) => m a
randomIO) Int -> m Int
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Int
mSeed
  IORef QCGen
qcGen <- IO (IORef QCGen) -> m (IORef QCGen)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef QCGen) -> m (IORef QCGen))
-> IO (IORef QCGen) -> m (IORef QCGen)
forall a b. (a -> b) -> a -> b
$ QCGen -> IO (IORef QCGen)
forall a. a -> IO (IORef a)
newIORef (QCGen -> IO (IORef QCGen)) -> QCGen -> IO (IORef QCGen)
forall a b. (a -> b) -> a -> b
$ Int -> QCGen
mkQCGen Int
seed
  ReaderT (Args SqlBackend n m) m a -> Args SqlBackend n m -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
forall (n :: Type -> Type) (m :: Type -> Type) a.
GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
runGraphulaT' GraphulaT n m a
action) (RunDB SqlBackend n m -> IORef QCGen -> Args SqlBackend n m
forall backend (n :: Type -> Type) (m :: Type -> Type).
RunDB backend n m -> IORef QCGen -> Args backend n m
Args ((forall b. ReaderT SqlBackend n b -> m b) -> RunDB SqlBackend n m
forall backend (n :: Type -> Type) (m :: Type -> Type).
(forall b. ReaderT backend n b -> m b) -> RunDB backend n m
RunDB forall b. ReaderT SqlBackend n b -> m b
runDB) IORef QCGen
qcGen)
    m a -> (HUnitFailure -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` Int -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
Int -> HUnitFailure -> m a
logFailingSeed Int
seed

logFailingSeed :: MonadIO m => Int -> HUnitFailure -> m a
logFailingSeed :: Int -> HUnitFailure -> m a
logFailingSeed Int
seed = String -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> HUnitFailure -> m a
rethrowHUnitWith (String
"Graphula with seed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
seed)

newtype GraphulaIdempotentT m a =
  GraphulaIdempotentT {GraphulaIdempotentT m a -> ReaderT (IORef (m ())) m a
runGraphulaIdempotentT' :: ReaderT (IORef (m ())) m a}
  deriving newtype (a -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
(a -> b) -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
(forall a b.
 (a -> b) -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b)
-> (forall a b.
    a -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a)
-> Functor (GraphulaIdempotentT m)
forall a b. a -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
forall a b.
(a -> b) -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
fmap :: (a -> b) -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
Functor, Functor (GraphulaIdempotentT m)
a -> GraphulaIdempotentT m a
Functor (GraphulaIdempotentT m)
-> (forall a. a -> GraphulaIdempotentT m a)
-> (forall a b.
    GraphulaIdempotentT m (a -> b)
    -> GraphulaIdempotentT m a -> GraphulaIdempotentT m b)
-> (forall a b c.
    (a -> b -> c)
    -> GraphulaIdempotentT m a
    -> GraphulaIdempotentT m b
    -> GraphulaIdempotentT m c)
-> (forall a b.
    GraphulaIdempotentT m a
    -> GraphulaIdempotentT m b -> GraphulaIdempotentT m b)
-> (forall a b.
    GraphulaIdempotentT m a
    -> GraphulaIdempotentT m b -> GraphulaIdempotentT m a)
-> Applicative (GraphulaIdempotentT m)
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
GraphulaIdempotentT m (a -> b)
-> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
(a -> b -> c)
-> GraphulaIdempotentT m a
-> GraphulaIdempotentT m b
-> GraphulaIdempotentT m c
forall a. a -> GraphulaIdempotentT m a
forall a b.
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
forall a b.
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
forall a b.
GraphulaIdempotentT m (a -> b)
-> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
forall a b c.
(a -> b -> c)
-> GraphulaIdempotentT m a
-> GraphulaIdempotentT m b
-> GraphulaIdempotentT m c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: Type -> Type).
Applicative m =>
Functor (GraphulaIdempotentT m)
forall (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaIdempotentT m a
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaIdempotentT m (a -> b)
-> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaIdempotentT m a
-> GraphulaIdempotentT m b
-> GraphulaIdempotentT m c
<* :: GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
$c<* :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m a
*> :: GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
$c*> :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
liftA2 :: (a -> b -> c)
-> GraphulaIdempotentT m a
-> GraphulaIdempotentT m b
-> GraphulaIdempotentT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaIdempotentT m a
-> GraphulaIdempotentT m b
-> GraphulaIdempotentT m c
<*> :: GraphulaIdempotentT m (a -> b)
-> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
$c<*> :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaIdempotentT m (a -> b)
-> GraphulaIdempotentT m a -> GraphulaIdempotentT m b
pure :: a -> GraphulaIdempotentT m a
$cpure :: forall (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaIdempotentT m a
$cp1Applicative :: forall (m :: Type -> Type).
Applicative m =>
Functor (GraphulaIdempotentT m)
Applicative, Applicative (GraphulaIdempotentT m)
a -> GraphulaIdempotentT m a
Applicative (GraphulaIdempotentT m)
-> (forall a b.
    GraphulaIdempotentT m a
    -> (a -> GraphulaIdempotentT m b) -> GraphulaIdempotentT m b)
-> (forall a b.
    GraphulaIdempotentT m a
    -> GraphulaIdempotentT m b -> GraphulaIdempotentT m b)
-> (forall a. a -> GraphulaIdempotentT m a)
-> Monad (GraphulaIdempotentT m)
GraphulaIdempotentT m a
-> (a -> GraphulaIdempotentT m b) -> GraphulaIdempotentT m b
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
forall a. a -> GraphulaIdempotentT m a
forall a b.
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
forall a b.
GraphulaIdempotentT m a
-> (a -> GraphulaIdempotentT m b) -> GraphulaIdempotentT m b
forall (m :: Type -> Type).
Monad m =>
Applicative (GraphulaIdempotentT m)
forall (m :: Type -> Type) a.
Monad m =>
a -> GraphulaIdempotentT m a
forall (m :: Type -> Type) a b.
Monad m =>
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
forall (m :: Type -> Type) a b.
Monad m =>
GraphulaIdempotentT m a
-> (a -> GraphulaIdempotentT m b) -> GraphulaIdempotentT m b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> GraphulaIdempotentT m a
$creturn :: forall (m :: Type -> Type) a.
Monad m =>
a -> GraphulaIdempotentT m a
>> :: GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
GraphulaIdempotentT m a
-> GraphulaIdempotentT m b -> GraphulaIdempotentT m b
>>= :: GraphulaIdempotentT m a
-> (a -> GraphulaIdempotentT m b) -> GraphulaIdempotentT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
GraphulaIdempotentT m a
-> (a -> GraphulaIdempotentT m b) -> GraphulaIdempotentT m b
$cp1Monad :: forall (m :: Type -> Type).
Monad m =>
Applicative (GraphulaIdempotentT m)
Monad, Monad (GraphulaIdempotentT m)
Monad (GraphulaIdempotentT m)
-> (forall a. IO a -> GraphulaIdempotentT m a)
-> MonadIO (GraphulaIdempotentT m)
IO a -> GraphulaIdempotentT m a
forall a. IO a -> GraphulaIdempotentT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type).
MonadIO m =>
Monad (GraphulaIdempotentT m)
forall (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaIdempotentT m a
liftIO :: IO a -> GraphulaIdempotentT m a
$cliftIO :: forall (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaIdempotentT m a
$cp1MonadIO :: forall (m :: Type -> Type).
MonadIO m =>
Monad (GraphulaIdempotentT m)
MonadIO, MonadReader (IORef (m ())))

instance MonadUnliftIO m => MonadUnliftIO (GraphulaIdempotentT m) where
  {-# INLINE withRunInIO #-}
  withRunInIO :: ((forall a. GraphulaIdempotentT m a -> IO a) -> IO b)
-> GraphulaIdempotentT m b
withRunInIO (forall a. GraphulaIdempotentT m a -> IO a) -> IO b
inner = ReaderT (IORef (m ())) m b -> GraphulaIdempotentT m b
forall (m :: Type -> Type) a.
ReaderT (IORef (m ())) m a -> GraphulaIdempotentT m a
GraphulaIdempotentT (ReaderT (IORef (m ())) m b -> GraphulaIdempotentT m b)
-> ReaderT (IORef (m ())) m b -> GraphulaIdempotentT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT (IORef (m ())) m a -> IO a) -> IO b)
-> ReaderT (IORef (m ())) m b
forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT (IORef (m ())) m a -> IO a) -> IO b)
 -> ReaderT (IORef (m ())) m b)
-> ((forall a. ReaderT (IORef (m ())) m a -> IO a) -> IO b)
-> ReaderT (IORef (m ())) m b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT (IORef (m ())) m a -> IO a
run ->
    (forall a. GraphulaIdempotentT m a -> IO a) -> IO b
inner ((forall a. GraphulaIdempotentT m a -> IO a) -> IO b)
-> (forall a. GraphulaIdempotentT m a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ ReaderT (IORef (m ())) m a -> IO a
forall a. ReaderT (IORef (m ())) m a -> IO a
run (ReaderT (IORef (m ())) m a -> IO a)
-> (GraphulaIdempotentT m a -> ReaderT (IORef (m ())) m a)
-> GraphulaIdempotentT m a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphulaIdempotentT m a -> ReaderT (IORef (m ())) m a
forall (m :: Type -> Type) a.
GraphulaIdempotentT m a -> ReaderT (IORef (m ())) m a
runGraphulaIdempotentT'

instance MonadTrans GraphulaIdempotentT where
  lift :: m a -> GraphulaIdempotentT m a
lift = ReaderT (IORef (m ())) m a -> GraphulaIdempotentT m a
forall (m :: Type -> Type) a.
ReaderT (IORef (m ())) m a -> GraphulaIdempotentT m a
GraphulaIdempotentT (ReaderT (IORef (m ())) m a -> GraphulaIdempotentT m a)
-> (m a -> ReaderT (IORef (m ())) m a)
-> m a
-> GraphulaIdempotentT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (IORef (m ())) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadIO m, MonadGraphulaFrontend m) => MonadGraphulaFrontend (GraphulaIdempotentT m) where
  insert :: Maybe (Key a) -> a -> GraphulaIdempotentT m (Maybe (Entity a))
insert Maybe (Key a)
mKey a
n = do
    IORef (m ())
finalizersRef <- GraphulaIdempotentT m (IORef (m ()))
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    Maybe (Entity a)
mEnt <- m (Maybe (Entity a)) -> GraphulaIdempotentT m (Maybe (Entity a))
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Entity a)) -> GraphulaIdempotentT m (Maybe (Entity a)))
-> m (Maybe (Entity a)) -> GraphulaIdempotentT m (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ Maybe (Key a) -> a -> m (Maybe (Entity a))
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Maybe (Key a) -> a -> m (Maybe (Entity a))
insert Maybe (Key a)
mKey a
n
    Maybe (Key a)
-> (Key a -> GraphulaIdempotentT m ()) -> GraphulaIdempotentT m ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Entity a -> Key a
forall record. Entity record -> Key record
entityKey (Entity a -> Key a) -> Maybe (Entity a) -> Maybe (Key a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Entity a)
mEnt)
      ((Key a -> GraphulaIdempotentT m ()) -> GraphulaIdempotentT m ())
-> (Key a -> GraphulaIdempotentT m ()) -> GraphulaIdempotentT m ()
forall a b. (a -> b) -> a -> b
$ \Key a
key -> IO () -> GraphulaIdempotentT m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GraphulaIdempotentT m ())
-> IO () -> GraphulaIdempotentT m ()
forall a b. (a -> b) -> a -> b
$ IORef (m ()) -> (m () -> m ()) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (m ())
finalizersRef (Key a -> m ()
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Key a -> m ()
remove Key a
key m () -> m () -> m ()
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>>)
    Maybe (Entity a) -> GraphulaIdempotentT m (Maybe (Entity a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe (Entity a)
mEnt
  remove :: Key a -> GraphulaIdempotentT m ()
remove = m () -> GraphulaIdempotentT m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GraphulaIdempotentT m ())
-> (Key a -> m ()) -> Key a -> GraphulaIdempotentT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> m ()
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Key a -> m ()
remove

-- | A wrapper around a graphula frontend that produces finalizers to remove
-- graph nodes on error or completion. An idempotent graph produces no data
-- outside of its own closure.
--
-- @
-- runGraphIdentity . runGraphulaIdempotentT . runGraphulaT $ do
--   node @PancakeBreakfast () mempty
-- @
--
runGraphulaIdempotentT :: (MonadUnliftIO m) => GraphulaIdempotentT m a -> m a
runGraphulaIdempotentT :: GraphulaIdempotentT m a -> m a
runGraphulaIdempotentT GraphulaIdempotentT m a
action = ((forall a. m a -> m a) -> m a) -> m a
forall (m :: Type -> Type) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m a) -> m a)
-> ((forall a. m a -> m a) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmasked -> do
  IORef (m ())
finalizersRef <- IO (IORef (m ())) -> m (IORef (m ()))
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (m ())) -> m (IORef (m ())))
-> (m () -> IO (IORef (m ()))) -> m () -> m (IORef (m ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> IO (IORef (m ()))
forall a. a -> IO (IORef a)
newIORef (m () -> m (IORef (m ()))) -> m () -> m (IORef (m ()))
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
  a
x <-
    m a -> m a
forall a. m a -> m a
unmasked
    (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ ReaderT (IORef (m ())) m a -> IORef (m ()) -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (GraphulaIdempotentT m a -> ReaderT (IORef (m ())) m a
forall (m :: Type -> Type) a.
GraphulaIdempotentT m a -> ReaderT (IORef (m ())) m a
runGraphulaIdempotentT' GraphulaIdempotentT m a
action) IORef (m ())
finalizersRef
    m a -> (SomeException -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IORef (m ()) -> SomeException -> m a
forall (m :: Type -> Type) a b.
MonadIO m =>
IORef (m a) -> SomeException -> m b
rollbackRethrow IORef (m ())
finalizersRef
  IORef (m ()) -> m a -> m a
forall (m :: Type -> Type) a b.
MonadIO m =>
IORef (m a) -> m b -> m b
rollback IORef (m ())
finalizersRef (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x
 where
  rollback :: MonadIO m => IORef (m a) -> m b -> m b
  rollback :: IORef (m a) -> m b -> m b
rollback IORef (m a)
finalizersRef m b
x = do
    m a
finalizers <- IO (m a) -> m (m a)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (m a) -> m (m a)) -> IO (m a) -> m (m a)
forall a b. (a -> b) -> a -> b
$ IORef (m a) -> IO (m a)
forall a. IORef a -> IO a
readIORef IORef (m a)
finalizersRef
    m a
finalizers m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> m b
x

  rollbackRethrow :: MonadIO m => IORef (m a) -> SomeException -> m b
  rollbackRethrow :: IORef (m a) -> SomeException -> m b
rollbackRethrow IORef (m a)
finalizersRef (SomeException
e :: SomeException) =
    IORef (m a) -> m b -> m b
forall (m :: Type -> Type) a b.
MonadIO m =>
IORef (m a) -> m b -> m b
rollback IORef (m a)
finalizersRef (SomeException -> m b
forall (m :: Type -> Type) e a.
(MonadIO m, Exception e) =>
e -> m a
throwIO SomeException
e)

newtype GraphulaLoggedT m a =
  GraphulaLoggedT {GraphulaLoggedT m a -> ReaderT (IORef (Seq Text)) m a
runGraphulaLoggedT' :: ReaderT (IORef (Seq Text)) m a}
  deriving newtype (a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
(a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
(forall a b.
 (a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b)
-> (forall a b. a -> GraphulaLoggedT m b -> GraphulaLoggedT m a)
-> Functor (GraphulaLoggedT m)
forall a b. a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall a b. (a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
$c<$ :: forall (m :: Type -> Type) a b.
Functor m =>
a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
fmap :: (a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
$cfmap :: forall (m :: Type -> Type) a b.
Functor m =>
(a -> b) -> GraphulaLoggedT m a -> GraphulaLoggedT m b
Functor, Functor (GraphulaLoggedT m)
a -> GraphulaLoggedT m a
Functor (GraphulaLoggedT m)
-> (forall a. a -> GraphulaLoggedT m a)
-> (forall a b.
    GraphulaLoggedT m (a -> b)
    -> GraphulaLoggedT m a -> GraphulaLoggedT m b)
-> (forall a b c.
    (a -> b -> c)
    -> GraphulaLoggedT m a
    -> GraphulaLoggedT m b
    -> GraphulaLoggedT m c)
-> (forall a b.
    GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b)
-> (forall a b.
    GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a)
-> Applicative (GraphulaLoggedT m)
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
forall a. a -> GraphulaLoggedT m a
forall a b.
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall a b.
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall a b.
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall a b c.
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: Type -> Type).
Applicative m =>
Functor (GraphulaLoggedT m)
forall (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
<* :: GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
$c<* :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m a
*> :: GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
$c*> :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
liftA2 :: (a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
$cliftA2 :: forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaLoggedT m a
-> GraphulaLoggedT m b
-> GraphulaLoggedT m c
<*> :: GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
$c<*> :: forall (m :: Type -> Type) a b.
Applicative m =>
GraphulaLoggedT m (a -> b)
-> GraphulaLoggedT m a -> GraphulaLoggedT m b
pure :: a -> GraphulaLoggedT m a
$cpure :: forall (m :: Type -> Type) a.
Applicative m =>
a -> GraphulaLoggedT m a
$cp1Applicative :: forall (m :: Type -> Type).
Applicative m =>
Functor (GraphulaLoggedT m)
Applicative, Applicative (GraphulaLoggedT m)
a -> GraphulaLoggedT m a
Applicative (GraphulaLoggedT m)
-> (forall a b.
    GraphulaLoggedT m a
    -> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b)
-> (forall a b.
    GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b)
-> (forall a. a -> GraphulaLoggedT m a)
-> Monad (GraphulaLoggedT m)
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall a. a -> GraphulaLoggedT m a
forall a b.
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall a b.
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
forall (m :: Type -> Type).
Monad m =>
Applicative (GraphulaLoggedT m)
forall (m :: Type -> Type) a. Monad m => a -> GraphulaLoggedT m a
forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> GraphulaLoggedT m a
$creturn :: forall (m :: Type -> Type) a. Monad m => a -> GraphulaLoggedT m a
>> :: GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
$c>> :: forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a -> GraphulaLoggedT m b -> GraphulaLoggedT m b
>>= :: GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
$c>>= :: forall (m :: Type -> Type) a b.
Monad m =>
GraphulaLoggedT m a
-> (a -> GraphulaLoggedT m b) -> GraphulaLoggedT m b
$cp1Monad :: forall (m :: Type -> Type).
Monad m =>
Applicative (GraphulaLoggedT m)
Monad, Monad (GraphulaLoggedT m)
Monad (GraphulaLoggedT m)
-> (forall a. IO a -> GraphulaLoggedT m a)
-> MonadIO (GraphulaLoggedT m)
IO a -> GraphulaLoggedT m a
forall a. IO a -> GraphulaLoggedT m a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: Type -> Type). MonadIO m => Monad (GraphulaLoggedT m)
forall (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaLoggedT m a
liftIO :: IO a -> GraphulaLoggedT m a
$cliftIO :: forall (m :: Type -> Type) a.
MonadIO m =>
IO a -> GraphulaLoggedT m a
$cp1MonadIO :: forall (m :: Type -> Type). MonadIO m => Monad (GraphulaLoggedT m)
MonadIO, MonadReader (IORef (Seq Text)))

instance MonadTrans GraphulaLoggedT where
  lift :: m a -> GraphulaLoggedT m a
lift = ReaderT (IORef (Seq Text)) m a -> GraphulaLoggedT m a
forall (m :: Type -> Type) a.
ReaderT (IORef (Seq Text)) m a -> GraphulaLoggedT m a
GraphulaLoggedT (ReaderT (IORef (Seq Text)) m a -> GraphulaLoggedT m a)
-> (m a -> ReaderT (IORef (Seq Text)) m a)
-> m a
-> GraphulaLoggedT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (IORef (Seq Text)) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadGraphulaBackend m, MonadIO m) => MonadGraphulaBackend (GraphulaLoggedT m) where
  type Logging (GraphulaLoggedT m) = Show
  askGen :: GraphulaLoggedT m (IORef QCGen)
askGen = m (IORef QCGen) -> GraphulaLoggedT m (IORef QCGen)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (IORef QCGen)
forall (m :: Type -> Type).
MonadGraphulaBackend m =>
m (IORef QCGen)
askGen
  logNode :: a -> GraphulaLoggedT m ()
logNode a
n = do
    IORef (Seq Text)
graphLog <- GraphulaLoggedT m (IORef (Seq Text))
forall r (m :: Type -> Type). MonadReader r m => m r
ask
    IO () -> GraphulaLoggedT m ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GraphulaLoggedT m ()) -> IO () -> GraphulaLoggedT m ()
forall a b. (a -> b) -> a -> b
$ IORef (Seq Text) -> (Seq Text -> Seq Text) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Seq Text)
graphLog (Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
|> String -> Text
pack (a -> String
forall a. Show a => a -> String
show a
n))

instance (Monad m, MonadGraphulaFrontend m) => MonadGraphulaFrontend (GraphulaLoggedT m) where
  insert :: Maybe (Key a) -> a -> GraphulaLoggedT m (Maybe (Entity a))
insert Maybe (Key a)
mKey = m (Maybe (Entity a)) -> GraphulaLoggedT m (Maybe (Entity a))
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Entity a)) -> GraphulaLoggedT m (Maybe (Entity a)))
-> (a -> m (Maybe (Entity a)))
-> a
-> GraphulaLoggedT m (Maybe (Entity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Key a) -> a -> m (Maybe (Entity a))
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Maybe (Key a) -> a -> m (Maybe (Entity a))
insert Maybe (Key a)
mKey
  remove :: Key a -> GraphulaLoggedT m ()
remove = m () -> GraphulaLoggedT m ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GraphulaLoggedT m ())
-> (Key a -> m ()) -> Key a -> GraphulaLoggedT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> m ()
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Key a -> m ()
remove

-- | An extension of 'runGraphulaT' that logs all nodes to a temporary file on
-- 'Exception' and re-throws the 'Exception'.
runGraphulaLoggedT :: MonadUnliftIO m => GraphulaLoggedT m a -> m a
runGraphulaLoggedT :: GraphulaLoggedT m a -> m a
runGraphulaLoggedT = (IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
forall (m :: Type -> Type) a.
MonadUnliftIO m =>
(IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
runGraphulaLoggedUsingT IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
IORef (Seq Text) -> HUnitFailure -> m a
logFailTemp

-- | A variant of 'runGraphulaLoggedT' that accepts a file path to logged to
-- instead of utilizing a temp file.
runGraphulaLoggedWithFileT
  :: MonadUnliftIO m => FilePath -> GraphulaLoggedT m a -> m a
runGraphulaLoggedWithFileT :: String -> GraphulaLoggedT m a -> m a
runGraphulaLoggedWithFileT = (IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
forall (m :: Type -> Type) a.
MonadUnliftIO m =>
(IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
runGraphulaLoggedUsingT ((IORef (Seq Text) -> HUnitFailure -> m a)
 -> GraphulaLoggedT m a -> m a)
-> (String -> IORef (Seq Text) -> HUnitFailure -> m a)
-> String
-> GraphulaLoggedT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> IORef (Seq Text) -> HUnitFailure -> m a
logFailFile

runGraphulaLoggedUsingT
  :: MonadUnliftIO m
  => (IORef (Seq Text) -> HUnitFailure -> m a)
  -> GraphulaLoggedT m a
  -> m a
runGraphulaLoggedUsingT :: (IORef (Seq Text) -> HUnitFailure -> m a)
-> GraphulaLoggedT m a -> m a
runGraphulaLoggedUsingT IORef (Seq Text) -> HUnitFailure -> m a
logFail GraphulaLoggedT m a
action = do
  IORef (Seq Text)
graphLog <- IO (IORef (Seq Text)) -> m (IORef (Seq Text))
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Seq Text)) -> m (IORef (Seq Text)))
-> IO (IORef (Seq Text)) -> m (IORef (Seq Text))
forall a b. (a -> b) -> a -> b
$ Seq Text -> IO (IORef (Seq Text))
forall a. a -> IO (IORef a)
newIORef Seq Text
forall a. Seq a
empty
  ReaderT (IORef (Seq Text)) m a -> IORef (Seq Text) -> m a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (GraphulaLoggedT m a -> ReaderT (IORef (Seq Text)) m a
forall (m :: Type -> Type) a.
GraphulaLoggedT m a -> ReaderT (IORef (Seq Text)) m a
runGraphulaLoggedT' GraphulaLoggedT m a
action) IORef (Seq Text)
graphLog m a -> (HUnitFailure -> m a) -> m a
forall (m :: Type -> Type) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IORef (Seq Text) -> HUnitFailure -> m a
logFail IORef (Seq Text)
graphLog

logFailUsing
  :: MonadIO m
  => IO (FilePath, Handle)
  -> IORef (Seq Text)
  -> HUnitFailure
  -> m a
logFailUsing :: IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
logFailUsing IO (String, Handle)
f IORef (Seq Text)
graphLog HUnitFailure
hunitfailure =
  (String -> HUnitFailure -> m a) -> HUnitFailure -> String -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> HUnitFailure -> m a
rethrowHUnitLogged HUnitFailure
hunitfailure (String -> m a) -> m String -> m a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Seq Text) -> IO (String, Handle) -> m String
forall (m :: Type -> Type).
MonadIO m =>
IORef (Seq Text) -> IO (String, Handle) -> m String
logGraphToHandle IORef (Seq Text)
graphLog IO (String, Handle)
f

logFailFile :: MonadIO m => FilePath -> IORef (Seq Text) -> HUnitFailure -> m a
logFailFile :: String -> IORef (Seq Text) -> HUnitFailure -> m a
logFailFile String
path = IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
logFailUsing ((String
path, ) (Handle -> (String, Handle)) -> IO Handle -> IO (String, Handle)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode)

logFailTemp :: MonadIO m => IORef (Seq Text) -> HUnitFailure -> m a
logFailTemp :: IORef (Seq Text) -> HUnitFailure -> m a
logFailTemp = IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
logFailUsing (IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a)
-> IO (String, Handle) -> IORef (Seq Text) -> HUnitFailure -> m a
forall a b. (a -> b) -> a -> b
$ do
  String
tmp <- (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/graphula") (String -> String) -> IO String -> IO String
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getTemporaryDirectory
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
tmp
  String -> String -> IO (String, Handle)
openTempFile String
tmp String
"fail-.graphula"

logGraphToHandle
  :: (MonadIO m) => IORef (Seq Text) -> IO (FilePath, Handle) -> m FilePath
logGraphToHandle :: IORef (Seq Text) -> IO (String, Handle) -> m String
logGraphToHandle IORef (Seq Text)
graphLog IO (String, Handle)
openHandle = IO String -> m String
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO String)
-> IO String
forall (m :: Type -> Type) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
  IO (String, Handle)
openHandle
  (Handle -> IO ()
hClose (Handle -> IO ())
-> ((String, Handle) -> Handle) -> (String, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Handle) -> Handle
forall a b. (a, b) -> b
snd)
  (\(String
path, Handle
handle) -> do
    Seq Text
nodes <- IORef (Seq Text) -> IO (Seq Text)
forall a. IORef a -> IO a
readIORef IORef (Seq Text)
graphLog
    String
path String -> IO () -> IO String
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ (Text -> IO ()) -> Seq Text -> IO ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> Text -> IO ()
T.hPutStrLn Handle
handle) Seq Text
nodes
  )

rethrowHUnitWith :: MonadIO m => String -> HUnitFailure -> m a
rethrowHUnitWith :: String -> HUnitFailure -> m a
rethrowHUnitWith String
message (HUnitFailure Maybe SrcLoc
l FailureReason
r) =
  HUnitFailure -> m a
forall (m :: Type -> Type) e a.
(MonadIO m, Exception e) =>
e -> m a
throwIO (HUnitFailure -> m a) -> (String -> HUnitFailure) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SrcLoc -> FailureReason -> HUnitFailure
HUnitFailure Maybe SrcLoc
l (FailureReason -> HUnitFailure)
-> (String -> FailureReason) -> String -> HUnitFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FailureReason
Reason (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
message String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FailureReason -> String
formatFailureReason FailureReason
r

rethrowHUnitLogged :: MonadIO m => FilePath -> HUnitFailure -> m a
rethrowHUnitLogged :: String -> HUnitFailure -> m a
rethrowHUnitLogged String
path =
  String -> HUnitFailure -> m a
forall (m :: Type -> Type) a.
MonadIO m =>
String -> HUnitFailure -> m a
rethrowHUnitWith (String
"Graph dumped in temp file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path)

class HasDependencies a where
  -- | A data type that contains values to be injected into @a@ via
  -- `dependsOn`. The default generic implementation of `dependsOn` supports
  -- tuples as 'Dependencies'. Data types with a single dependency should use
  -- 'Only' as a 1-tuple.
  --
  -- note: The contents of a tuple must be ordered as they appear in the
  -- definition of @a@.
  type Dependencies a
  type instance Dependencies _a = ()

  -- | Specify the method for resolving a node's key
  --
  -- This can be
  --
  -- @
  -- 'SourceDefault   -- automatically generate keys from the database
  -- 'SourceArbitrary -- automatically generate keys using @'Arbitrary'@
  -- 'SourceExternal  -- explicitly pass a key using @'nodeKeyed'@
  -- @
  --
  -- Most types will use @'SourceDefault'@ or @'SourceArbitrary'@. Only
  -- use @'SourceExternal'@ if the key for a value is always defined
  -- externally.
  --
  type KeySource a :: KeySourceType
  type instance KeySource _a = 'SourceDefault

  -- | Assign values from the 'Dependencies' collection to a value.
  -- 'dependsOn' must be an idempotent operation.
  --
  -- Law:
  --
  -- prop> (\x d -> x `dependsOn` d `dependsOn` d) = dependsOn
  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)

-- | Abstract over how keys are generated using @'SourceDefault'@ or @'SourceArbitrary'@
class (GenerateKeyInternal (KeySource a) a, KeyConstraint (KeySource a) a) => GenerateKey a
instance (GenerateKeyInternal (KeySource a) a, KeyConstraint (KeySource a) a) => GenerateKey a

data GenerationFailure
  = GenerationFailureMaxAttemptsToConstrain TypeRep
  -- ^ Could not satisfy constraints defined using @'ensure'@
  | GenerationFailureMaxAttemptsToInsert TypeRep
  -- ^ Could not satisfy database constraints on insert
  deriving stock (Int -> GenerationFailure -> String -> String
[GenerationFailure] -> String -> String
GenerationFailure -> String
(Int -> GenerationFailure -> String -> String)
-> (GenerationFailure -> String)
-> ([GenerationFailure] -> String -> String)
-> Show GenerationFailure
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GenerationFailure] -> String -> String
$cshowList :: [GenerationFailure] -> String -> String
show :: GenerationFailure -> String
$cshow :: GenerationFailure -> String
showsPrec :: Int -> GenerationFailure -> String -> String
$cshowsPrec :: Int -> GenerationFailure -> String -> String
Show, GenerationFailure -> GenerationFailure -> Bool
(GenerationFailure -> GenerationFailure -> Bool)
-> (GenerationFailure -> GenerationFailure -> Bool)
-> Eq GenerationFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenerationFailure -> GenerationFailure -> Bool
$c/= :: GenerationFailure -> GenerationFailure -> Bool
== :: GenerationFailure -> GenerationFailure -> Bool
$c== :: GenerationFailure -> GenerationFailure -> Bool
Eq)

instance Exception GenerationFailure

type GraphulaNode m a
  = ( HasDependencies a
    , Logging m a
    , PersistEntityBackend a ~ SqlBackend
    , PersistEntity a
    , Typeable a
    , Arbitrary a
    )

{-|
  Generate a value with data dependencies. This leverages
  'HasDependencies' to insert the specified data in the generated value. All
  dependency data is inserted after any editing operations.

  > node @Dog (ownerId, veterinarianId) mempty
  > node @Dog (ownerId, veterinarianId) $ edit $ \dog ->
  >   dog {name = "fido"}

  A value that has an externally managed key must use @'nodeKeyed'@ instead.
-}
node
  :: forall a m
   . (GraphulaContext m '[a], GenerateKey a)
  => Dependencies a
  -> NodeOptions a
  -> m (Entity a)
node :: Dependencies a -> NodeOptions a -> m (Entity a)
node = m (Maybe (Key a))
-> Dependencies a -> NodeOptions a -> m (Entity a)
forall a (m :: Type -> Type).
GraphulaContext m '[a] =>
m (Maybe (Key a))
-> Dependencies a -> NodeOptions a -> m (Entity a)
nodeImpl (m (Maybe (Key a))
 -> Dependencies a -> NodeOptions a -> m (Entity a))
-> m (Maybe (Key a))
-> Dependencies a
-> NodeOptions a
-> m (Entity a)
forall a b. (a -> b) -> a -> b
$ Gen (Maybe (Key a)) -> m (Maybe (Key a))
forall (m :: Type -> Type) a.
(MonadIO m, MonadGraphulaBackend m) =>
Gen a -> m a
generate (Gen (Maybe (Key a)) -> m (Maybe (Key a)))
-> Gen (Maybe (Key a)) -> m (Maybe (Key a))
forall a b. (a -> b) -> a -> b
$ (GenerateKeyInternal (KeySource a) a,
 KeyConstraint (KeySource a) a) =>
Gen (Maybe (Key a))
forall (s :: KeySourceType) a.
(GenerateKeyInternal s a, KeyConstraint s a) =>
Gen (Maybe (Key a))
generateKey @(KeySource a) @a

{-|
  Generate a value with data dependencies given an externally managed
  key. This leverages 'HasDependencies' to insert the specified data
  in the generated value. All dependency data is inserted after any
  editing operations.

  > someKey <- generateKey
  > node @Cat someKey (ownerId, veterinarianId) mempty
  > anotherKey <- generateKey
  > node @Cat anotherKey (ownerId, veterinarianId) $ edit $ \cat ->
  >   cat {name = "milo"}

  A value that has an automatically managed key may use @'node'@ instead.
-}
nodeKeyed
  :: forall a m
   . GraphulaContext m '[a]
  => Key a
  -> Dependencies a
  -> NodeOptions a
  -> m (Entity a)
nodeKeyed :: Key a -> Dependencies a -> NodeOptions a -> m (Entity a)
nodeKeyed Key a
key = m (Maybe (Key a))
-> Dependencies a -> NodeOptions a -> m (Entity a)
forall a (m :: Type -> Type).
GraphulaContext m '[a] =>
m (Maybe (Key a))
-> Dependencies a -> NodeOptions a -> m (Entity a)
nodeImpl (m (Maybe (Key a))
 -> Dependencies a -> NodeOptions a -> m (Entity a))
-> m (Maybe (Key a))
-> Dependencies a
-> NodeOptions a
-> m (Entity a)
forall a b. (a -> b) -> a -> b
$ Maybe (Key a) -> m (Maybe (Key a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Key a) -> m (Maybe (Key a)))
-> Maybe (Key a) -> m (Maybe (Key a))
forall a b. (a -> b) -> a -> b
$ Key a -> Maybe (Key a)
forall a. a -> Maybe a
Just Key a
key

nodeImpl
  :: forall a m
   . GraphulaContext m '[a]
  => m (Maybe (Key a))
  -> Dependencies a
  -> NodeOptions a
  -> m (Entity a)
nodeImpl :: m (Maybe (Key a))
-> Dependencies a -> NodeOptions a -> m (Entity a)
nodeImpl m (Maybe (Key a))
genKey Dependencies a
dependencies NodeOptions {Kendo Maybe a
nodeOptionsEdit :: forall a. NodeOptions a -> Kendo Maybe a
nodeOptionsEdit :: Kendo Maybe a
..} = Int -> Int -> m (Maybe (Maybe (Key a), a)) -> m (Entity a)
forall a (m :: Type -> Type).
GraphulaContext m '[a] =>
Int -> Int -> m (Maybe (Maybe (Key a), a)) -> m (Entity a)
attempt Int
100 Int
10 (m (Maybe (Maybe (Key a), a)) -> m (Entity a))
-> m (Maybe (Maybe (Key a), a)) -> m (Entity a)
forall a b. (a -> b) -> a -> b
$ do
  a
initial <- Gen a -> m a
forall (m :: Type -> Type) a.
(MonadIO m, MonadGraphulaBackend m) =>
Gen a -> m a
generate Gen a
forall a. Arbitrary a => Gen a
arbitrary
  Maybe a
-> (a -> m (Maybe (Key a), a)) -> m (Maybe (Maybe (Key a), a))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Kendo Maybe a -> a -> Maybe a
forall (m :: Type -> Type) a. Kendo m a -> a -> m a
appKendo Kendo Maybe a
nodeOptionsEdit a
initial) ((a -> m (Maybe (Key a), a)) -> m (Maybe (Maybe (Key a), a)))
-> (a -> m (Maybe (Key a), a)) -> m (Maybe (Maybe (Key a), a))
forall a b. (a -> b) -> a -> b
$ \a
edited -> do
    let hydrated :: a
hydrated = a
edited a -> Dependencies a -> a
forall a. HasDependencies a => a -> Dependencies a -> a
`dependsOn` Dependencies a
dependencies
    a -> m ()
forall (m :: Type -> Type) a.
(MonadGraphulaBackend m, Logging m a) =>
a -> m ()
logNode a
hydrated
    Maybe (Key a)
mKey <- m (Maybe (Key a))
genKey
    (Maybe (Key a), a) -> m (Maybe (Key a), a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Key a)
mKey, a
hydrated)

-- | Modify the node after it's been generated
--
-- @
-- a <- node @A () $ edit $ \a -> a { someField = True }
-- @
--
edit :: (a -> a) -> NodeOptions a
edit :: (a -> a) -> NodeOptions a
edit a -> a
f = NodeOptions Any
forall a. Monoid a => a
mempty { nodeOptionsEdit :: Kendo Maybe a
nodeOptionsEdit = (a -> Maybe a) -> Kendo Maybe a
forall (m :: Type -> Type) a. (a -> m a) -> Kendo m a
Kendo ((a -> Maybe a) -> Kendo Maybe a)
-> (a -> Maybe a) -> Kendo Maybe a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f }

-- | Require a node to satisfy the specified predicate
--
-- @
-- a <- node @A () $ ensure $ (== True) . someField
-- @
--
ensure :: (a -> Bool) -> NodeOptions a
ensure :: (a -> Bool) -> NodeOptions a
ensure a -> Bool
f = NodeOptions Any
forall a. Monoid a => a
mempty { nodeOptionsEdit :: Kendo Maybe a
nodeOptionsEdit = (a -> Maybe a) -> Kendo Maybe a
forall (m :: Type -> Type) a. (a -> m a) -> Kendo m a
Kendo ((a -> Maybe a) -> Kendo Maybe a)
-> (a -> Maybe a) -> Kendo Maybe a
forall a b. (a -> b) -> a -> b
$ \a
a -> a
a a -> Maybe () -> Maybe a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (a -> Bool
f a
a) }

-- | Options for generating an individual node
--
-- @'NodeOptions'@ can be created and combined with the Monoidal
-- operations @'(<>)'@ and @'mempty'@.
--
-- @
-- a1 <- node @A () mempty
-- a2 <- node @A () $ edit $ \a -> a { someField = True }
-- a3 <- node @A () $ ensure $ (== True) . someField
-- @
--
newtype NodeOptions a = NodeOptions
  { NodeOptions a -> Kendo Maybe a
nodeOptionsEdit :: Kendo Maybe a
  }
  deriving stock (forall x. NodeOptions a -> Rep (NodeOptions a) x)
-> (forall x. Rep (NodeOptions a) x -> NodeOptions a)
-> Generic (NodeOptions a)
forall x. Rep (NodeOptions a) x -> NodeOptions a
forall x. NodeOptions a -> Rep (NodeOptions a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NodeOptions a) x -> NodeOptions a
forall a x. NodeOptions a -> Rep (NodeOptions a) x
$cto :: forall a x. Rep (NodeOptions a) x -> NodeOptions a
$cfrom :: forall a x. NodeOptions a -> Rep (NodeOptions a) x
Generic

instance Semigroup (NodeOptions a) where
  <> :: NodeOptions a -> NodeOptions a -> NodeOptions a
(<>) = NodeOptions a -> NodeOptions a -> NodeOptions a
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend
  {-# INLINE (<>) #-}

instance Monoid (NodeOptions a) where
  mempty :: NodeOptions a
mempty = NodeOptions a
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  {-# INLINE mempty #-}

-- | Like @'Endo'@ but uses Kliesli composition
newtype Kendo m a = Kendo { Kendo m a -> a -> m a
appKendo :: a -> m a }
    deriving stock (forall x. Kendo m a -> Rep (Kendo m a) x)
-> (forall x. Rep (Kendo m a) x -> Kendo m a)
-> Generic (Kendo m a)
forall x. Rep (Kendo m a) x -> Kendo m a
forall x. Kendo m a -> Rep (Kendo m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: Type -> Type) a x. Rep (Kendo m a) x -> Kendo m a
forall (m :: Type -> Type) a x. Kendo m a -> Rep (Kendo m a) x
$cto :: forall (m :: Type -> Type) a x. Rep (Kendo m a) x -> Kendo m a
$cfrom :: forall (m :: Type -> Type) a x. Kendo m a -> Rep (Kendo m a) x
Generic

instance Monad m => Semigroup (Kendo m a) where
  Kendo a -> m a
f <> :: Kendo m a -> Kendo m a -> Kendo m a
<> Kendo a -> m a
g = (a -> m a) -> Kendo m a
forall (m :: Type -> Type) a. (a -> m a) -> Kendo m a
Kendo ((a -> m a) -> Kendo m a) -> (a -> m a) -> Kendo m a
forall a b. (a -> b) -> a -> b
$ a -> m a
f (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: Type -> Type) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m a
g
  {-# INLINE (<>) #-}

instance Monad m => Monoid (Kendo m a) where
  mempty :: Kendo m a
mempty = (a -> m a) -> Kendo m a
forall (m :: Type -> Type) a. (a -> m a) -> Kendo m a
Kendo a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
  {-# INLINE mempty #-}

attempt
  :: forall a m
   . (GraphulaContext m '[a])
  => Int
  -> Int
  -> m (Maybe (Maybe (Key a), a))
  -> m (Entity a)
attempt :: Int -> Int -> m (Maybe (Maybe (Key a), a)) -> m (Entity a)
attempt Int
maxEdits Int
maxInserts m (Maybe (Maybe (Key a), a))
source = Int -> Int -> m (Entity a)
loop Int
0 Int
0
 where
  loop :: Int -> Int -> m (Entity a)
  loop :: Int -> Int -> m (Entity a)
loop Int
numEdits Int
numInserts
    | Int
numEdits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxEdits = (TypeRep -> GenerationFailure) -> m (Entity a)
die TypeRep -> GenerationFailure
GenerationFailureMaxAttemptsToConstrain
    | Int
numInserts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxInserts = (TypeRep -> GenerationFailure) -> m (Entity a)
die TypeRep -> GenerationFailure
GenerationFailureMaxAttemptsToInsert
    | Bool
otherwise = m (Maybe (Maybe (Key a), a))
source m (Maybe (Maybe (Key a), a))
-> (Maybe (Maybe (Key a), a) -> m (Entity a)) -> m (Entity a)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (Maybe (Key a), a)
Nothing -> Int -> Int -> m (Entity a)
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
numEdits) Int
numInserts
      --               ^ failed to edit, only increments this
      Just (Maybe (Key a)
mKey, a
value) -> Maybe (Key a) -> a -> m (Maybe (Entity a))
forall (m :: Type -> Type) a.
(MonadGraphulaFrontend m, PersistEntityBackend a ~ SqlBackend,
 PersistEntity a, Monad m) =>
Maybe (Key a) -> a -> m (Maybe (Entity a))
insert Maybe (Key a)
mKey a
value m (Maybe (Entity a))
-> (Maybe (Entity a) -> m (Entity a)) -> m (Entity a)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Entity a)
Nothing -> Int -> Int -> m (Entity a)
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
numEdits) (Int -> Int
forall a. Enum a => a -> a
succ Int
numInserts)
        --               ^ failed to insert, but also increments this
        Just Entity a
a -> Entity a -> m (Entity a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Entity a
a

  die :: (TypeRep -> GenerationFailure) -> m (Entity a)
  die :: (TypeRep -> GenerationFailure) -> m (Entity a)
die TypeRep -> GenerationFailure
e = GenerationFailure -> m (Entity a)
forall (m :: Type -> Type) e a.
(MonadIO m, Exception e) =>
e -> m a
throwIO (GenerationFailure -> m (Entity a))
-> GenerationFailure -> m (Entity a)
forall a b. (a -> b) -> a -> b
$ TypeRep -> GenerationFailure
e (TypeRep -> GenerationFailure) -> TypeRep -> GenerationFailure
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

-- | For entities that only have singular 'Dependencies'
newtype Only a = Only { 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
/= :: Only a -> Only a -> Bool
$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
Eq, Int -> Only a -> String -> String
[Only a] -> String -> String
Only a -> String
(Int -> Only a -> String -> String)
-> (Only a -> String)
-> ([Only a] -> String -> String)
-> Show (Only a)
forall a. Show a => Int -> Only a -> String -> String
forall a. Show a => [Only a] -> String -> String
forall a. Show a => Only a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Only a] -> String -> String
$cshowList :: forall a. Show a => [Only a] -> String -> String
show :: Only a -> String
$cshow :: forall a. Show a => Only a -> String
showsPrec :: Int -> Only a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Only a -> String -> String
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
min :: Only a -> Only a -> Only a
$cmin :: forall a. Ord a => Only a -> Only a -> Only a
max :: Only a -> Only a -> Only a
$cmax :: forall a. Ord a => Only a -> Only a -> Only a
>= :: 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
$c< :: forall a. Ord a => Only a -> Only a -> Bool
compare :: Only a -> Only a -> Ordering
$ccompare :: forall a. Ord a => Only a -> Only a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (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
$cto :: forall a x. Rep (Only a) x -> Only a
$cfrom :: forall a x. Only a -> Rep (Only a) x
Generic, a -> Only b -> Only a
(a -> b) -> Only a -> Only b
(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 :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Only b -> Only a
$c<$ :: forall a b. a -> Only b -> Only a
fmap :: (a -> b) -> Only a -> Only b
$cfmap :: forall a b. (a -> b) -> Only a -> Only b
Functor, Only a -> Bool
(a -> m) -> Only a -> m
(a -> b -> b) -> b -> Only a -> b
(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 :: Type -> Type).
(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
product :: Only a -> a
$cproduct :: forall a. Num a => Only a -> a
sum :: Only a -> a
$csum :: forall a. Num a => Only a -> a
minimum :: Only a -> a
$cminimum :: forall a. Ord a => Only a -> a
maximum :: Only a -> a
$cmaximum :: forall a. Ord a => Only a -> a
elem :: a -> Only a -> Bool
$celem :: forall a. Eq a => a -> Only a -> Bool
length :: Only a -> Int
$clength :: forall a. Only a -> Int
null :: Only a -> Bool
$cnull :: forall a. Only a -> Bool
toList :: Only a -> [a]
$ctoList :: forall a. Only a -> [a]
foldl1 :: (a -> a -> a) -> Only a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Only a -> a
foldr1 :: (a -> a -> a) -> Only a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Only a -> a
foldl' :: (b -> a -> b) -> b -> Only a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Only a -> b
foldl :: (b -> a -> b) -> b -> Only a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Only a -> b
foldr' :: (a -> b -> b) -> b -> Only a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Only a -> b
foldr :: (a -> b -> b) -> b -> Only a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Only a -> b
foldMap' :: (a -> m) -> Only a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Only a -> m
foldMap :: (a -> m) -> Only a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Only a -> m
fold :: Only m -> m
$cfold :: forall m. Monoid m => Only m -> m
Foldable, Functor Only
Foldable Only
Functor Only
-> Foldable Only
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> Only a -> f (Only b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    Only (f a) -> f (Only a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> Only a -> m (Only b))
-> (forall (m :: Type -> Type) a.
    Monad m =>
    Only (m a) -> m (Only a))
-> Traversable Only
(a -> f b) -> Only a -> f (Only b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
    Applicative f =>
    t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a. Monad m => Only (m a) -> m (Only a)
forall (f :: Type -> Type) a.
Applicative f =>
Only (f a) -> f (Only a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
sequence :: Only (m a) -> m (Only a)
$csequence :: forall (m :: Type -> Type) a. Monad m => Only (m a) -> m (Only a)
mapM :: (a -> m b) -> Only a -> m (Only b)
$cmapM :: forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> Only a -> m (Only b)
sequenceA :: Only (f a) -> f (Only a)
$csequenceA :: forall (f :: Type -> Type) a.
Applicative f =>
Only (f a) -> f (Only a)
traverse :: (a -> f b) -> Only a -> f (Only b)
$ctraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Only a -> f (Only b)
$cp2Traversable :: Foldable Only
$cp1Traversable :: Functor Only
Traversable)

only :: a -> Only a
only :: a -> Only a
only = a -> Only a
forall a. a -> Only a
Only