packages feed

extensible 0.2.10 → 0.3

raw patch · 11 files changed

+114/−113 lines, 11 files

Files

CHANGELOG.md view
@@ -1,3 +1,16 @@+0.3+-----------------------------------------------------+* Renamed `generate` to `htabulate`+* Renamed `generateA` to `hgenerate`+* Renamed `generateFor` to `htabulateFor`+* Renamed `generateForA` to `hgenerateFor`+* Renamed `htabulate` to `hmapWithIndex`+* Added `(<@=>)`+* Added `Comp`+* Fixed badly-specialized `htraverse`+* Added `hsequence`, `hdistribute`, `hcollect`+* Added `hindex`+ 0.2.10 ----------------------------------------------------- * Optimized `sector` (~2x)
− benchmarks/test.hs 
@@ -1,16 +0,0 @@-{-# LANGUAGE TypeOperators #-}-import Data.Extensible-import AtoZ-import Unsafe.Coerce-import Control.Applicative---- | @'views' :: Lens' s a -> (a -> r) -> (s -> r)@-views :: ((a -> Const r a) -> (s -> Const r s)) -> (a -> r) -> s -> r-views = unsafeCoerce-{-# INLINE views #-}--pluck' :: (x ∈ xs) => AllOf xs -> x-pluck' = views (sectorAt membership) getK0-{-# INLINE pluck' #-}--main = print (pluck' extensible26 :: A)
− examples/test.hs 
@@ -1,7 +0,0 @@-import Data.Extensible--test = (42 :: Int) <% "hoge" <% False <% Nil--value = pluck test :: Int--main = print value
extensible.cabal view
@@ -1,5 +1,5 @@ name:                extensible-version:             0.2.10+version:             0.3 synopsis:            Extensible, efficient, lens-friendly data types homepage:            https://github.com/fumieval/extensible bug-reports:         http://github.com/fumieval/extensible/issues@@ -32,7 +32,6 @@     Data.Extensible.Inclusion     Data.Extensible.Internal     Data.Extensible.Internal.Rig-    Data.Extensible.Internal.HList     Data.Extensible.Dictionary     Data.Extensible.League     Data.Extensible.Match
src/Data/Extensible.hs view
@@ -31,6 +31,8 @@   , module Data.Extensible.Product   , module Data.Extensible.Sum   , module Data.Extensible.Union+  , Comp(..)+  , comp   ) where import Data.Extensible.Inclusion import Data.Extensible.Match@@ -40,6 +42,7 @@ import Data.Extensible.League import Data.Extensible.Union import Data.Extensible.Record+import Data.Extensible.Internal.Rig import Data.Extensible.Dictionary ()  -------------------------------------------------------------
src/Data/Extensible/Dictionary.hs view
@@ -31,27 +31,27 @@ instance Reifiable Show where   data Dictionary Show h x = DictShow { getShowsPrec :: Int -> h x -> ShowS }   library :: forall h xs. WrapForall Show h xs => Dictionary Show h :* xs-  library = generateFor (Proxy :: Proxy (Instance1 Show h)) $ const $ DictShow showsPrec+  library = htabulateFor (Proxy :: Proxy (Instance1 Show h)) $ const $ DictShow showsPrec  instance Reifiable Eq where   data Dictionary Eq h x = DictEq { getEq :: h x -> h x -> Bool }   library :: forall h xs. WrapForall Eq h xs => Dictionary Eq h :* xs-  library = generateFor (Proxy :: Proxy (Instance1 Eq h)) $ const $ DictEq (==)+  library = htabulateFor (Proxy :: Proxy (Instance1 Eq h)) $ const $ DictEq (==)  instance Reifiable Ord where   data Dictionary Ord h x = DictOrd { getCompare :: h x -> h x -> Ordering }   library :: forall h xs. WrapForall Ord h xs => Dictionary Ord h :* xs-  library = generateFor (Proxy :: Proxy (Instance1 Ord h)) $ const $ DictOrd compare+  library = htabulateFor (Proxy :: Proxy (Instance1 Ord h)) $ const $ DictOrd compare  instance Reifiable Monoid where   data Dictionary Monoid h x = DictMonoid { getMempty :: h x, getMappend :: h x -> h x -> h x }   library :: forall h xs. WrapForall Monoid h xs => Dictionary Monoid h :* xs-  library = generateFor (Proxy :: Proxy (Instance1 Monoid h)) $ const $ DictMonoid mempty mappend+  library = htabulateFor (Proxy :: Proxy (Instance1 Monoid h)) $ const $ DictMonoid mempty mappend  instance Reifiable B.Binary where   data Dictionary B.Binary h x = DictBinary { getGet :: B.Get (h x), getPut :: h x -> B.Put }   library :: forall h xs. WrapForall B.Binary h xs => Dictionary B.Binary h :* xs-  library = generateFor (Proxy :: Proxy (Instance1 B.Binary h)) $ const $ DictBinary B.get B.put+  library = htabulateFor (Proxy :: Proxy (Instance1 B.Binary h)) $ const $ DictBinary B.get B.put  instance WrapForall Show h xs => Show (h :* xs) where   showsPrec d = showParen (d > 0)@@ -78,7 +78,7 @@   {-# INLINE mappend #-}  instance WrapForall B.Binary h xs => B.Binary (h :* xs) where-  get = generateForA (Proxy :: Proxy (Instance1 B.Binary h)) (const B.get)+  get = hgenerateFor (Proxy :: Proxy (Instance1 B.Binary h)) (const B.get)   put = flip appEndo (return ()) . hfoldMap getConst' . hzipWith (\dic x -> Const' $ Endo $ (getPut dic x >>)) library  instance WrapForall Show h xs => Show (h :| xs) where
src/Data/Extensible/Inclusion.hs view
@@ -50,7 +50,7 @@  -- | Reify the inclusion of type level sets. inclusion :: forall xs ys. Include ys xs => Membership ys :* xs-inclusion = generateFor (Proxy :: Proxy (Member ys)) (const membership)+inclusion = htabulateFor (Proxy :: Proxy (Member ys)) (const membership)  -- | /O(m log n)/ Select some elements. shrink :: (xs ⊆ ys) => h :* ys -> h :* xs@@ -71,9 +71,9 @@  -- | The inverse of 'inclusion'. coinclusion :: (Include ys xs, Generate ys) => Nullable (Membership xs) :* ys-coinclusion = flip appEndo (generate (const Null))+coinclusion = flip appEndo (htabulate (const Null))   $ hfoldMap getConst'-  $ htabulate (\src dst -> Const' $ Endo $ sectorAt dst `over` const (Eine src))+  $ hmapWithIndex (\src dst -> Const' $ Endo $ sectorAt dst `over` const (Eine src))   $ inclusion  -- | Extend a product and fill missing fields by 'Null'.
− src/Data/Extensible/Internal/HList.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}------------------------------------------------------------------------------ Module      :  Data.Extensible.Internal.HList--- Copyright   :  (c) Fumiaki Kinoshita 2015--- License     :  BSD3------ Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>--- Stability   :  experimental--- Portability :  non-portable-------------------------------------------------------------------------------module Data.Extensible.Internal.HList where--import Data.Extensible.Internal--data HList (h :: k -> *) (s :: [k]) where-  HNil :: HList h '[]-  HCons :: h x -> HList h xs -> HList h (x ': xs)--infixr 5 `HCons`--merge :: HList h xs -> HList h ys -> HList h (Merge xs ys)-merge (HCons x xs) (HCons y ys) = x `HCons` y `HCons` merge xs ys-merge HNil ys = ys-merge xs HNil = xs--split :: forall h xs. HList h xs -> (HList h (Half xs), HList h (Half (Tail xs)))-split (HCons x (HCons y ys)) = let (a, b) = split ys-  in (HCons x a, lemmaHalfTail (Proxy :: Proxy (Tail (Tail xs))) $ HCons y b)-split (HCons x HNil) = (HCons x HNil, HNil)-split HNil = (HNil, HNil)
src/Data/Extensible/Internal/Rig.hs view
@@ -57,6 +57,12 @@ -- | Turn a wrapper type into one clause that returns @a@. newtype Match h a x = Match { runMatch :: h x -> a } deriving Typeable +newtype Comp f g a = Comp { getComp :: f (g a) }++comp :: Functor f => (a -> g b) -> f a -> Comp f g b+comp f = Comp . fmap f+{-# INLINE comp #-}+ -- | Poly-kinded Maybe data Nullable h x = Null | Eine (h x) deriving (Show, Eq, Ord, Typeable)
src/Data/Extensible/Product.hs view
@@ -22,28 +22,28 @@   , htail   , huncons   , hmap+  , hmapWithIndex   , htrans   , hzipWith   , hzipWith3   , hfoldMap   , htraverse-  , htabulate+  , hsequence+  , hcollect+  , hdistribute   -- * Lookup   , hlookup+  , hindex   , sector   , sectorAt   -- * Generation   , Generate(..)-  , generate+  , htabulate   , Forall(..)-  , generateFor-  -- * HList-  , fromHList-  , toHList) where+  , htabulateFor) where  import Data.Extensible.Internal import Data.Extensible.Internal.Rig-import Data.Extensible.Internal.HList import Unsafe.Coerce import Control.Applicative import Data.Monoid@@ -77,6 +77,11 @@ infixr 0 <:  -- | Transform every elements in a product, preserving the order.+--+-- @+-- 'hmap' 'id' ≡ 'id'+-- 'hmap' (f . g) ≡ 'hmap' f . 'hmap' g+-- @ hmap :: (forall x. g x -> h x) -> g :* xs -> h :* xs hmap t (Tree h a b) = Tree (t h) (hmap t a) (hmap t b) hmap _ Nil = Nil@@ -105,28 +110,55 @@ hzipWith3 _ _ Nil _ = Nil hzipWith3 _ _ _ Nil = Nil --- | Combine all elements.+-- | Map elements to a monoid and combine the results.+--+-- @'hfoldMap' f . 'hmap' g ≡ 'hfoldMap' (f . g)@ hfoldMap :: Monoid a => (forall x. h x -> a) -> h :* xs -> a hfoldMap f (Tree h a b) = f h <> hfoldMap f a <> hfoldMap f b hfoldMap _ Nil = mempty --- | Traverse all elements.-htraverse :: Applicative f => (forall x. h x -> f (h x)) -> h :* xs -> f (h :* xs)+-- | Traverse all elements and combine the result sequentially.+-- @+-- htraverse (fmap f . g) ≡ fmap (hmap f) . htraverse g+-- htraverse pure ≡ pure+-- htraverse (Comp . fmap g . f) ≡ Comp . fmap (htraverse g) . htraverse f+-- @+htraverse :: Applicative f => (forall x. g x -> f (h x)) -> g :* xs -> f (h :* xs) htraverse f (Tree h a b) = Tree <$> f h <*> htraverse f a <*> htraverse f b htraverse _ Nil = pure Nil +-- | 'sequence' analog for extensible products+hsequence :: Applicative f => Comp f h :* xs -> f (h :* xs)+hsequence = htraverse getComp+{-# INLINE hsequence #-}++-- | The dual of 'htraverse'+hcollect :: (Functor f, Generate xs) => (a -> h :* xs) -> f a -> Comp f h :* xs+hcollect f m = htabulate $ \pos -> Comp $ fmap (hlookup pos . f) m+{-# INLINABLE hcollect #-}++-- | The dual of 'hsequence'+hdistribute :: (Functor f, Generate xs) => f (h :* xs) -> Comp f h :* xs+hdistribute = hcollect id+{-# INLINE hdistribute #-}+ -- | /O(log n)/ Pick up an elemtnt. hlookup :: Membership xs x -> h :* xs -> h x hlookup = view . sectorAt-{-# INLINE hlookup #-}+{-# INLINABLE hlookup #-} +-- | Flipped 'hlookup'+hindex :: h :* xs -> Membership xs x -> h x+hindex = flip hlookup+{-# INLINE hindex #-}+ -- | 'hmap' with its indices.-htabulate :: forall g h xs. (forall x. Membership xs x -> g x -> h x) -> g :* xs -> h :* xs-htabulate f = go id where+hmapWithIndex :: forall g h xs. (forall x. Membership xs x -> g x -> h x) -> g :* xs -> h :* xs+hmapWithIndex f = go id where   go :: (forall x. Membership t x -> Membership xs x) -> g :* t -> h :* t   go k (Tree g a b) = Tree (f (k here) g) (go (k . navL) a) (go (k . navR) b)   go _ Nil = Nil-{-# INLINE htabulate #-}+{-# INLINE hmapWithIndex #-}  -- | /O(log n)/ A lens for a specific element. sector :: forall h x xs. (x ∈ xs) => Lens' (h :* xs) (h x)@@ -146,49 +178,45 @@  -- | Given a function that maps types to values, we can "collect" entities all you want. class Generate (xs :: [k]) where-  -- | /O(n)/ generates a product with the given function.-  generateA :: Applicative f => (forall x. Membership xs x -> f (h x)) -> f (h :* xs)+  -- | /O(n)/ htabulates a product with the given function.+  hgenerate :: Applicative f => (forall x. Membership xs x -> f (h x)) -> f (h :* xs)  instance Generate '[] where-  generateA _ = pure Nil-  {-# INLINE generateA #-}+  hgenerate _ = pure Nil+  {-# INLINE hgenerate #-}  instance (Generate (Half xs), Generate (Half (Tail xs))) => Generate (x ': xs) where-  generateA f = Tree <$> f here <*> generateA (f . navL) <*> generateA (f . navR)-  {-# INLINE generateA #-}+  hgenerate f = Tree <$> f here <*> hgenerate (f . navL) <*> hgenerate (f . navR)+  {-# INLINE hgenerate #-} --- | Pure version of 'generateA'.-generate :: Generate xs => (forall x. Membership xs x -> h x) -> h :* xs-generate f = getK0 (generateA (K0 . f))-{-# INLINE generate #-}+-- | Pure version of 'hgenerate'.+--+-- @+-- 'hmap' f ('htabulate' g) ≡ 'htabulate' (f . g)+-- 'htabulate' ('hindex' m) ≡ m+-- 'hindex' ('htabulate' k) ≡ k+-- @+htabulate :: Generate xs => (forall x. Membership xs x -> h x) -> h :* xs+htabulate f = getK0 (hgenerate (K0 . f))+{-# INLINE htabulate #-}  -- | Guarantees the all elements satisfies the predicate. class Forall c (xs :: [k]) where-  -- | /O(n)/ Analogous to 'generate', but it also supplies a context @c x@ for every elements in @xs@.-  generateForA :: Applicative f => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (h :* xs)+  -- | /O(n)/ Analogous to 'htabulate', but it also supplies a context @c x@ for every elements in @xs@.+  hgenerateFor :: Applicative f => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (h :* xs)  instance Forall c '[] where-  generateForA _ _ = pure Nil-  {-# INLINE generateForA #-}+  hgenerateFor _ _ = pure Nil+  {-# INLINE hgenerateFor #-}  instance (c x, Forall c (Half xs), Forall c (Half (Tail xs))) => Forall c (x ': xs) where-  generateForA proxy f = Tree+  hgenerateFor proxy f = Tree     <$> f here-    <*> generateForA proxy (f . navL)-    <*> generateForA proxy (f . navR)-  {-# INLINE generateForA #-}---- | Pure version of 'generateForA'.-generateFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> h x) -> h :* xs-generateFor p f = getK0 (generateForA p (K0 . f))-{-# INLINE generateFor #-}---- | Turn a product into 'HList'.-toHList :: h :* xs -> HList h xs-toHList (Tree h a b) = HCons h $ lemmaMerging $ toHList a `merge` toHList b-toHList Nil = HNil+    <*> hgenerateFor proxy (f . navL)+    <*> hgenerateFor proxy (f . navR)+  {-# INLINE hgenerateFor #-} --- | Build a product from 'HList'.-fromHList :: HList h xs -> h :* xs-fromHList (HCons x xs) = let (a, b) = split xs in Tree x (fromHList a) (fromHList b)-fromHList HNil = Nil+-- | Pure version of 'hgenerateFor'.+htabulateFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> h x) -> h :* xs+htabulateFor p f = getK0 (hgenerateFor p (K0 . f))+{-# INLINE htabulateFor #-}
src/Data/Extensible/Record.hs view
@@ -19,6 +19,7 @@   , (<:*)   , (:*)(Nil)   , (@=)+  , (<@=>)   , mkField   , recordType   , Field(..)@@ -31,6 +32,7 @@   ) where import Data.Extensible.Product import Data.Extensible.Internal+import Data.Extensible.Internal.Rig import Language.Haskell.TH import Language.Haskell.TH.Quote import GHC.TypeLits hiding (Nat)@@ -85,6 +87,12 @@ (@=) _ = Field {-# INLINE (@=) #-} infix 1 @=++-- | Lifted ('@=')+(<@=>) :: Functor f => FieldName s -> f (FieldValue s) -> Comp f Field s+(<@=>) _ = comp Field+{-# INLINE (<@=>) #-}+infix 1 <@=>  -- | Generate a field. -- @'mkField' "foo" [t|Int|]@ defines: