data-layer 1.0.3 → 1.0.4

raw patch · 6 files changed

+179/−85 lines, 6 filesdep +convertdep ~lensPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: convert

Dependency ranges changed: lens

API changes (from Hackage documentation)

Files

• data-layer.cabal +6/−3
• src/Data/Abstract.hs +13/−0
• src/Data/Coat.hs +45/−0
• src/Data/Layer.hs +7/−0
• src/Data/Layer/Coat.hs +0/−82
• src/Data/Layer/Cover.hs +108/−0

@@ -1,5 +1,5 @@ name: data-layer-version: 1.0.3+version: 1.0.4 cabal-version: >=1.10 build-type: Simple license: Apache-2.0@@ -15,13 +15,16 @@  library     exposed-modules:+        Data.Abstract+        Data.Coat         Data.Layer-        Data.Layer.Coat+        Data.Layer.Cover         Data.Layer.Immersed     build-depends:         base >=4.6 && <4.9,+        convert -any,         data-construction >=1.0,-        lens >=4.12.3+        lens >=4.13     default-language: Haskell2010     default-extensions: ConstraintKinds DataKinds DefaultSignatures                         DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric

@@ -0,0 +1,13 @@+module Data.Abstract where++import Control.Lens++++type family Abstract a++class HasAbstract a where abstract :: Lens' a (Abstract a)+                          default abstract :: IsAbstract a => Lens' a (Abstract a)+                          abstract = abstracted++class IsAbstract a where abstracted :: Iso' a (Abstract a)

@@ -0,0 +1,45 @@+module Data.Coat where++import Prelude+import Control.Lens+import Control.Monad+import Data.Layer+++-- Non-monadic interface++class Coated c where+    coated :: Lens (c a) (c a') a a'+    default coated :: (Unwrapped (c a) ~ a, Unwrapped (c a') ~ a', Rewrapping (c a) (c a')) => Lens (c a) (c a') a a'+    coated = _Wrapped+++class IsCoat c where+    coat :: a -> c a+    default coat :: (IsLayer (c a), Unlayered (c a) ~ a) => a -> c a+    coat = layer++uncoat :: Coated c => c a -> a+uncoat = view coated+++-- Monadic interface++class CoatedM m c where+    viewCoatedM :: c a -> m a+    setCoatedM  :: a -> c a -> m (c a)+++uncoatM :: CoatedM m c => c a -> m a+uncoatM = viewCoatedM++withCoatedM :: (CoatedM m c, Monad m) => (a -> m a) -> c a -> m (c a)+withCoatedM f l = viewCoatedM l >>= f >>= flip setCoatedM l++withCoatedM' :: (CoatedM m c, Monad m) => (a -> a) -> c a -> m (c a)+withCoatedM' = withCoatedM . (return .)+++class CoatConstructor a m c where constructCoat :: a -> m (c a)+class CoatGenerator     m c where generateCoat  :: a -> m (c a)+

@@ -17,6 +17,11 @@     default layered :: (Unlayered l ~ Unwrapped l, Wrapped l) => Lens' l (Unlayered l)     layered = _Wrapped' +class TransLayered l l' where+    transLayered :: Lens l l' (Unlayered l) (Unlayered l')+    default transLayered :: (Unlayered l ~ Unwrapped l, Unlayered l' ~ Unwrapped l', Rewrapping l l') => Lens l l' (Unlayered l) (Unlayered l')+    transLayered = _Wrapped ; {-# INLINE transLayered #-}+ class IsLayer l where     layer :: Unlayered l -> l @@ -46,6 +51,8 @@ withLayeredM' = withLayeredM . (return .)  ++class LayerConstructor m l where constructLayer :: (Unlayered l) -> m l   --class Cover   m l where cover   :: Unlayered l -> m l

@@ -1,82 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--module Data.Layer.Coat where--import Prelude-import Control.Lens-import Control.Monad-import Data.Construction-import Data.Layer----- === Coat ===--newtype Coat a = Coat a deriving (Show, Functor, Foldable, Traversable)-type instance Unlayered (Coat a) = a--type family Uncoated a where Uncoated (Coat a) = a-                             Uncoated a        = Uncoated (Unlayered a)---- Instances--instance Layered   (Coat a)-instance Rewrapped (Coat a) (Coat a')-instance Wrapped   (Coat a) where-    type Unwrapped (Coat a) = a-    _Wrapped' = iso (\(Coat a) -> a) Coat------ === Coated ===---- pure interface--class Coated a where coated :: Lens' a (Uncoated a)-instance {-# OVERLAPPABLE #-} ( Layered a-                              , Coated (Unlayered a)-                              , Uncoated a ~ Uncoated (Unlayered a)-                              ) => Coated a        where coated = layered . coated-instance {-# OVERLAPPABLE #-}      Coated (Coat a) where coated = _Wrapped'--uncoat :: Coated a => a -> Uncoated a-uncoat = view coated----- monadic interface--class CoatedM m a where viewCoatedM :: a -> m (Uncoated a)-                        setCoatedM  :: Uncoated a -> a -> m a--instance {-# OVERLAPPABLE #-} ( Monad m-                              , LayeredM m a-                              , CoatedM m (Unlayered a)-                              , Uncoated a ~ Uncoated (Unlayered a)-                              )       => CoatedM m a        where viewCoatedM = viewLayeredM >=> viewCoatedM-                                                                  setCoatedM  = withLayeredM . setCoatedM-instance {-# OVERLAPPABLE #-} Monad m => CoatedM m (Coat a) where viewCoatedM   = return . uncoat-                                                                  setCoatedM  v = return . set coated v----- === Coat generator ===--class CoatConstructor m a where constructCoat :: Uncoated a -> m a-instance {-# OVERLAPPABLE #-} ( CoatConstructor m (Destructed a)-                              , Uncoated a ~ Uncoated (Destructed a)-                              , Constructor m a-                              , Monad m ) => CoatConstructor m a        where constructCoat = constructCoat >=> construct-instance {-# OVERLAPPABLE #-}   Monad m   => CoatConstructor m (Coat a) where constructCoat = return . Coat--class CoatDestructor m a where destructCoat :: a -> m (Uncoated a)-instance {-# OVERLAPPABLE #-} ( Uncoated a ~ Uncoated (Destructed a)-                              , CoatDestructor m (Destructed a)-                              , Destructor m a-                              , Monad m ) => CoatDestructor m a        where destructCoat = destruct >=> destructCoat-instance {-# OVERLAPPABLE #-}   Monad m   => CoatDestructor m (Coat a) where destructCoat = return . view _Wrapped'----class Destruction m a where destroy :: a -> m (Uncoated a)---instance {-# OVERLAPPABLE #-} Monad m => Destruction m (Coat a) where destroy = return . unlayer---instance {-# OVERLAPPABLE #-} Monad m => Destruction m (Coat a) where destroy = return . unlayer----type family Deconstructed a---class Construction   m a where construct   :: Deconstructed a -> m a---class Deconstruction m a where deconstruct :: a               -> m (Deconstructed a)

@@ -0,0 +1,108 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DoRec                #-}++module Data.Layer.Cover where++import Prelude+import Control.Lens+import Control.Monad+import Control.Monad.Fix+import Data.Construction+import Data.Convert+import Data.Layer++-- === Cover ===++newtype Cover a = Cover a deriving (Show, Eq, Ord, Functor, Foldable, Traversable)+type instance Unlayered (Cover a) = a++type family Uncovered a where Uncovered (Cover a) = a+                              Uncovered a         = Uncovered (Unlayered a)++-- Instances++instance Layered   (Cover a)+instance Rewrapped (Cover a) (Cover a')+instance Wrapped   (Cover a) where+    type Unwrapped (Cover a) = a+    _Wrapped' = iso (\(Cover a) -> a) Cover++instance Castable    a a' => Castable    (Cover a) (Cover a') where cast    = _Wrapped %~ cast+instance Convertible a a' => Convertible (Cover a) (Cover a') where convert = _Wrapped %~ convert+++-- === Covered ===++-- pure interface++class Covered a where covered :: Lens' a (Uncovered a)+instance {-# OVERLAPPABLE #-} ( Layered a+                              , Covered (Unlayered a)+                              , Uncovered a ~ Uncovered (Unlayered a)+                              ) => Covered a        where covered = layered . covered+instance {-# OVERLAPPABLE #-}      Covered (Cover a) where covered = _Wrapped'++uncover :: Covered a => a -> Uncovered a+uncover = view covered+++-- monadic interface++class CoveredM m a where viewCoveredM :: a -> m (Uncovered a)+                         setCoveredM  :: Uncovered a -> a -> m a++instance {-# OVERLAPPABLE #-} ( Monad m+                              , LayeredM m a+                              , CoveredM m (Unlayered a)+                              , Uncovered a ~ Uncovered (Unlayered a)+                              )       => CoveredM m a         where viewCoveredM   = viewLayeredM >=> viewCoveredM+                                                                    setCoveredM    = withLayeredM . setCoveredM+instance {-# OVERLAPPABLE #-} Monad m => CoveredM m (Cover a) where viewCoveredM   = return . uncover+                                                                    setCoveredM  v = return . set covered v+++-- === Cover generator ===++class CoverConstructor m a where constructCover :: Uncovered a -> m a+instance {-# OVERLAPPABLE #-} ( CoverConstructor m (Unlayered a)+                              , Uncovered a ~ Uncovered (Unlayered a)+                              , LayerConstructor m a+                              , Monad m ) => CoverConstructor m a         where constructCover = constructCover >=> constructLayer+instance {-# OVERLAPPABLE #-}   Monad m   => CoverConstructor m (Cover a) where constructCover = return . Cover++class CoverConstructorFix m a where constructCoverFix :: Uncovered a -> m a+instance {-# OVERLAPPABLE #-} ( CoverConstructorFix m (Unlayered a)+                              , Uncovered a ~ Uncovered (Unlayered a)+                              , LayerConstructor m a+                              , MonadFix m ) => CoverConstructorFix m a         where+    constructCoverFix base = mdo+        out <- constructLayer l+        l   <- constructCoverFix base +        return out+instance {-# OVERLAPPABLE #-}   Monad m   => CoverConstructorFix m (Cover a) where constructCoverFix = return . Cover++--class CoverConstructor m a where constructCover :: Uncovered a -> m a+--instance {-# OVERLAPPABLE #-} ( CoverConstructor m (Destructed a)+--                              , Uncovered a ~ Uncovered (Destructed a)+--                              , Constructor m a+--                              , Monad m ) => CoverConstructor m a         where constructCover = constructCover >=> construct+--instance {-# OVERLAPPABLE #-}   Monad m   => CoverConstructor m (Cover a) where constructCover = return . Cover++--class CoverDestructor m a where destructCover :: a -> m (Uncovered a)+--instance {-# OVERLAPPABLE #-} ( Uncovered a ~ Uncovered (Destructed a)+--                              , CoverDestructor m (Destructed a)+--                              , Destructor m a+--                              , Monad m ) => CoverDestructor m a         where destructCover = destruct >=> destructCover+--instance {-# OVERLAPPABLE #-}   Monad m   => CoverDestructor m (Cover a) where destructCover = return . view _Wrapped'++--class Destruction m a where destroy :: a -> m (Uncovered a)+--instance {-# OVERLAPPABLE #-} Monad m => Destruction m (Cover a) where destroy = return . unlayer+--instance {-# OVERLAPPABLE #-} Monad m => Destruction m (Cover a) where destroy = return . unlayer++--type family Deconstructed a+--class Construction   m a where construct   :: Deconstructed a -> m a+--class Deconstruction m a where deconstruct :: a               -> m (Deconstructed a)+-- >//>+-- >\\>+-- >><>+