composite-base 0.5.5.0 → 0.6.0.0
raw patch · 3 files changed
+52/−48 lines, 3 filesdep ~lensdep ~profunctorsdep ~template-haskellnew-uploader
Dependency ranges changed: lens, profunctors, template-haskell, vinyl
Files
- composite-base.cabal +23/−23
- src/Composite/CoRecord.hs +21/−21
- src/Composite/Record.hs +8/−4
composite-base.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 1ecc9858c092eb474a62472e1f3bd7ed1a5c0acc8d511e17137072db07a68cbf+-- hash: 07d0720f8ca6afb65660fb74ac73b3d0910962355401e84040c5cfaa70339214 name: composite-base-version: 0.5.5.0+version: 0.6.0.0 synopsis: Shared utilities for composite-* packages. description: Shared helpers for the various composite packages. category: Records@@ -19,6 +19,14 @@ build-type: Simple library+ exposed-modules:+ Composite+ Composite.CoRecord+ Composite.Record+ Composite.TH+ Control.Monad.Composite.Context+ other-modules:+ Paths_composite_base hs-source-dirs: src default-extensions: ConstraintKinds DataKinds FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns OverloadedStrings PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving StrictData TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns@@ -26,29 +34,25 @@ build-depends: base >=4.7 && <5 , exceptions >=0.8.3 && <0.11- , lens >=4.15.4 && <4.17+ , lens >=4.15.4 && <4.18 , monad-control >=1.0.2.2 && <1.1 , mtl >=2.2.1 && <2.3- , profunctors >=5.2.1 && <5.3- , template-haskell >=2.11.1.0 && <2.14+ , profunctors >=5.2.1 && <5.4+ , template-haskell >=2.11.1.0 && <2.15 , text >=1.2.2.2 && <1.3 , transformers >=0.5.2.0 && <0.6 , transformers-base >=0.4.4 && <0.5 , unliftio-core >=0.1.0.0 && <0.2.0.0- , vinyl >=0.5.3 && <0.9- exposed-modules:- Composite- Composite.CoRecord- Composite.Record- Composite.TH- Control.Monad.Composite.Context- other-modules:- Paths_composite_base+ , vinyl >=0.5.3 && <0.12 default-language: Haskell2010 test-suite composite-base-test type: exitcode-stdio-1.0 main-is: Main.hs+ other-modules:+ RecordSpec+ THSpec+ Paths_composite_base hs-source-dirs: test default-extensions: ConstraintKinds DataKinds FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns OverloadedStrings PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving StrictData TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns@@ -59,18 +63,14 @@ , composite-base , exceptions >=0.8.3 && <0.11 , hspec- , lens >=4.15.4 && <4.17+ , lens >=4.15.4 && <4.18 , monad-control >=1.0.2.2 && <1.1 , mtl >=2.2.1 && <2.3- , profunctors >=5.2.1 && <5.3- , template-haskell >=2.11.1.0 && <2.14+ , profunctors >=5.2.1 && <5.4+ , template-haskell >=2.11.1.0 && <2.15 , text >=1.2.2.2 && <1.3 , transformers >=0.5.2.0 && <0.6 , transformers-base >=0.4.4 && <0.5 , unliftio-core >=0.1.0.0 && <0.2.0.0- , vinyl >=0.5.3 && <0.9- other-modules:- RecordSpec- THSpec- Paths_composite_base+ , vinyl >=0.5.3 && <0.12 default-language: Haskell2010
src/Composite/CoRecord.hs view
@@ -4,14 +4,14 @@ module Composite.CoRecord where import Prelude-import Composite.Record (AllHave, HasInstances, (:->)(getVal, Val), reifyDicts, val, zipRecsWith)+import Composite.Record (AllHave, HasInstances, (:->)(getVal, Val), reifyDicts, reifyVal, val, zipRecsWith) 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.Core (Dict(Dict), Rec((:&), RNil), RecApplicative, recordToList, reifyConstraint, rmap, rpure)+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)@@ -28,14 +28,14 @@ where shower :: Rec (Op String) rs shower = reifyDicts (Proxy @'[Show]) (\ _ -> Op show)- show' = runOp (rget Proxy shower)+ show' = runOp (rget shower) -instance forall rs. (RecAll Maybe rs Eq, RecApplicative rs) => Eq (CoRec Identity rs) where+instance forall rs. (RMap rs, RecAll Maybe rs Eq, RecApplicative rs, RecordToList rs, ReifyConstraint Eq Maybe rs) => Eq (CoRec Identity rs) where crA == crB = and . recordToList $ zipRecsWith f (toRec crA) (fieldToRec crB) where f :: forall a. (Dict Eq :. Maybe) a -> Maybe a -> Const Bool a f (Compose (Dict a)) b = Const $ a == b- toRec = reifyConstraint (Proxy @Eq) . fieldToRec+ toRec = reifyConstraint . fieldToRec -- |The common case of a 'CoRec' with @f ~ 'Identity'@, i.e. a regular value. type Field = CoRec Identity@@ -46,9 +46,9 @@ coRec :: r ∈ rs => f r -> CoRec f rs coRec = CoVal --- |Produce a prism for the given alternative of a 'CoRec', given a proxy to identify which @r@ you meant.-coRecPrism :: (RecApplicative rs, r ∈ rs) => proxy r -> Prism' (CoRec f rs) (f r)-coRecPrism proxy = prism' CoVal (getCompose . rget proxy . coRecToRec)+-- |Produce a prism for the given alternative of a 'CoRec'.+coRecPrism :: (RecApplicative rs, r ∈ rs) => Prism' (CoRec f rs) (f r)+coRecPrism = prism' CoVal (getCompose . rget . coRecToRec) -- |Inject a value @r@ into a @'Field' rs@ given that @r@ is one of the valid @rs@. --@@ -62,13 +62,13 @@ fieldVal :: forall s a rs proxy. s :-> a ∈ rs => proxy (s :-> a) -> a -> Field rs fieldVal _ = CoVal . val @s --- |Produce a prism for the given alternative of a 'Field', given a proxy to identify which @r@ you meant.-fieldPrism :: (RecApplicative rs, r ∈ rs) => proxy r -> Prism' (Field rs) r-fieldPrism proxy = coRecPrism proxy . dimap runIdentity (fmap Identity)+-- |Produce a prism for the given alternative of a 'Field'.+fieldPrism :: (RecApplicative rs, r ∈ rs) => Prism' (Field rs) r+fieldPrism = coRecPrism . dimap runIdentity (fmap Identity) -- |Produce a prism for the given @:->@ alternative of a 'Field', given a proxy to identify which @s :-> a@ you meant. fieldValPrism :: (RecApplicative rs, s :-> a ∈ rs) => proxy (s :-> a) -> Prism' (Field rs) a-fieldValPrism proxy = coRecPrism proxy . dimap (getVal . runIdentity) (fmap (Identity . Val))+fieldValPrism proxy = coRecPrism . dimap (getVal . reifyVal proxy . runIdentity) (fmap (Identity . Val)) -- |Apply an extraction to whatever @f r@ is contained in the given 'CoRec'. --@@ -95,7 +95,7 @@ -- |Project a 'Field' into a @'Rec' 'Maybe'@ where only the single @r@ held by the 'Field' is 'Just' in the resulting record, and all other -- fields are 'Nothing'.-fieldToRec :: RecApplicative rs => Field rs -> Rec Maybe rs+fieldToRec :: (RMap rs, RecApplicative rs) => Field rs -> Rec Maybe rs fieldToRec = rmap (fmap runIdentity . getCompose) . coRecToRec {-# INLINE fieldToRec #-} @@ -136,7 +136,7 @@ {-# INLINE firstCoRec #-} -- |Given a @'Rec' 'Maybe' rs@, yield a @Just field@ for the first field which is @Just@, or @Nothing@ if there are no @Just@ fields in the record.-firstField :: FoldRec rs rs => Rec Maybe rs -> Maybe (Field rs)+firstField :: (FoldRec rs rs, RMap rs) => Rec Maybe rs -> Maybe (Field rs) firstField = firstCoRec . rmap (Compose . fmap Identity) {-# INLINE firstField #-} @@ -150,7 +150,7 @@ {-# INLINE lastCoRec #-} -- |Given a @'Rec' 'Maybe' rs@, yield a @Just field@ for the last field which is @Just@, or @Nothing@ if there are no @Just@ fields in the record.-lastField :: FoldRec rs rs => Rec Maybe rs -> Maybe (Field rs)+lastField :: (RMap rs, FoldRec rs rs) => Rec Maybe rs -> Maybe (Field rs) lastField = lastCoRec . rmap (Compose . fmap Identity) {-# INLINE lastField #-} @@ -167,7 +167,7 @@ -> f b onCoRec p f (CoVal x) = go <$> x where- go = runOp $ rget Proxy (reifyDicts p (\ _ -> Op f) :: Rec (Op b) rs)+ go = runOp $ rget (reifyDicts p (\ _ -> Op f) :: Rec (Op b) rs) {-# INLINE onCoRec #-} -- |Given a list of constraints @cs@ required to apply some function, apply the function to whatever value @r@ which the 'Field' contains.@@ -183,8 +183,8 @@ -- |Given some target type @r@ that's a possible value of @'Field' rs@, yield @Just@ if that is indeed the value being stored by the 'Field', or @Nothing@ if -- not.-asA :: (r ∈ rs, RecApplicative rs) => proxy r -> Field rs -> Maybe r-asA p = rget p . fieldToRec+asA :: (r ∈ rs, RMap rs, RecApplicative rs) => Field rs -> Maybe r+asA = rget . fieldToRec {-# INLINE asA #-} -- |An extractor function @f a -> b@ which can be passed to 'foldCoRec' to eliminate one possible alternative of a 'CoRec'.@@ -215,14 +215,14 @@ type Cases rs b = Rec (Case b) rs -- |Fold a 'Field' using 'Cases' which eliminate each possible value held by the 'Field', yielding the @b@ produced by whichever case matches.-foldField :: RecApplicative (r ': rs) => Cases (r ': rs) b -> Field (r ': rs) -> b+foldField :: (RMap rs, RecApplicative (r ': rs)) => Cases (r ': rs) b -> Field (r ': rs) -> b foldField hs = foldCoRec (rmap (Case' . (. runIdentity) . unCase) hs) {-# INLINE foldField #-} -- |Fold a 'Field' using 'Cases' which eliminate each possible value held by the 'Field', yielding the @b@ produced by whichever case matches. -- -- Equivalent to 'foldCoRec' but with its arguments flipped so it can be written @matchCoRec coRec $ cases@.-matchField :: RecApplicative (r ': rs) => Field (r ': rs) -> Cases (r ': rs) b -> b+matchField :: (RMap rs, RecApplicative (r ': rs)) => Field (r ': rs) -> Cases (r ': rs) b -> b matchField = flip foldField {-# INLINE matchField #-} @@ -233,7 +233,7 @@ 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 :: (FoldRec ss ss, RMap rs, RMap 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))
src/Composite/Record.hs view
@@ -5,7 +5,7 @@ , (:->)(Val, getVal), _Val, val, valName, valWithName , RElem, rlens, rlens' , AllHave, HasInstances, ValuesAllHave- , zipRecsWith, reifyDicts, recordToNonEmpty+ , zipRecsWith, reifyDicts, reifyVal, recordToNonEmpty , ReifyNames(reifyNames) , RecWithContext(rmapWithContext) , RDelete, RDeletable, rdelete@@ -153,6 +153,10 @@ (:^:) fa rs = fmap Val fa :& rs infixr 5 :^: +-- |Reify the type of a val.+reifyVal :: proxy (s :-> a) -> (s :-> a) -> (s :-> a)+reifyVal _ = id+ -- |Lens to a particular field of a record using the 'Identity' functor. -- -- For example, given:@@ -176,7 +180,7 @@ -- @ rlens :: (Functor g, RElem (s :-> a) rs, Functor g) => proxy (s :-> a) -> (a -> g a) -> Rec Identity rs -> g (Rec Identity rs) rlens proxy f =- Vinyl.rlens proxy $ \ (Identity (Val a)) ->+ Vinyl.rlens $ \ (Identity (getVal . reifyVal proxy -> a)) -> Identity . Val <$> f a {-# INLINE rlens #-} @@ -203,7 +207,7 @@ -- @ rlens' :: (Functor f, Functor g, RElem (s :-> a) rs, Functor g) => proxy (s :-> a) -> (f a -> g (f a)) -> Rec f rs -> g (Rec f rs) rlens' proxy f =- Vinyl.rlens proxy $ \ (fmap getVal -> fa) ->+ Vinyl.rlens $ \ (fmap (getVal . reifyVal proxy) -> fa) -> fmap Val <$> f fa {-# INLINE rlens' #-} @@ -213,7 +217,7 @@ zipRecsWith f (r :& rs) (s :& ss) = f r s :& zipRecsWith f rs ss -- | Convert a provably nonempty @'Rec' ('Const' a) rs@ to a @'NonEmpty' a@.-recordToNonEmpty :: Rec (Const a) (r ': rs) -> NonEmpty a+recordToNonEmpty :: Vinyl.RecordToList rs => Rec (Const a) (r ': rs) -> NonEmpty a recordToNonEmpty (Const a :& rs) = a :| recordToList rs -- |Type function which produces a constraint on @a@ for each constraint in @cs@.