composite-base 0.4.2.0 → 0.5.0.0

raw patch · 5 files changed

+116/−13 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• composite-base.cabal +6/−4
• src/Composite/CoRecord.hs +15/−2
• src/Composite/Record.hs +30/−1
• src/Control/Monad/Composite/Context.hs +65/−1
• test/RecordSpec.hs +0/−5

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.17.0.+-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack  name:           composite-base-version:        0.4.2.0+version:        0.5.0.0 synopsis:       Shared utilities for composite-* packages. description:    Shared helpers for the various composite packages. category:       Records@@ -23,11 +23,11 @@   build-depends:       base >= 4.7 && < 5     , exceptions-    , template-haskell     , lens     , monad-control     , mtl     , profunctors+    , template-haskell     , text     , transformers     , transformers-base@@ -38,6 +38,8 @@       Composite.Record       Composite.TH       Control.Monad.Composite.Context+  other-modules:+      Paths_composite_base   default-language: Haskell2010  test-suite composite-base-test@@ -50,11 +52,11 @@   build-depends:       base >= 4.7 && < 5     , exceptions-    , template-haskell     , lens     , monad-control     , mtl     , profunctors+    , template-haskell     , text     , transformers     , transformers-base

@@ -8,11 +8,12 @@ import Control.Lens (Prism', prism') import Data.Functor.Identity (Identity(Identity), runIdentity) import Data.Kind (Constraint)+import Data.Maybe (fromMaybe) import Data.Profunctor (dimap) import Data.Proxy (Proxy(Proxy))-import Data.Vinyl (Dict(Dict), Rec((:&), RNil), RecApplicative, RElem, recordToList, reifyConstraint, rmap, rpure)+import Data.Vinyl.Core (Dict(Dict), Rec((:&), RNil), RecApplicative, recordToList, reifyConstraint, rmap, rpure) import Data.Vinyl.Functor (Compose(Compose, getCompose), Const(Const), (:.))-import Data.Vinyl.Lens (type (∈), rget, rput)+import Data.Vinyl.Lens (RElem, type (∈), type (⊆), rget, rput, rreplace) import Data.Vinyl.TypeLevel (RecAll, RIndex)  -- FIXME? replace with int-index/union or at least lift ideas from there. This encoding is awkward to work with and not compositional.@@ -214,3 +215,15 @@ matchField :: RecApplicative (r ': rs) => Field (r ': rs) -> Cases (r ': rs) b -> b matchField = flip foldField {-# INLINE matchField #-}++-- |Widen a @'CoRec' f rs@ to a @'CoRec' f ss@ given that @rs ⊆ ss@.+widenCoRec :: (FoldRec ss ss, RecApplicative rs, RecApplicative ss, rs ⊆ ss) => CoRec f rs -> CoRec f ss+widenCoRec r =+  fromMaybe (error "widenCoRec should be provably total, isn't") $+    firstCoRec (rreplace (coRecToRec r) (rpure $ Compose Nothing))++-- |Widen a @'Field' rs@ to a @'Field' ss@ given that @rs ⊆ ss@.+widenField :: (FoldRec ss ss, RecApplicative rs, RecApplicative ss, rs ⊆ ss) => Field rs -> Field ss+widenField r =+  fromMaybe (error "widenField should be provably total, isn't") $+    firstField (rreplace (fieldToRec r) (rpure Nothing))

@@ -2,7 +2,7 @@ module Composite.Record   ( Rec((:&), RNil), Record   , pattern (:*:), pattern (:^:)-  , (:->)(Val, getVal), valName, valWithName+  , (:->)(Val, getVal), val, valName, valWithName   , RElem, rlens, rlens'   , AllHave, HasInstances, ValuesAllHave   , zipRecsWith, reifyDicts, recordToNonEmpty@@ -80,6 +80,35 @@  instance forall (s :: Symbol) a. (KnownSymbol s, Show a) => Show (s :-> a) where   showsPrec p (Val a) = ((symbolVal (Proxy :: Proxy s) ++ " :-> ") ++) . showsPrec p a++-- |Convenience function to make an @'Identity' (s ':->' a)@ with a particular symbol, used for named field construction.+--+-- For example:+--+-- @+--   type FFoo = "foo" :-> Int+--   type FBar = "bar" :-> String+--   type FBaz = "baz" :-> Double+--   type MyRecord = [FFoo, FBar, FBaz]+--+--   myRecord1 :: Record MyRecord+--   myRecord1+--     =  val @"foo" 123+--     :& val @"bar" "foobar"+--     :& val @"baz" 3.21+--     :& RNil+--+--   myRecord2 :: Record MyRecord+--   myRecord2 = rcast+--     $  val @"baz" 3.21+--     :& val @"foo" 123+--     :& val @"bar" "foobar"+--     :& RNil+-- @+--+-- In this example, both @myRecord1@ and @myRecord2@ have the same value, since 'Data.Vinyl.Lens.rcast' can reorder records.+val :: forall (s :: Symbol) a. a -> Identity (s :-> a)+val = Identity . Val @s  -- |Reflect the type level name of a named value @s :-> a@ to a @Text@. For example, given @"foo" :-> Int@, yields @"foo" :: Text@ valName :: forall s a. KnownSymbol s => s :-> a -> Text

@@ -3,7 +3,7 @@  -- |Module with a `ReaderT` style monad specialized to holding a record. module Control.Monad.Composite.Context-  ( ContextT(ContextT, runContextT), withContext, mapContextT+  ( ContextT(ContextT, runContextT), runInContext, withContext, mapContextT   , MonadContext(askContext, localContext), asksContext, askField   ) where @@ -13,18 +13,30 @@ import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.Base (MonadBase(liftBase)) import Control.Monad.Catch (MonadThrow(throwM), MonadCatch(catch), MonadMask(mask, uninterruptibleMask))+import Control.Monad.Cont (ContT(ContT), runContT) import Control.Monad.Cont.Class (MonadCont(callCC)) import Control.Monad.Error.Class (MonadError(throwError, catchError))+import Control.Monad.Except (ExceptT(ExceptT), runExceptT) import Control.Monad.Fail (MonadFail) import qualified Control.Monad.Fail as MonadFail import Control.Monad.Fix (MonadFix(mfix)) import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Reader (ReaderT(ReaderT), runReaderT) import Control.Monad.Reader.Class (MonadReader(local, ask, reader))+import qualified Control.Monad.RWS.Lazy as Lazy+import qualified Control.Monad.RWS.Strict as Strict import Control.Monad.RWS.Class (MonadRWS)+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.State.Strict as Strict import Control.Monad.State.Class (MonadState(get, put, state)) import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.Trans.Control (MonadTransControl(type StT, liftWith, restoreT), MonadBaseControl(type StM, liftBaseWith, restoreM))+import Control.Monad.Trans.Identity (IdentityT(IdentityT), runIdentityT)+import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)+import qualified Control.Monad.Writer.Lazy as Lazy+import qualified Control.Monad.Writer.Strict as Strict import Control.Monad.Writer.Class (MonadWriter(writer, tell, listen, pass))+import Data.Monoid (Monoid)  -- |Class of monad (stacks) which have context reading functionality baked in. Similar to 'Control.Monad.Reader.MonadReader' but can coexist with a -- another monad that provides 'Control.Monad.Reader.MonadReader' and requires the context to be a record.@@ -35,6 +47,54 @@   -- |Run some action which has the same type of context with the context modified.   localContext :: (Record c -> Record c) -> m a -> m a +instance MonadContext c ((->) (Record c)) where+  askContext = id+  localContext f = (. f)++instance MonadContext c m => MonadContext c (ReaderT r m) where+  askContext = lift askContext+  localContext f m = ReaderT $ \ r -> localContext f (runReaderT m r)++instance MonadContext c m => MonadContext c (MaybeT m) where+  askContext = lift askContext+  localContext f m = MaybeT $ localContext f (runMaybeT m)++instance (MonadContext c m, Monoid w) => MonadContext c (Strict.WriterT w m) where+  askContext = lift askContext+  localContext f m = Strict.WriterT $ localContext f (Strict.runWriterT m)++instance (MonadContext c m, Monoid w) => MonadContext c (Lazy.WriterT w m) where+  askContext = lift askContext+  localContext f m = Lazy.WriterT $ localContext f (Lazy.runWriterT m)++instance MonadContext c m => MonadContext c (Strict.StateT s m) where+  askContext = lift askContext+  localContext f m = Strict.StateT $ \ s -> localContext f (Strict.runStateT m s)++instance MonadContext c m => MonadContext c (Lazy.StateT s m) where+  askContext = lift askContext+  localContext f m = Lazy.StateT $ \ s -> localContext f (Lazy.runStateT m s)++instance MonadContext c m => MonadContext c (IdentityT m) where+  askContext = lift askContext+  localContext f m = IdentityT $ localContext f (runIdentityT m)++instance MonadContext c m => MonadContext c (ExceptT e m) where+  askContext = lift askContext+  localContext f m = ExceptT $ localContext f (runExceptT m)++instance MonadContext c m => MonadContext c (ContT r m) where+  askContext = lift askContext+  localContext f m = ContT $ \ k -> localContext f (runContT m k)++instance (MonadContext c m, Monoid w) => MonadContext c (Strict.RWST r w s m) where+  askContext = lift askContext+  localContext f m = Strict.RWST $ \ r s -> localContext f (Strict.runRWST m r s)++instance (MonadContext c m, Monoid w) => MonadContext c (Lazy.RWST r w s m) where+  askContext = lift askContext+  localContext f m = Lazy.RWST $ \ r s -> localContext f (Lazy.runRWST m r s)+ -- |Project some value out of the context using a function. asksContext :: MonadContext c m => (Record c -> a) -> m a asksContext f = f <$> askContext@@ -45,6 +105,10 @@  -- |Monad transformer which adds an implicit environment which is a record. Isomorphic to @ReaderT (Record c) m@. newtype ContextT (c :: [*]) (m :: (* -> *)) a = ContextT { runContextT :: Record c -> m a }++-- |Run some action in a given context, equivalent to 'runContextT' but with the arguments flipped.+runInContext :: Record c -> ContextT c m a -> m a+runInContext = flip runContextT  -- |Permute the current context with a function and then run some action with that modified context. withContext :: (Record c' -> Record c) -> ContextT c m a -> ContextT c' m a

@@ -25,11 +25,6 @@           Just foo :^: Nothing :^: RNil = rec       foo `shouldBe` 123 -    it "Supports pattern matching an Identity .: (:->)" $ do-      let val = Val (123 :: Int)-          Val i = val-      i `shouldBe` 123-     it "Supports lensing in a Rec Identity" $ do       let rec = 123 :*: "foo" :*: RNil :: Record TestRec       view (rlens fFoo_) rec `shouldBe` 123