composite-base 0.8.2.1 → 0.8.2.2

raw patch · 4 files changed

+93/−23 lines, 4 filesdep ~deepseqdep ~lensdep ~mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq, lens, mtl, template-haskell, text, transformers

API changes (from Hackage documentation)

Files

• composite-base.cabal +3/−9
• src/Composite/CoRecord.hs +71/−7
• src/Composite/Record.hs +16/−5
• src/Control/Monad/Composite/Context.hs +3/−2

@@ -1,13 +1,7 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7.------ see: https://github.com/sol/hpack------ hash: e7d77c01ec2d16ffde579ab8162ffa4762d032bef3c7bdfdbcecb769700420d8- name:           composite-base-version:        0.8.2.1+version:        0.8.2.2 synopsis:       Shared utilities for composite-* packages. description:    Shared helpers for the various composite packages. category:       Records@@ -59,7 +53,7 @@       base >=4.12 && <5     , deepseq ==1.4.*     , exceptions >=0.8.3 && <0.11-    , lens >=4.15.4 && <5.2+    , lens >=4.15.4 && <5.3     , monad-control >=1.0.2.2 && <1.1     , mtl >=2.2.1 && <2.3     , profunctors >=5.2.1 && <5.7@@ -112,7 +106,7 @@     , deepseq ==1.4.*     , exceptions >=0.8.3 && <0.11     , hspec-    , lens >=4.15.4 && <5.2+    , lens >=4.15.4 && <5.3     , monad-control >=1.0.2.2 && <1.1     , mtl >=2.2.1 && <2.3     , profunctors >=5.2.1 && <5.7

@@ -5,22 +5,25 @@  import Prelude import Composite.Record (AllHave, HasInstances, (:->)(getVal, Val), reifyDicts, reifyVal, val, zipRecsWith)-import Control.Lens (Prism', prism')+import Control.Lens (Prism', Wrapped, Unwrapped, prism', review, view, _Wrapped')+import Control.Monad.Except (ExceptT, throwError, withExceptT) import Data.Functor.Contravariant (Contravariant(contramap)) import Data.Functor.Identity (Identity(Identity), runIdentity)-import Data.Kind (Constraint)+import Data.Kind (Constraint, Type) import Data.Maybe (fromMaybe) import Data.Profunctor (dimap) import Data.Proxy (Proxy(Proxy))+import Data.Text (Text, pack) import Data.Vinyl.Core (Dict(Dict), Rec((:&), RNil), RMap, RecApplicative, RecordToList, ReifyConstraint, recordToList, reifyConstraint, rmap, rpure) import Data.Vinyl.Functor (Compose(Compose, getCompose), Const(Const), (:.)) import Data.Vinyl.Lens (RElem, type (∈), type (⊆), rget, rput, rreplace) import Data.Vinyl.TypeLevel (RecAll, RIndex)+import GHC.TypeLits (KnownSymbol, symbolVal)  -- FIXME? replace with int-index/union or at least lift ideas from there. This encoding is awkward to work with and not compositional.  -- |@CoRef f rs@ represents a single value of type @f r@ for some @r@ in @rs@.-data CoRec :: (u -> *) -> [u] -> * where+data CoRec :: (u -> Type) -> [u] -> Type where   -- |Witness that @r@ is an element of @rs@ using '∈' ('RElem' with 'RIndex') from Vinyl.   CoVal :: r ∈ rs => !(f r) -> CoRec f rs @@ -160,10 +163,10 @@  -- |Given a list of constraints @cs@ required to apply some function, apply the function to whatever value @r@ (not @f r@) which the 'CoRec' contains. onCoRec-  :: forall (cs :: [* -> Constraint]) (f :: * -> *) (rs :: [*]) (b :: *) (proxy :: [* -> Constraint] -> *).+  :: forall (cs :: [Type -> Constraint]) (f :: Type -> Type) (rs :: [Type]) (b :: Type) (proxy :: [Type -> Constraint] -> Type).      (AllHave cs rs, Functor f, RecApplicative rs)   => proxy cs-  -> (forall (a :: *). HasInstances a cs => a -> b)+  -> (forall (a :: Type). HasInstances a cs => a -> b)   -> CoRec f rs   -> f b onCoRec p f (CoVal x) = go <$> x@@ -173,10 +176,10 @@  -- |Given a list of constraints @cs@ required to apply some function, apply the function to whatever value @r@ which the 'Field' contains. onField-  :: forall (cs :: [* -> Constraint]) (rs :: [*]) (b :: *) (proxy :: [* -> Constraint] -> *).+  :: forall (cs :: [Type -> Constraint]) (rs :: [Type]) (b :: Type) (proxy :: [Type -> Constraint] -> Type).      (AllHave cs rs, RecApplicative rs)   => proxy cs-  -> (forall (a :: *). HasInstances a cs => a -> b)+  -> (forall (a :: Type). HasInstances a cs => a -> b)   -> Field rs   -> b onField p f x = runIdentity (onCoRec p f x)@@ -245,3 +248,64 @@ widenField r =   fromMaybe (error "widenField should be provably total, isn't") $     firstField (rreplace (fieldToRec r) (rpure Nothing))++-- |Constraint showing that @rs ⊆ ss@ and giving enough power to widen a @'CoRec' f rs@ to @'CoRec' f ss@.+type WiderCoRec rs ss = (FoldRec ss ss, RecApplicative rs, RecApplicative ss, rs ⊆ ss)++-- |Constraint on a pair of types @r@ and @s@ which are 'Wrapped' around @'CoRec' f rs@ and @'CoRec' f ss@ respectively and observes that those types can be unwrapped and the former can be widened to the latter.+type WrappedWiderCoRec f r rs s ss = (Wrapped r, Unwrapped r ~ CoRec f rs, Wrapped s, Unwrapped s ~ CoRec f ss, WiderCoRec rs ss)++-- |'WrappedWiderCoRec' specialized to 'CoRec' 'Identity', i.e. 'Field'.+type WrappedWiderField r rs s ss = WrappedWiderCoRec Identity r rs s ss++-- |Widen a @'CoRec' f rs@ wrapped in @r@ to a @'CoRec' f ss@ wrapped in @s@.+widenWrappedCoRec :: WrappedWiderCoRec f r rs s ss => r -> s+widenWrappedCoRec = review _Wrapped' . widenCoRec . view _Wrapped'++-- |Widen a @'Field' rs@ wrapped in @r@ to a @'Field' ss@ wrapped in @s@.+widenWrappedField :: WrappedWiderField r rs s ss => r -> s+widenWrappedField = review _Wrapped' . widenCoRec . view _Wrapped'++-- |Widen a wrapped 'CoRec' using 'widenWrappedCoRec' and then throw it as an 'ExceptT' error, as a convenience when using 'CoRec' / 'Field' for building up error types by set union.+throwWidened :: (Monad m, WrappedWiderCoRec f e er e' er') => e -> ExceptT e' m a+throwWidened = throwError . widenWrappedCoRec++-- |Catch a wrapped 'CoRec' thrown by an 'ExceptT' and widen it using 'widenWrappedCoRec' then rethrow it, as a convenience when using 'CoRec' / 'Field' for building up error types by set union.+rethrowWidened :: (Functor m, WrappedWiderCoRec f e er e' er') => ExceptT e m a -> ExceptT e' m a+rethrowWidened = withExceptT widenWrappedCoRec++-- |Specialized type of 'Case' for 'Val', with the type parameters in a convenient order for type application, e.g.:+--+-- @+--   valCase @"foo" (\ a -> ...)+--     :& valCase @"bar" (\ b -> ...)+--     :& RNil+-- @+valCase :: forall s a b. (a -> b) -> Case b (s :-> a)+valCase f = Case $ \(Val a) -> f a++-- |Specialized type of 'Case'' for 'Val', with the type parameters in a convenient order for type application, e.g.:+--+-- @+--   valCase' @"foo" (\ fa -> ...)+--     :& valCase' @"bar" (\ fb -> ...)+--     :& RNil+-- @+valCase' :: forall s f a b. Functor f => (f a -> b) -> Case' f b (s :-> a)+valCase' f = Case' $ \fva -> f (fmap getVal fva)++-- |Make a 'Case' which yields the symbol text for a field @s :-> ()@. E.g.:+--+-- @+--   keywordCase @"foo" (Identity (Val ())) == "foo"+-- @+keywordCase :: KnownSymbol s => Case Text (s :-> ())+keywordCase = keywordCase' id++-- |Make a 'Case'' which yields the symbol text for a field @s :-> ()@ as projected through the given function. E.g.:+--+-- @+--   keywordCase @"foo" (<> "bar") (Identity (Val ())) == "foobar"+-- @+keywordCase' :: KnownSymbol s => (Text -> a) -> Case a (s :-> ())+keywordCase' f = Case $ \(Val () :: s :-> ()) -> f (pack (symbolVal (Proxy @s)))

@@ -10,21 +10,23 @@   , ReifyNames(reifyNames)   , RecWithContext(rmapWithContext)   , RDelete, RDeletable, rdelete+  , rwiden+  , _SingleVal   ) where  import Control.DeepSeq(NFData(rnf)) import Control.Lens (Iso, iso) import Control.Lens.TH (makeWrapped)-import Data.Functor.Identity (Identity(Identity))+import Data.Functor.Identity (Identity(Identity), runIdentity) import Data.Functor.Contravariant (Contravariant(contramap)) import Data.Kind (Constraint, Type) import Data.List.NonEmpty (NonEmpty((:|))) import Data.Proxy (Proxy(Proxy)) import Data.String (IsString) import Data.Text (Text, pack)-import Data.Vinyl (Rec((:&), RNil), RecApplicative, rcast, recordToList, rpure)+import Data.Vinyl (Rec((:&), RNil), RecApplicative, RMap, rcast, rdowncast, recordToList, rmap, rpure) import qualified Data.Vinyl as Vinyl-import Data.Vinyl.Functor (Compose(Compose), Const(Const), (:.))+import Data.Vinyl.Functor (Compose(Compose, getCompose), Const(Const), (:.)) import Data.Vinyl.Lens (type (∈), type (⊆)) import qualified Data.Vinyl.TypeLevel as Vinyl import Data.Vinyl.XRec(IsoHKD(HKD, toHKD, unHKD))@@ -80,8 +82,6 @@   traverse k (Val a) = Val <$> k a   {-# INLINE traverse #-} instance Monad ((:->) s) where-  return = pure-  {-# INLINE return #-}   Val a >>= k = k a   {-# INLINE (>>=) #-} @@ -349,3 +349,14 @@ -- |Remove an element @r@ from a @'Rec' f rs@. Note this is just a type constrained 'rcast'. rdelete :: RDeletable r rs => proxy r -> Rec f rs -> Rec f (RDelete r rs) rdelete _ = rcast++-- |Widen a record from @'Record' rs@ to @'Rec' 'Maybe' ss@. Note this is just a type constrainted 'rdowncast'.+rwiden :: (RecApplicative ss, RMap rs, RMap ss, rs ⊆ ss) => Record rs -> Rec Maybe ss+rwiden = rmap (fmap runIdentity . getCompose) . rdowncast++-- |'Iso' which observes that a record with a single field @s@ with value @a@ is isomorphic to the value alone.+_SingleVal :: forall s a b. Iso (Record '[s :-> a]) (Record '[s :-> b]) a b+_SingleVal =+  let toA :: Record '[s :-> a] -> a = getVal . runIdentity . Vinyl.rget @(s :-> a)+      fromA x = Identity (Val x) :& RNil+   in iso toA fromA

@@ -46,6 +46,7 @@ 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.Kind (Type)  import Control.Monad.IO.Unlift   ( MonadUnliftIO@@ -59,7 +60,7 @@  -- |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.-class Monad m => MonadContext (c :: [*]) m | m -> c where+class Monad m => MonadContext (c :: [Type]) m | m -> c where   -- |Fetch the context record from the environment.   askContext :: m (Record c) @@ -123,7 +124,7 @@ askField l = asksContext $ view l  -- |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 }+newtype ContextT (c :: [Type]) (m :: (Type -> Type)) 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