fixed-vector-hetero 0.5.0.0 → 0.6.0.0

raw patch · 8 files changed

+526/−112 lines, 8 filesdep +doctestdep +fixed-vector-heterodep ~basedep ~fixed-vectorbuild-type:Customsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: doctest, fixed-vector-hetero

Dependency ranges changed: base, fixed-vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +14/−0
• Data/Vector/HFixed.hs +279/−77
• Data/Vector/HFixed/Class.hs +119/−27
• Data/Vector/HFixed/Cont.hs +32/−1
• Data/Vector/HFixed/HVec.hs +1/−2
• Setup.hs +31/−0
• fixed-vector-hetero.cabal +38/−5
• test/doctests.hs +12/−0

@@ -1,3 +1,17 @@+Changes in 0.6.0.0++  * Type class `TyLookup` and `tyLookup` & `tyLookupF` added for lookup up field+    by its type.++  * `:&&:` type class for composing constraints added++  * `Data.Vector.HFixed.fold` removed since it was completely unusable+  +  * `index` and `set` from `Data.Vector.HFixed` use GHC's Nats for indexing++  * Documentation improvements and doctests test suite++ Changes in 0.5.0.0    * GHC8.4 compatibility release. Semigroup instance is added for HVec

@@ -11,77 +11,105 @@ {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE UndecidableInstances  #-} -- |--- Heterogeneous vectors.+-- This module provides function for working with product types and+-- comes in two variants. First works with plain product, types like+-- @(a,b)@ or @data Prod = Prod A B@, etc. Second one is for+-- parameterized products (it seems there's no standard name for+-- them), that is types like: @data ProdF f = ProdF (f Int) (f Char)@.+--+-- Most examples in this module use tuple but library is not limited+-- to them in any way. They're just in base and convenient to work+-- with. module Data.Vector.HFixed (     -- * HVector type classes-    Arity-  , ArityC-  , HVector(..)+    HVector(..)   , tupleSize   , HVectorF(..)   , tupleSizeF-  , Proxy(..)   , ContVec   , ContVecF(..)   , asCVec   , asCVecF-    -- * Position based functions+    -- * Plain product types+    -- ** Construction+    -- *** Simple constructor+    -- $construction+  , mk0+  , mk1+  , mk2+  , mk3+  , mk4+  , mk5+    -- *** Unfoldr & replicate+  , unfoldr+  , replicate+  , replicateM+  -- ** Position based functions   , convert   , head   , tail   , cons   , concat-    -- ** Indexing+    -- *** Indexing   , ValueAt   , Index   , index   , set   , element   , elementCh-    -- * Generic constructors-  , mk0-  , mk1-  , mk2-  , mk3-  , mk4-  , mk5-    -- * Folds and unfolds-  , fold+  , tyLookup+  , tyLookupF+    -- ** Folds & unfolds   , foldr   , foldl-  , foldrF-  , foldlF-  , foldrNatF-  , foldlNatF   , mapM_-  , unfoldr+    -- ** Zips+  , zipWith+  , zipFold+    -- ** Specializations+  , eq+  , compare+  , rnf+    -- * Parametrized products+    -- ** Construction+    -- *** Simple constructors+    -- $construction_F+  , mk0F+  , mk1F+  , mk2F+  , mk3F+  , mk4F+  , mk5F+    -- *** Unfoldr & replicate   , unfoldrF-    -- ** Replicate variants-  , replicate-  , replicateM   , replicateF   , replicateNatF-    -- ** Zip variants-  , zipWith-  , zipWithF-  , zipWithNatF-  , zipFold-  , zipFoldF+    -- ** Conversion to\/from products+  , wrap+  , unwrap   , monomorphize   , monomorphizeF-    -- ** Tuples parametrized with type constructor+    -- ** Functor\/Applicative like+  , map   , mapNat   , sequence   , sequence_   , sequenceF-  , wrap-  , unwrap   , distribute   , distributeF-    -- * Specialized operations-  , eq-  , compare-  , rnf+    -- ** Folds and unfolds+  , foldrF+  , foldlF+  , foldrNatF+  , foldlNatF+    -- ** Zips+  , zipWithF+  , zipWithNatF+  , zipFoldF+    -- ** Reexports+  , Arity+  , ArityC+  , Proxy(..)   ) where  import Control.Applicative  (Applicative(..),(<$>))@@ -125,12 +153,17 @@  -- | We can convert between any two vector which have same --   structure but different representations.+--+-- >>> convert (1 :+ 2) :: (Double,Double)+-- (1.0,2.0) convert :: (HVector v, HVector w, Elems v ~ Elems w)         => v -> w {-# INLINE convert #-} convert v = inspect v construct --- | Tail of the vector+-- | Tail of the vector. Note that in the example we only tell GHC+--   that resulting value is 2-tuple via pattern matching and let+--   typechecker figure out the rest. -- -- >>> case tail ('a',"aa",()) of x@(_,_) -> x -- ("aa",())@@ -141,19 +174,27 @@   -- | Head of the vector+--+-- >>> head ('a',"ABC")+-- 'a' head :: (HVector v, Elems v ~ (a : as), Arity as)      => v -> a {-# INLINE head #-} head = C.head . C.cvec --- | Prepend element to the list. Note that it changes type of vector---   so it either must be known from context of specified explicitly+-- | Prepend element to the product.+--+-- >>> cons 'c' ('d','e') :: (Char,Char,Char)+-- ('c','d','e') cons :: (HVector v, HVector w, Elems w ~ (a : Elems v))      => a -> v -> w {-# INLINE cons #-} cons a = C.vector . C.cons a . C.cvec  -- | Concatenate two vectors+--+-- >>> concat ('c','d') ('e','f') :: (Char,Char,Char,Char)+-- ('c','d','e','f') concat :: ( HVector v, HVector u, HVector w           , Elems w ~ (Elems v ++ Elems u)           )@@ -167,62 +208,98 @@ -- Indexing ---------------------------------------------------------------- --- | Index heterogeneous vector-index :: (Index n (Elems v), HVector v) => v -> proxy n -> ValueAt n (Elems v)+-- | Index heterogeneous vector.+--+-- >>> index (Proxy @0) ('c',"str")+-- 'c'+-- >>> index (Proxy @1) ('c',"str")+-- "str"+index+  :: forall n v proxy. (Index (Peano n) (Elems v), HVector v)+  => proxy n                     -- ^ Type level index+  -> v                           -- ^ Vector to index+  -> ValueAt (Peano n) (Elems v) {-# INLINE index #-}-index = C.index . C.cvec+index _ v = C.index (C.cvec v) (Proxy @(Peano n)) + -- | Set element in the vector-set :: (Index n (Elems v), HVector v)-       => proxy n -> ValueAt n (Elems v) -> v -> v+--+-- >>> set (Proxy @0) 'X' ('_',"str")+-- ('X',"str")+set :: forall n v proxy. (Index (Peano n) (Elems v), HVector v)+    => proxy n                     -- ^ Type level index+    -> ValueAt (Peano n) (Elems v) -- ^ New value at index+    -> v+    -> v {-# INLINE set #-}-set n x = C.vector-        . C.set n x+set _ x = C.vector+        . C.set (Proxy @(Peano n)) x         . C.cvec  -- | Twan van Laarhoven's lens for i'th element.-element :: forall n v a f proxy.-           ( Index   (Peano n) (Elems v)-           , ValueAt (Peano n) (Elems v) ~ a+element :: forall n v proxy.+           ( Index (Peano n) (Elems v)            , HVector v-           , Functor f            )-        => proxy n -> (a -> f a) -> (v -> f v)+        => proxy n              -- ^ Type level index+        -> Lens' v (ValueAt (Peano n) (Elems v)) {-# INLINE element #-} element _ f v = inspect v-              $ lensF (Proxy @ (Peano n)) f construct+              $ lensF (Proxy @(Peano n)) f construct  -- | Type changing Twan van Laarhoven's lens for i'th element.-elementCh :: forall n v w a b f proxy.+elementCh :: forall n v w a b proxy.              ( Index   (Peano n) (Elems v)              , ValueAt (Peano n) (Elems v) ~ a              , HVector v              , HVector w              , Elems w ~ NewElems (Peano n) (Elems v) b-             , Functor f              )-          => proxy n -> (a -> f b) -> (v -> f w)+          => proxy n            -- ^ Type level index+          -> Lens v w a b {-# INLINE elementCh #-} elementCh _ f v = inspect v-                $ lensChF (Proxy @ (Peano n)) f construct+                $ lensChF (Proxy @(Peano n)) f construct  +-- | Lookup field from product by its type. Product must contain one+--   and only one field of type @a@+--+-- >>> tyLookup ('c',"str") :: Char+-- 'c'+--+-- >>> tyLookup ('c',"str") :: Int+-- ...+--     • Cannot find type:+--       Int+--     • In the expression: tyLookup ('c', "str") :: Int+--       In an equation for ‘it’: it = tyLookup ('c', "str") :: Int+--+-- >>> tyLookup ('c','c') :: Char+-- ...+--     • Duplicate type found:+--       Char+--     • In the expression: tyLookup ('c', 'c') :: Char+--       In an equation for ‘it’: it = tyLookup ('c', 'c') :: Char+tyLookup :: (HVector v, TyLookup a (Elems v)) => v -> a+tyLookup = C.tyLookup . C.cvec+{-# INLINE tyLookup #-} +-- | Analog of 'tyLookup' for @HVectorF@+tyLookupF :: (HVectorF v, TyLookup a (ElemsF v)) => v f -> f a+tyLookupF = C.tyLookupF . C.cvecF+{-# INLINE tyLookupF #-}++ ---------------------------------------------------------------- -- Folds over vector ---------------------------------------------------------------- --- | Most generic form of fold which doesn't constrain elements id use---   of 'inspect'. Or in more convenient form below:------ >>> fold (12::Int,"Str") (\a s -> show a ++ s)--- "12Str"-fold :: HVector v => v -> Fn Identity (Elems v) r -> r--- FIXME: Not really useable-fold v f = inspect v (TFun f)-{-# INLINE fold #-}- -- | Right fold over heterogeneous vector+--+-- >>> foldr (Proxy @Show) (\x str -> show x : str) [] (12,'c')+-- ["12","'c'"] foldr :: (HVector v, ArityC c (Elems v))       => Proxy c -> (forall a. c a => a -> b -> b) -> b -> v -> b {-# INLINE foldr #-}@@ -282,6 +359,20 @@ -- Constructors ---------------------------------------------------------------- +-- $construction+--+-- Functions below allow to construct products up to 5 elements. Here+-- are example for product types from base:+--+-- >>> mk0 :: ()+-- ()+--+-- >>> mk3 12 'x' "xyz" :: (Int,Char,String)+-- (12,'x',"xyz")+--+-- >>> mk2 0 1 :: Complex Double+-- 0.0 :+ 1.0+ mk0 :: forall v. (HVector v, Elems v ~ '[]) => v mk0 = coerce (construct :: Fun '[] v) {-# INLINE mk0 #-}@@ -312,18 +403,74 @@ {-# INLINE mk5 #-}  +-- $construction_F+--+-- Construction function for parametrized products are fully+-- analogous to plain products:+--+-- >>>mk2F (Identity 'c') (Identity 1) :: HVecF '[Char, Int] Identity+-- [Identity 'c',Identity 1]+--+-- >>>mk2F (Nothing) (Just 1) :: HVecF '[Char, Int] Maybe+-- [Nothing,Just 1] +mk0F :: forall f v. (HVectorF v, ElemsF v ~ '[]) => v f+mk0F = coerce (constructF :: TFun f '[] (v f))+{-# INLINE mk0F #-}++mk1F :: forall f v a. (HVectorF v, ElemsF v ~ '[a])+     => f a -> v f+mk1F = coerce (constructF :: TFun f '[a] (v f))+{-# INLINE mk1F #-}++mk2F :: forall f v a b. (HVectorF v, ElemsF v ~ '[a,b])+     => f a -> f b -> v f+mk2F = coerce (constructF :: TFun f '[a,b] (v f))+{-# INLINE mk2F #-}++mk3F :: forall f v a b c. (HVectorF v, ElemsF v ~ '[a,b,c])+     => f a -> f b -> f c -> v f+mk3F = coerce (constructF :: TFun f '[a,b,c] (v f))+{-# INLINE mk3F #-}++mk4F :: forall f v a b c d. (HVectorF v, ElemsF v ~ '[a,b,c,d])+     => f a -> f b -> f c -> f d -> v f+mk4F = coerce (constructF :: TFun f '[a,b,c,d] (v f))+{-# INLINE mk4F #-}++mk5F :: forall f v a b c d e. (HVectorF v, ElemsF v ~ '[a,b,c,d,e])+     => f a -> f b -> f c -> f d -> f e -> v f+mk5F = coerce (constructF :: TFun f '[a,b,c,d,e] (v f))+{-# INLINE mk5F #-}+++ ---------------------------------------------------------------- -- Collective operations ---------------------------------------------------------------- +-- | Apply function to every value of parametrized product.+--+-- >>> map (Proxy @Num) (Identity . fromMaybe 0) (mk2F (Just 12) Nothing :: HVecF '[Double, Int] Maybe)+-- [Identity 12.0,Identity 0]+map :: (HVectorF v, ArityC c (ElemsF v))+    => Proxy c -> (forall a. c a => f a -> g a) -> v f -> v g+{-# INLINE map #-}+map cls f = C.vectorF . C.map cls f . C.cvecF+ -- | Apply natural transformation to every element of the tuple.+--+-- >>> mapNat (Just . runIdentity) (mk2F (pure 'c') (pure 1) :: HVecF '[Char, Int] Identity)+-- [Just 'c',Just 1] mapNat :: (HVectorF v)-           => (forall a. f a -> g a) -> v f -> v g+       => (forall a. f a -> g a) -> v f -> v g {-# INLINE mapNat #-} mapNat f = C.vectorF . C.mapNat f . C.cvecF  -- | Sequence effects for every element in the vector+--+-- >>> sequence (mk2F [1,2] "ab" :: HVecF '[Int,Char] []) :: [(Int,Char)]+-- [(1,'a'),(1,'b'),(2,'a'),(2,'b')] sequence   :: ( Applicative f, HVectorF v, HVector w, ElemsF v ~ Elems w )   => v f -> f w@@ -383,21 +530,29 @@ -- | Replicate polymorphic value n times. Concrete instance for every --   element is determined by their respective types. ----- >>> import Data.Vector.HFixed as H--- >>> H.replicate (Proxy :: Proxy Monoid) mempty :: ((),String)+-- >>> replicate (Proxy :: Proxy Monoid) mempty :: ((),String) -- ((),"")+--+-- Or a bit contrived example which illustrate what how to call+-- function that require multiple type class constraints:+--+-- >>> replicate (Proxy @(Monoid :&&: Num)) (mempty * 10) :: (Product Int, Sum Int)+-- (Product {getProduct = 10},Sum {getSum = 0}) replicate :: (HVector v, ArityC c (Elems v))           => Proxy c -> (forall x. c x => x) -> v {-# INLINE replicate #-} replicate c x = C.vector $ C.replicateF c (Identity x) --- | Replicate monadic action n times.+-- | Replicate monadic action n times. Example below is a bit awkward does convey what's ----- >>> import Data.Vector.HFixed as H--- >>> H.replicateM (Proxy :: Proxy Read) (fmap read getLine) :: IO (Int,Char)--- > 12--- > 'a'--- (12,'a')+-- >>> :{+--   Prelude.mapM_ print+--     (replicateM (Proxy @(Monoid :&&: Num)) [mempty+1, mempty * 10] :: [(Product Int, Sum Int)])+-- :}+-- (Product {getProduct = 2},Sum {getSum = 1})+-- (Product {getProduct = 2},Sum {getSum = 0})+-- (Product {getProduct = 10},Sum {getSum = 1})+-- (Product {getProduct = 10},Sum {getSum = 0}) replicateM :: (HVector v, Applicative f, ArityC c (Elems v))            => Proxy c -> (forall a. c a => f a) -> f v {-# INLINE replicateM #-}@@ -406,11 +561,19 @@   $ C.sequenceF   $ C.replicateF c (Compose $ fmap Identity x) +-- | Replicate value @f a@ which is valid for every type a n times.+--+-- >>> replicateNatF Nothing :: HVecF '[Char,Int] Maybe+-- [Nothing,Nothing] replicateNatF :: (HVectorF v, Arity (ElemsF v))            => (forall a. f a) -> v f {-# INLINE replicateNatF #-} replicateNatF x = C.vectorF $ C.replicateNatF x +-- | Replicate polymorphic value n times:+--+-- >>> replicateF (Proxy @Num) (Just 0) :: HVecF '[Double,Int] Maybe+-- [Just 0.0,Just 0] replicateF :: (HVectorF v, ArityC c (ElemsF v))             => Proxy c -> (forall a. c a => f a) -> v f {-# INLINE replicateF #-}@@ -423,6 +586,9 @@ ----------------------------------------------------------------  -- | Zip two heterogeneous vectors+--+-- >>> zipWith (Proxy @Num) (+) (0, 1.2) (1, 10) :: (Int,Double)+-- (1,11.2) zipWith :: (HVector v, ArityC c (Elems v))         => Proxy c -> (forall a. c a => a -> a -> a) -> v -> v -> v {-# INLINE zipWith #-}@@ -444,6 +610,11 @@ zipWithNatF f v u   = C.vectorF $ C.zipWithNatF f (C.cvecF v) (C.cvecF u) +-- | Zip two heterogeneous vectors and immediately fold resulting+--   value.+--+-- >>> zipFold (Proxy @Show) (\a b -> show (a,b)) ((),'c',10) ((),'D',1)+-- "((),())('c','D')(10,1)" zipFold :: (HVector v, ArityC c (Elems v), Monoid m)         => Proxy c -> (forall a. c a => a -> a -> m) -> v -> v -> m {-# INLINE zipFold #-}@@ -477,11 +648,22 @@   -- | Generic equality for heterogeneous vectors+--+-- >>> data A = A Int Char deriving Generic+-- >>> instance HVector A+-- >>> eq (A 1 'c') (A 2 'c')+-- False eq :: (HVector v, ArityC Eq (Elems v)) => v -> v -> Bool eq v u = getAll $ zipFold (Proxy :: Proxy Eq) (\x y -> All (x == y)) v u {-# INLINE eq #-} --- | Generic comparison for heterogeneous vectors+-- | Generic comparison for heterogeneous vectors. It works same way+--   as Ord instance for tuples.+--+-- >>> data A = A Int Char deriving Generic+-- >>> instance HVector A+-- >>> compare (A 1 'c') (A 2 'c')+-- LT compare :: (HVector v, ArityC Ord (Elems v)) => v -> v -> Ordering compare = zipFold (Proxy :: Proxy Ord) Prelude.compare {-# INLINE compare #-}@@ -490,3 +672,23 @@ rnf :: (HVector v, ArityC NF.NFData (Elems v)) => v -> () rnf = foldl (Proxy :: Proxy NF.NFData) (\r a -> NF.rnf a `seq` r) () {-# INLINE rnf #-}+++----------------------------------------------------------------+-- Doctest+----------------------------------------------------------------++-- $setup+--+-- >>> :set -XDeriveGeneric+-- >>> :set -XTypeApplications+-- >>> :set -XTypeOperators+-- >>> :set -XDataKinds+-- >>> import Prelude (Int,Double,String,Char,IO,(++),Maybe(..))+-- >>> import Prelude (Show(..),Read(..),read,Num(..),Monoid(..))+-- >>> import Prelude (print)+-- >>> import Data.Complex (Complex(..))+-- >>> import Data.Monoid  (Sum(..),Product(..))+-- >>> import Data.Maybe   (fromMaybe)+-- >>> import Data.Vector.HFixed.HVec (HVec,HVecF)+-- >>> import GHC.Generics (Generic)

@@ -1,17 +1,19 @@-{-# LANGUAGE ConstraintKinds       #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DefaultSignatures     #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE KindSignatures        #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeApplications      #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ConstraintKinds         #-}+{-# LANGUAGE DataKinds               #-}+{-# LANGUAGE DefaultSignatures       #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE KindSignatures          #-}+{-# LANGUAGE MagicHash               #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE PolyKinds               #-}+{-# LANGUAGE RankNTypes              #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE TypeApplications        #-}+{-# LANGUAGE TypeFamilies            #-}+{-# LANGUAGE TypeOperators           #-}+{-# LANGUAGE UndecidableInstances    #-}+{-# LANGUAGE UndecidableSuperClasses #-} module Data.Vector.HFixed.Class (     -- * Types and type classes     -- ** N-ary functions@@ -26,10 +28,14 @@     -- ** Type classes   , Arity(..)   , ArityC(..)+  , (:&&:)   , HVector(..)   , tupleSize   , HVectorF(..)   , tupleSizeF+    -- *** Lookup in vector+  , Index(..)+  , TyLookup(..)     -- ** CPS-encoded vector   , ContVec   , ContVecF(..)@@ -56,14 +62,15 @@   , concatF   , lensWorkerF   , lensWorkerTF-  , Index(..)+    -- * Lens+  , Lens+  , Lens'   ) where -import Control.Applicative   (Applicative(..),(<$>)) import Data.Coerce import Data.Complex          (Complex(..))-import Data.Typeable         (Proxy(..)) import Data.Functor.Identity (Identity(..))+import Data.Type.Equality    (type (==))  import           Data.Vector.Fixed.Cont   (Peano,PeanoNum(..),ArityPeano) import qualified Data.Vector.Fixed                as F@@ -74,6 +81,7 @@ import qualified Data.Vector.Fixed.Boxed          as B  import Unsafe.Coerce (unsafeCoerce)+import GHC.Exts (Proxy#,proxy#) import GHC.TypeLits import GHC.Generics hiding (S) @@ -106,6 +114,12 @@ -- Generic operations ---------------------------------------------------------------- +-- | Type class for combining two constraint constructors. Those are+--   required for 'ArityC' type class.+class (c1 a, c2 a) => (:&&:) c1 c2 a++instance (c1 a, c2 a) => (:&&:) c1 c2 a+ -- | Type class for dealing with N-ary function in generic way. Both --   'accum' and 'apply' work with accumulator data types which are --   polymorphic. So it's only possible to write functions which@@ -188,14 +202,27 @@   --- | Type class for heterogeneous vectors. Instance should specify way--- to construct and deconstruct itself+-- |+-- Type class for product type. Any product type could have instance+-- of this type.  Its methods describe how to construct and+-- deconstruct data type. For example instance for simple data type+-- with two fields could be written as: ----- Note that this type class is extremely generic. Almost any single--- constructor data type could be made instance. It could be--- monomorphic, it could be polymorphic in some or all fields it--- doesn't matter. Only law instance should obey is:+-- > data A a = A Int a+-- >+-- > instance HVector (A a) where+-- >   type Elems (A a) = '[Int,a]+-- >   construct = TFun $ \i a -> A i a+-- >   inspect (A i a) (TFun f) = f i a --+-- Another equivalent description of this type class is descibes+-- isomorphism between data type and+-- 'Data.Vector.HFixed.Cont.ContVec', where @constuct@ implements+-- @ContVec → a@ (see 'Data.Vector.HFixed.Cont.vector') and @inspect@+-- implements @a → ContVec@ (see 'Data.Vector.HFixed.Cont.cvec')+--+-- Istances should satisfy one law:+-- -- > inspect v construct = v -- -- Default implementation which uses 'Generic' is provided.@@ -216,7 +243,7 @@   {-# INLINE construct #-}   {-# INLINE inspect   #-} --- | Number of elements in tuple+-- | Number of elements in product type tupleSize :: forall v proxy. HVector v => proxy v -> Int tupleSize _ = arity (Proxy :: Proxy (Elems v)) @@ -229,7 +256,7 @@   inspectF   :: v f -> TFun f (ElemsF v) a -> a   constructF :: TFun f (ElemsF v) (v f) --- | Number of elements in tuple+-- | Number of elements in parametrized product type tupleSizeF :: forall v f proxy. HVectorF v => proxy (v f) -> Int tupleSizeF _a = arity (Proxy :: Proxy (ElemsF v)) @@ -559,7 +586,55 @@   {-# INLINE lensChF #-}  +----------------------------------------------------------------+-- Type lookup+---------------------------------------------------------------- +-- | Type class to supporty looking up value in product type by its+--   type. Latter must not contain two elements of type @x@.+class Arity xs => TyLookup x xs where+  lookupTFun :: TFun f xs (f x)++-- Case analysis for type equality+class Arity xs => TyLookupCase (eq :: Bool) x xs where+  lookupTFunCase :: Proxy# eq -> TFun f xs (f x)++-- List xs does not contain type x+class NoType                  x xs+class NoTypeCase (eq :: Bool) x xs+instance                             NoType a '[]+instance NoTypeCase (a == x) a xs => NoType a (x ': xs)+instance ( TypeError ('Text "Duplicate type found: " ':$$: 'ShowType a)+         )           => NoTypeCase 'True  a xs+instance NoType a xs => NoTypeCase 'False a xs+++instance ( TypeError ('Text "Cannot find type: " ':$$: 'ShowType a)+         ) => TyLookup a '[] where+  lookupTFun = error "Unreachable"++-- Case analysis of type equality+instance ( Arity xs+         , TyLookupCase (a == x) a (x ': xs)+         ) => TyLookup a (x ': xs) where+  lookupTFun = lookupTFunCase (proxy# :: Proxy# (a == x))+  {-# INLINE lookupTFun #-}++-- Found x+instance ( Arity xs+         , NoType x xs+         ) => TyLookupCase 'True x (x ': xs) where+  lookupTFunCase _ = uncurryTFun pure+  {-# INLINE lookupTFunCase #-}++-- Go deeper+instance ( Arity xs+         , TyLookup a xs+         ) => TyLookupCase 'False a (x ': xs) where+  lookupTFunCase _ = uncurryTFun $ const lookupTFun+  {-# INLINE lookupTFunCase #-}++ ---------------------------------------------------------------- -- Instances ----------------------------------------------------------------@@ -858,6 +933,12 @@   {-# INLINE inspect   #-}  +-- | Copy of lens type definition from lens package+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++-- | Copy of type preserving lens definition from lens package+type Lens' s a = Lens s s a a+ ---------------------------------------------------------------- -- Generics ----------------------------------------------------------------@@ -880,7 +961,6 @@ instance ( GHVector f, GHVector g, Arity (GElems f), Arity (GElems g)          ) => GHVector (f :*: g) where   type GElems (f :*: g) = GElems f ++ GElems g-   gconstruct = concatF (:*:) gconstruct gconstruct   ginspect (f :*: g) fun     = ginspect g $ ginspect f $ curryMany fun@@ -888,11 +968,23 @@   {-# INLINE ginspect   #-}  +instance ( TypeError ('Text "It's impossible to derive HVector for type without constructors")+         ) => GHVector V1 where+  type GElems V1 = TypeError ('Text "It's impossible to derive HVector for type without constructors")+  gconstruct = error "Unreachable"+  ginspect   = error "Unreachable"++instance ( TypeError ('Text "It's impossible to derive HVector for sum types")+         ) => GHVector (f :+: g) where+  type GElems (f :+: g) = TypeError ('Text "It's impossible to derive HVector for sum types")+  gconstruct = error "Unreachable"+  ginspect   = error "Unreachable"+ -- Recursion is terminated by simple field instance GHVector (K1 R x) where   type GElems (K1 R x) = '[x]   gconstruct               = TFun (K1 . runIdentity)-  ginspect (K1 x) (TFun f) = f (Identity x) -- f (Identity x)+  ginspect (K1 x) (TFun f) = f (Identity x)   {-# INLINE gconstruct #-}   {-# INLINE ginspect   #-} 

@@ -46,6 +46,8 @@     -- ** Indexing   , index   , set+  , tyLookup+  , tyLookupF     -- ** Folds and unfolds   , foldlF   , foldrF@@ -62,6 +64,7 @@     -- ** Monomorphization of vectors   , monomorphizeF     -- ** Manipulation with type constructor+  , map   , mapNat   , sequenceF   , distributeF@@ -71,7 +74,6 @@ import Data.Monoid           (Monoid(..),(<>)) import Data.Functor.Compose  (Compose(..)) import Data.Functor.Identity (Identity(..))-import Data.Typeable         (Proxy(..)) import qualified Data.Vector.Fixed.Cont as F import Prelude               (Functor(..),id,(.),($)) @@ -132,10 +134,39 @@ set n x (ContVecF cont) = ContVecF $ cont . putF n x {-# INLINE set #-} +-- | Lookup value by its type+tyLookup :: TyLookup a xs => ContVec xs -> a+tyLookup (ContVecF cont) = runIdentity $ cont lookupTFun+{-# INLINE tyLookup #-} +-- | Lookup value by its type+tyLookupF :: TyLookup a xs => ContVecF xs f -> f a+tyLookupF (ContVecF cont) = cont lookupTFun+{-# INLINE tyLookupF #-}++ ---------------------------------------------------------------- -- Monadic/applicative API ----------------------------------------------------------------++-- | Apply transformation to every element of the tuple.+map :: (ArityC c xs)+    => Proxy c+    -> (forall a. c a => f a -> g a)+    -> ContVecF xs f+    -> ContVecF xs g+map cls f (ContVecF cont) = ContVecF $ cont . mapF cls f+{-# INLINE map #-}++mapF :: forall c f g r xs. (ArityC c xs)+     => Proxy c+     -> (forall a. c a => f a -> g a)+     -> TFun g xs r+     -> TFun f xs r+mapF cls g (TFun f0) = accumC cls+  (\(TF_map f) a -> TF_map $ f (g a))+  (\(TF_map r)   -> r)+  (TF_map f0 :: TF_map r g xs)  -- | Apply natural transformation to every element of the tuple. mapNat :: (Arity xs)

@@ -20,12 +20,11 @@ import Data.Functor.Classes import Control.DeepSeq         (NFData(..)) import Data.Semigroup          (Semigroup(..))-import Data.Monoid             (Monoid(..),All(..))+import Data.Monoid             (All(..)) import Data.List               (intersperse,intercalate) import Data.Primitive.SmallArray ( SmallArray, SmallMutableArray, newSmallArray                                  , writeSmallArray, indexSmallArray                                  , unsafeFreezeSmallArray)-import Text.Show               (showChar) import GHC.Exts                (Any) import Unsafe.Coerce           (unsafeCoerce) 

@@ -1,2 +1,33 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif++#if MIN_VERSION_cabal_doctest(1,0,0)++import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests"++#else++#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+#warning You are configuring this package without cabal-doctest installed. \+         The doctests test-suite will not work as a result. \+         To fix this, install cabal-doctest before configuring.+#endif+ import Distribution.Simple++main :: IO () main = defaultMain++#endif

@@ -1,28 +1,46 @@ Name:           fixed-vector-hetero-Version:        0.5.0.0-Synopsis:       Generic heterogeneous vectors+Version:        0.6.0.0+Synopsis:       Library for working with product types generically Description:-  Generic heterogeneous vectors+  Library allow to work with arbitrary product types in generic+  manner. They could be constructed, destucted, converted provided+  they are product of identical types. -Cabal-Version:  >= 1.6+Cabal-Version:  >= 1.10 License:        BSD3 License-File:   LICENSE Author:         Aleksey Khudyakov <alexey.skladnoy@gmail.com> Maintainer:     Aleksey Khudyakov <alexey.skladnoy@gmail.com> Homepage:       http://github.org/Shimuuar/fixed-vector-hetero Category:       Data-Build-Type:     Simple+Build-Type:     Custom extra-source-files:   ChangeLog.md +tested-with:+    GHC ==8.0.2+     || ==8.2.2+     || ==8.4.4+     || ==8.6.5+     || ==8.8.3+     || ==8.10.1+  , GHCJS ==8.4+ source-repository head   type:     git   location: http://github.com/Shimuuar/fixed-vector-hetero +custom-setup+    setup-depends:+        base          >=4.9   && <5,+        Cabal         >=1.10  && <3.3,+        cabal-doctest >=1.0.6 && <1.1+ Library   -- Bigger context stack needed for HVector instances for large   -- tuples   Ghc-options:          -Wall -freduction-depth=50+  default-language: Haskell2010   Build-Depends: base          >=4.9 && <5                , deepseq                , fixed-vector  >= 1.0.0.0@@ -33,3 +51,18 @@     Data.Vector.HFixed.Cont     Data.Vector.HFixed.HVec     Data.Vector.HFixed.TypeFuns+++test-suite doctests+    if impl(ghcjs)+      buildable: False+    type:             exitcode-stdio-1.0+    main-is:          doctests.hs+    hs-source-dirs:   test+    default-language: Haskell2010+    build-depends:+        base                >=4.9 && <5+      , doctest             >=0.15 && <0.17+      , fixed-vector        >=1.0+      , fixed-vector-hetero -any+

@@ -0,0 +1,12 @@+module Main where++import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable  (traverse_)+import Test.DocTest   (doctest)++main :: IO ()+main = do+    traverse_ putStrLn args+    doctest args+  where+    args = flags ++ pkgs ++ module_sources