extensible 0.4.8 → 0.4.9

raw patch · 13 files changed

+165/−32 lines, 13 filesdep +prettyprinterdep +th-liftPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: prettyprinter, th-lift

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• examples/eff.hs +0/−23
• examples/misc.hs +22/−0
• examples/records.hs +1/−1
• extensible.cabal +3/−1
• src/Data/Extensible.hs +19/−0
• src/Data/Extensible/Dictionary.hs +49/−1
• src/Data/Extensible/Effect/Default.hs +2/−2
• src/Data/Extensible/Field.hs +21/−1
• src/Data/Extensible/Internal.hs +9/−0
• src/Data/Extensible/Nullable.hs +6/−1
• src/Data/Extensible/Product.hs +9/−0
• src/Data/Extensible/Wrapper.hs +14/−2

@@ -1,3 +1,13 @@+0.4.9+-------------------------------------------------+* Generalised the `MonadIO` instance for `Eff` to `(MonadIO m, Associate "IO" m xs) => MonadIO (Eff xs)`+* Added `And :: (k -> Constraint) -> (k -> Constraint) -> k -> Constraint`+* Added `Semigroup` and `Monoid` instances for `Const'`+* Added `stringAssocKey :: (IsString a, KnownSymbol (AssocKey kv)) => proxy kv -> a`+* Added a `Wrapper` instance for `Either e`+* Added instances of `Pretty` and `Lift`+* Added `hmapWithIndexFor`+ 0.4.8 ------------------------------------------------- * Changed the `FromJSON` instance for `Record` to call `parseJSON Null` for missing fields

@@ -1,23 +0,0 @@-{-# LANGUAGE TypeApplications, OverloadedLabels, PolyKinds, DataKinds, ScopedTypeVariables, Rank2Types #-}-import Data.Extensible--import Prelude hiding (readFile)-import Control.Exception-import Data.ByteString (ByteString)--data FileSystem r where-  ReadFile-    :: FilePath-    -> FileSystem (Either SomeException ByteString)--readFile-  :: forall xs-  . (Associate "fs" FileSystem xs-  , Associate "fs_error" (EitherEff SomeException) xs)-  => FilePath-  -> Eff xs ByteString-readFile fp = liftEff #fs (ReadFile fp)-           >>= either (throwEff #fs_error) pure--foo :: forall xs. Associate "fs" FileSystem xs => Eff xs (Either SomeException ByteString)-foo = castEff (runEitherEff @ "fs_error" (readFile "foo") :: Eff '["fs" >: FileSystem] (Either SomeException ByteString))

@@ -0,0 +1,22 @@+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeApplications #-}++import Data.Extensible+import Data.Functor.Identity+import Data.Proxy+import GHC.TypeLits+import Data.Extensible.Internal.Rig+import Data.Typeable+import Data.Functor.Product++-- | Collect keys+keys :: forall proxy xs. Forall (KeyIs KnownSymbol) xs => proxy xs -> [String]+keys _ = henumerateFor (Proxy @ (KeyIs KnownSymbol)) (Proxy @ xs)+  ((:) . symbolVal . proxyAssocKey) []++values :: Forall (ValueIs Show) xs => Record xs -> [String]+values = hfoldrWithIndexFor (Proxy @ (ValueIs Show))+  (const $ (:) . show . view _Wrapper) []++values' :: Forall (ValueIs (Product Typeable Show)) xs => Record xs -> [String]+values' = hfoldrWithIndexFor (Proxy @ (ValueIs Show))+  (const $ (:) . show . view _Wrapper) []

@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds, TypeOperators, TypeFamilies, FlexibleContexts, OverloadedLabels #-}+{-# LANGUAGE TemplateHaskell, DataKinds, TypeOperators, TypeFamilies, FlexibleContexts, OverloadedLabels #-} import Data.Extensible import Control.Lens 

@@ -1,5 +1,5 @@ name:                extensible-version:             0.4.8+version:             0.4.9 synopsis:            Extensible, efficient, optics-friendly data types and effects homepage:            https://github.com/fumieval/extensible bug-reports:         http://github.com/fumieval/extensible/issues@@ -78,6 +78,7 @@     , hashable     , monad-skeleton >= 0.1.2     , mtl+    , prettyprinter     , primitive     , profunctors     , QuickCheck@@ -86,6 +87,7 @@     , tagged     , template-haskell     , text+    , th-lift     , transformers     , unordered-containers     , vector

@@ -7,6 +7,25 @@ -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com> -- -- This module just reexports everything.+--+-- * Basic+--+--     * 'Data.Extensible.Class': basic membership operations.+--     * 'Data.Extensible.Product': Combinators for extensible products+--     * 'Data.Extensible.Sum': the basic interface for extensible sums+--     * 'Data.Extensible.Field': extensible records and variants+--     * 'Data.Extensible.Inclusion': shrinking records and widening variants+--+-- * Advanced+--     * 'Data.Extensible.Record': Conversion between regular records and+--     extensible records+--     * 'Data.Extensible.Nullable': Nullable records+--     * 'Data.Extensible.Tangle': Extensible tangle+--     * 'Data.Extensible.Effect': Extensible effects+--     * 'Data.Extensible.Match': Extensible pattern match+--+-- * Internal+--     * 'Data.Extensible.Wrapper': Stock wrappers ----------------------------------------------------------------------------- module Data.Extensible (   module Data.Extensible.Class

@@ -1,8 +1,10 @@+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies, ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances, MultiParamTypeClasses #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE UndecidableSuperClasses #-} #endif+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------- -- |@@ -15,7 +17,8 @@ -- Reification of constraints using extensible data types. -- Also includes orphan instances. ------------------------------------------------------------------------module Data.Extensible.Dictionary (library, WrapForall, Instance1) where+module Data.Extensible.Dictionary (library, WrapForall, Instance1, And) where+import Control.Applicative import Control.DeepSeq import qualified Data.Aeson as J import qualified Data.Csv as Csv@@ -34,11 +37,14 @@ import Data.Hashable import qualified Data.HashMap.Strict as HM import Data.Semigroup+import Data.Text.Prettyprint.Doc import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Unboxed as U import qualified Data.Vector as V import qualified Data.Text as T+import Language.Haskell.TH.Lift+import Language.Haskell.TH import GHC.TypeLits import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen@@ -48,12 +54,30 @@ library = hrepeatFor (Proxy :: Proxy c) $ Comp Dict {-# INLINE library #-} +class (f x, g x) => And f g x+instance (f x, g x) => And f g x+ instance WrapForall Show h xs => Show (h :* xs) where   showsPrec d xs = showParen (d > 0)     $ henumerateFor (Proxy :: Proxy (Instance1 Show h)) xs     (\i r -> showsPrec 0 (hlookup i xs) . showString " <: " . r)     (showString "nil") +#if !MIN_VERSION_prettyprinter(1,2,1)+instance Pretty a => Pretty (Identity a) where+  pretty = pretty . runIdentity++instance Pretty a => Pretty (Const a b) where+  pretty = pretty . getConst+#endif++instance WrapForall Pretty h xs => Pretty (h :* xs) where+  pretty xs = align+    $ encloseSep (flatAlt "" "{ ") (flatAlt "" " }") (flatAlt "" "; ")+    $ henumerateFor (Proxy :: Proxy (Instance1 Pretty h)) xs+    (\i r -> pretty (hlookup i xs) : r)+    []+ instance WrapForall Eq h xs => Eq (h :* xs) where   xs == ys = henumerateFor (Proxy :: Proxy (Instance1 Eq h)) xs     (\i r -> hlookup i xs == hlookup i ys && r) True@@ -85,6 +109,18 @@   minBound = hrepeatFor (Proxy :: Proxy (Instance1 Bounded h)) minBound   maxBound = hrepeatFor (Proxy :: Proxy (Instance1 Bounded h)) maxBound +#if !MIN_VERSION_th_lift(0,7,9)+instance Lift a => Lift (Identity a) where+  lift = appE (conE 'Identity) . lift . runIdentity++instance Lift a => Lift (Const a b) where+  lift = appE (conE 'Const) . lift . getConst+#endif++instance WrapForall Lift h xs => Lift (h :* xs) where+  lift = hfoldrWithIndexFor (Proxy :: Proxy (Instance1 Lift h))+    (\_ x xs -> infixE (Just $ lift x) (varE '(<:)) (Just xs)) (varE 'nil)+ newtype instance U.MVector s (h :* xs) = MV_Product (Comp (U.MVector s) h :* xs) newtype instance U.Vector (h :* xs) = V_Product (Comp U.Vector h :* xs) @@ -223,6 +259,11 @@     (library :: Comp Dict (Instance1 Hashable h) :* xs)   {-# INLINE hashWithSalt #-} +instance WrapForall Lift h xs => Lift (h :| xs) where+  lift (EmbedAt i h) = views (pieceAt i)+    (\(Comp Dict) -> conE 'EmbedAt `appE` lift i `appE` lift h)+    (library :: Comp Dict (Instance1 Lift h) :* xs)+ instance WrapForall Arbitrary h xs => Arbitrary (h :| xs) where   arbitrary = choose (0, hcount (Proxy :: Proxy xs)) >>= henumerateFor       (Proxy :: Proxy (Instance1 Arbitrary h))@@ -234,6 +275,13 @@   shrink (EmbedAt i h) = views (pieceAt i)     (\(Comp Dict) -> EmbedAt i <$> shrink h)     (library :: Comp Dict (Instance1 Arbitrary h) :* xs)++instance WrapForall Pretty h xs => Pretty (h :| xs) where+  pretty (EmbedAt i h) = "EmbedAt "+    <> pretty i+    <> " "+    <> views (pieceAt i) (\(Comp Dict) -> pretty h)+    (library :: Comp Dict (Instance1 Pretty h) :* xs)  -- | Forall upon a wrapper type WrapForall c h = Forall (Instance1 c h)

@@ -36,8 +36,8 @@ import Control.Monad.State.Strict import Control.Monad.Writer.Class -instance Associate "IO" IO xs => MonadIO (Eff xs) where-  liftIO = liftEff (Proxy :: Proxy "IO")+instance (MonadIO m, Associate "IO" m xs) => MonadIO (Eff xs) where+  liftIO = liftEff (Proxy :: Proxy "IO") . liftIO  pReader :: Proxy "Reader" pReader = Proxy

@@ -1,7 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables, TypeFamilies #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE UndecidableSuperClasses, TypeInType #-} #endif@@ -40,6 +42,7 @@   , KeyValue   , proxyAssocKey   , proxyAssocValue+  , stringAssocKey   , KeyIs   , ValueIs   -- * Internal@@ -68,6 +71,8 @@ import Data.Functor.Identity import Data.Hashable import Data.Semigroup+import Data.String+import Data.Text.Prettyprint.Doc import Data.Typeable (Typeable) import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M@@ -75,6 +80,8 @@ import Foreign.Storable (Storable) import GHC.Generics (Generic) import GHC.TypeLits hiding (Nat)+import Language.Haskell.TH.Lift+import Language.Haskell.TH (appE, conE) import Test.QuickCheck.Arbitrary  -- | Take the type of the key@@ -85,10 +92,15 @@ proxyAssocKey :: proxy kv -> Proxy (AssocKey kv) proxyAssocKey _ = Proxy --- | Proxy-level 'AssocKey'. This is useful when using 'symbolVal'.+-- | Proxy-level 'AssocValue'. proxyAssocValue :: proxy kv -> Proxy (AssocValue kv) proxyAssocValue _ = Proxy +-- | Get a string from a proxy of @'Assoc' 'Symbol' v@.+stringAssocKey :: (IsString a, KnownSymbol (AssocKey kv)) => proxy kv -> a+stringAssocKey = fromString . symbolVal . proxyAssocKey+{-# INLINE stringAssocKey #-}+ -- | Take the type of the value type family AssocValue (kv :: Assoc k v) :: v where   AssocValue (k ':> v) = v@@ -193,6 +205,9 @@  instance (U.Unbox (h (AssocValue x))) => U.Unbox (Field h x) +instance Lift (h (AssocValue x)) => Lift (Field h x) where+  lift = appE (conE 'Field) . lift . getField+ -- | Lift a function for the content. liftField :: (g (AssocValue kv) -> h (AssocValue kv)) -> Field g kv -> Field h kv liftField = coerce@@ -214,6 +229,11 @@   showsPrec d (Field a) = showParen (d >= 1) $ showString (symbolVal (Proxy :: Proxy k))     . showString " @= "     . showsPrec 1 (view _Wrapper a)++instance (KnownSymbol k, Pretty (h v)) => Pretty (Field h (k ':> v)) where+  pretty (Field a) = fromString (symbolVal (Proxy :: Proxy k))+    <> ": "+    <> pretty a  -- | The type of records which contain several fields. --

@@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables, BangPatterns #-} {-# LANGUAGE StandaloneDeriving #-}@@ -63,8 +64,10 @@ import Control.Monad import Unsafe.Coerce import Data.Hashable+import Data.Text.Prettyprint.Doc import Data.Typeable import Language.Haskell.TH hiding (Pred)+import Language.Haskell.TH.Lift import Data.Semigroup (Semigroup(..)) import GHC.TypeLits @@ -84,6 +87,9 @@   { getMemberId :: Int -- ^ get the position as an 'Int'.   } deriving (Typeable, NFData) +instance Lift (Membership xs x) where+  lift (Membership i) = mkMembership i+ newtype Remembrance xs x r = Remembrance (Member xs x => r)  -- | Remember that @Member xs x@ from 'Membership'.@@ -138,6 +144,9 @@  instance Show (Membership xs x) where   show (Membership n) = "$(mkMembership " ++ show n ++ ")"++instance Pretty (Membership xs x) where+  pretty (Membership n) = "$(mkMembership " <> pretty n <> ")"  instance Eq (Membership xs x) where   _ == _ = True

@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase, TypeFamilies #-}+{-# LANGUAGE LambdaCase, TypeFamilies, TemplateHaskell #-} ------------------------------------------------------------------------ -- | -- Module      :  Data.Extensible.Nullable@@ -29,6 +29,8 @@ import Data.Profunctor.Unsafe import Data.Semigroup import GHC.Generics (Generic)+import Language.Haskell.TH.Lift+import Language.Haskell.TH (appE, conE) import Test.QuickCheck.Arbitrary  -- | Wrapped Maybe@@ -47,6 +49,9 @@   mappend (Nullable (Just a)) (Nullable (Just b)) = Nullable (Just (a <> b))   mappend a@(Nullable (Just _)) _ = a   mappend _ b = b++instance Lift (h a) => Lift (Nullable h a) where+  lift = appE (conE 'Nullable) . lift . getNullable  -- | Apply a function to its content. mapNullable :: (g x -> h y) -> Nullable g x -> Nullable h y

@@ -22,6 +22,7 @@   , happend   , hmap   , hmapWithIndex+  , hmapWithIndexFor   , hzipWith   , hzipWith3   , hfoldMap@@ -102,6 +103,14 @@ hmapWithIndex :: (forall x. Membership xs x -> g x -> h x) -> g :* xs -> h :* xs hmapWithIndex t p = hfrozen (newFrom p t) {-# INLINE hmapWithIndex #-}++-- | Map a function to every element of a product.+hmapWithIndexFor :: Forall c xs+  => proxy c+  -> (forall x. c x => Membership xs x -> g x -> h x)+  -> g :* xs -> h :* xs+hmapWithIndexFor c t p = hfrozen $ newFor c $ \i -> t i $ hlookup i p+{-# INLINE hmapWithIndexFor #-}  -- | Transform every element in a product, preserving the order. --

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveTraversable, StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Extensible.Wrapper@@ -26,9 +27,13 @@ import Data.Extensible.Internal.Rig import Data.Hashable import Data.Semigroup+import Data.Text.Prettyprint.Doc import GHC.Generics (Generic)+import Language.Haskell.TH.Lift+import Language.Haskell.TH (conE, appE) import Test.QuickCheck.Arbitrary + -- | The extensible data types should take @k -> *@ as a parameter. -- This class allows us to take a shortcut for direct representation. class Wrapper (h :: k -> *) where@@ -56,18 +61,25 @@   type Repr Maybe a = Maybe a   _Wrapper = id +instance Wrapper (Either e) where+  type Repr (Either e) a = Either e a+  _Wrapper = id+ instance Wrapper [] where   type Repr [] a = [a]   _Wrapper = id  -- | Poly-kinded composition newtype Comp (f :: j -> *) (g :: i -> j) (a :: i) = Comp { getComp :: f (g a) }-  deriving (Show, Eq, Ord, Typeable, NFData, Generic, Semigroup, Monoid, Arbitrary, Hashable)+  deriving (Show, Eq, Ord, Typeable, NFData, Generic, Semigroup, Monoid, Arbitrary, Hashable, Pretty)  deriving instance (Functor f, Functor g) => Functor (Comp f g) deriving instance (Foldable f, Foldable g) => Foldable (Comp f g) deriving instance (Traversable f, Traversable g) => Traversable (Comp f g) +instance Lift (f (g a)) => Lift (Comp f g a) where+  lift = appE (conE 'Comp) . lift . getComp+ -- | Wrap a result of 'fmap' comp :: Functor f => (a -> g b) -> f a -> Comp f g b comp f = Comp #. fmap f@@ -80,7 +92,7 @@  -- | Poly-kinded Const newtype Const' a x = Const' { getConst' :: a }-  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Functor, Foldable, Traversable, Arbitrary, Hashable)+  deriving (Show, Eq, Ord, Typeable, Generic, NFData, Semigroup, Monoid, Functor, Foldable, Traversable, Arbitrary, Hashable)  instance Wrapper (Const' a) where   type Repr (Const' a) b = a