mu-persistent 0.2.0.0 → 0.3.0.0

raw patch · 2 files changed

+34/−29 lines, 2 filesdep ~mu-schemaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mu-schema

API changes (from Hackage documentation)

Files

• mu-persistent.cabal +4/−2
• src/Mu/Adapter/Persistent.hs +30/−27

@@ -1,5 +1,5 @@ name:               mu-persistent-version:            0.2.0.0+version:            0.3.0.0 synopsis:           Utilities for interoperation between Mu and Persistent description:   Please see the <https://github.com/higherkindness/mu-haskell/persistent#readme readme file>.@@ -29,7 +29,9 @@   build-depends:       base          >=4.7   && <5     , monad-logger-    , mu-schema     >=0.2.0+    , mu-schema     >=0.3.0     , persistent     , resourcet     , transformers++  ghc-options:      -Wall

@@ -1,13 +1,13 @@-{-# language DataKinds             #-}-{-# language FlexibleContexts      #-}-{-# language FlexibleInstances     #-}-{-# language GADTs                 #-}-{-# language KindSignatures        #-}-{-# language MultiParamTypeClasses #-}-{-# language ScopedTypeVariables   #-}-{-# language TypeApplications      #-}-{-# language TypeOperators         #-}-{-# language UndecidableInstances  #-}+{-# language DataKinds              #-}+{-# language FlexibleContexts       #-}+{-# language FlexibleInstances      #-}+{-# language FunctionalDependencies #-}+{-# language GADTs                  #-}+{-# language KindSignatures         #-}+{-# language ScopedTypeVariables    #-}+{-# language TypeApplications       #-}+{-# language TypeOperators          #-}+{-# language UndecidableInstances   #-} {-| Description : Utilities for interoperation between Mu and Persistent @@ -28,14 +28,13 @@ import           Control.Monad.Logger import           Control.Monad.Trans.Reader import           Control.Monad.Trans.Resource.Internal-import           Data.Functor.Identity import           Data.Int import           Database.Persist.Sql import           GHC.Generics import           GHC.TypeLits+ import           Mu.Schema import           Mu.Schema.Class-import           Mu.Schema.Interpretation  -- | Wrapper for 'Entity' to be used with @DerivingVia@. --   This wrappers indicates that the identifier is to be found@@ -53,36 +52,40 @@ newtype WithEntityPlainId (ty :: Symbol) (fmap :: Mappings Symbol Symbol) a   = WithEntityPlainId { unWithEntityPlainId :: a } -instance ( Generic t, Applicative w+instance ( Generic t          , (sch :/: sty) ~ 'DRecord name (idArg ': args)          , idArg ~ 'Mu.Schema.FieldDef idArgName ('TPrimitive Int64)          , Rep t ~ D1 dInfo (C1 cInfo f)-         , GToSchemaRecord Identity sch fmap args f+         , GToSchemaRecord sch fmap args f          , ToBackendKey (PersistEntityBackend t) t          , PersistEntityBackend t ~ SqlBackend )-         => ToSchema w sch sty (WithEntityPlainId sty fmap (Entity t)) where+         => ToSchema sch sty (WithEntityPlainId sty fmap (Entity t)) where   toSchema (WithEntityPlainId (Entity key x))-    = TRecord $ Field (pure $ FPrimitive (unSqlBackendKey $ toBackendKey key))-      :* transFieldsNoMaps up (toSchemaRecord (Proxy @fmap) (unM1 $ unM1 $ from x))-    where up :: Identity a -> w a-          up (Identity i) = pure i+    = TRecord $ Field (FPrimitive (unSqlBackendKey $ toBackendKey key))+      :* toSchemaRecord (Proxy @fmap) (unM1 $ unM1 $ from x) -instance ( Generic t, Applicative w+instance ( Generic t          , (sch :/: sty) ~ 'DRecord name (nestedIdArg ': args)-         , nestedIdArg ~ 'Mu.Schema.FieldDef fname ('TSchematic idTy)+         , nestedIdArg ~ 'Mu.Schema.FieldDef fname k+         , ToSchemaKey sch idTy k          , (sch :/: idTy) ~ 'DRecord idName '[idArg]          , idArg ~ 'Mu.Schema.FieldDef idArgName ('TPrimitive Int64)          , Rep t ~ D1 dInfo (C1 cInfo f)-         , GToSchemaRecord Identity sch fmap args f+         , GToSchemaRecord sch fmap args f          , ToBackendKey (PersistEntityBackend t) t          , PersistEntityBackend t ~ SqlBackend )-         => ToSchema w sch sty (WithEntityNestedId sty fmap (Entity t)) where+         => ToSchema sch sty (WithEntityNestedId sty fmap (Entity t)) where   toSchema (WithEntityNestedId (Entity key x))-    = TRecord $ Field (pure $ FSchematic $ TRecord (Field (pure $ FPrimitive key') :* Nil))-      :* transFieldsNoMaps up (toSchemaRecord (Proxy @fmap) (unM1 $ unM1 $ from x))+    = TRecord $ Field (toSchemaKey $ FSchematic $ TRecord (Field (FPrimitive key') :* Nil))+      :* toSchemaRecord (Proxy @fmap) (unM1 $ unM1 $ from x)     where key' = unSqlBackendKey $ toBackendKey key-          up :: Identity a -> w a-          up (Identity i) = pure i++class ToSchemaKey (sch :: Schema') (idTy :: Symbol) t | sch t -> idTy where+  toSchemaKey :: FieldValue sch ('TSchematic idTy) -> FieldValue sch t+instance ToSchemaKey sch idTy ('TSchematic idTy) where+  toSchemaKey = id+instance ToSchemaKey sch idTy t => ToSchemaKey sch idTy ('TOption t) where+  toSchemaKey = FOption . Just . toSchemaKey  -- | Simple utility to execute a database operation --   in any monad which supports 'IO' operations.