vec 0.4.1 → 0.5.1.1
raw patch · 10 files changed
Files
- ChangeLog.md +8/−0
- bench/Bench.hs +2/−0
- src/Control/Lens/Yocto.hs +0/−13
- src/Data/Functor/Confusing.hs +0/−136
- src/Data/Vec/DataFamily/SpineStrict.hs +0/−32
- src/Data/Vec/DataFamily/SpineStrict/Pigeonhole.hs +0/−295
- src/Data/Vec/Lazy.hs +0/−31
- src/Data/Vec/Pull.hs +0/−2
- test/Inspection/DataFamily/SpineStrict/Pigeonhole.hs +0/−119
- vec.cabal +23/−42
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for vec +## 0.5.1++- Support GHC-8.6.5...9.10.1++## 0.5++- Remove PigeonHole module. It didn't work well.+ ## 0.4.1 - Add `boring` instances
bench/Bench.hs view
@@ -36,12 +36,14 @@ FS (FS FZ) -> 3 FS (FS (FS FZ)) -> 4 FS (FS (FS (FS FZ))) -> 5+ _ -> -1 ysp = P.Vec $ \i -> case i of FZ -> 6 FS FZ -> 7 FS (FS FZ) -> 8 FS (FS (FS FZ)) -> 9 FS (FS (FS (FS FZ))) -> 0+ _ -> -1 main :: IO () main = defaultMain
src/Control/Lens/Yocto.hs view
@@ -43,9 +43,7 @@ import Prelude (Either (..), Maybe, either, maybe, (.)) #endif -#if MIN_VERSION_base(4,11,0) import Data.Functor ((<&>))-#endif ------------------------------------------------------------------------------- -- Types@@ -86,17 +84,6 @@ over :: LensLike Identity s t a b -> (a -> b) -> s -> t over = coerce {-# INLINE over #-}------------------------------------------------------------------------------------ Operators----------------------------------------------------------------------------------#if !MIN_VERSION_base(4,11,0)-(<&>) :: Functor f => f a -> (a -> b) -> f b-as <&> f = fmap f as--infixl 1 <&>-#endif ------------------------------------------------------------------------------- -- Constructors
− src/Data/Functor/Confusing.hs
@@ -1,136 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE Safe #-}--- |--- Csongor Kiss, Matthew Pickering, and Nicolas Wu. 2018. Generic deriving of generic traversals.--- Proc. ACM Program. Lang. 2, ICFP, Article 85 (July 2018), 30 pages. DOI: https://doi.org/10.1145/3236780------ https://arxiv.org/abs/1805.06798------ This is modified version of part of @generic-lens@ library------ Copyright (c) 2018, Csongor Kiss------ All rights reserved.------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:------ * Redistributions of source code must retain the above copyright--- notice, this list of conditions and the following disclaimer.------ * Redistributions in binary form must reproduce the above--- copyright notice, this list of conditions and the following--- disclaimer in the documentation and/or other materials provided--- with the distribution.------ * Neither the name of Csongor Kiss nor the names of other--- contributors may be used to endorse or promote products derived--- from this software without specific prior written permission.------ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS--- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT--- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR--- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT--- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,--- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT--- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,--- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY--- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT--- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE--- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.----module Data.Functor.Confusing (- fusing, confusing, LensLike,- ifusing, iconfusing, IxLensLike,- ffusing, fconfusing, FLensLike,- liftCurriedYoneda, yap,- Curried (..), liftCurried, lowerCurried,- Yoneda (..), liftYoneda, lowerYoneda,- ) where--import Control.Applicative------------------------------------------------------------------------------------ Confusing----------------------------------------------------------------------------------type LensLike f s t a b = (a -> f b) -> s -> f t---- note: qualified name to justify import even with newer GHCs--fusing :: Functor f => LensLike (Yoneda f) s t a b -> LensLike f s t a b-fusing t = \f -> lowerYoneda . t (liftYoneda . f)-{-# INLINE fusing #-}--confusing :: Control.Applicative.Applicative f => LensLike (Curried (Yoneda f)) s t a b -> LensLike f s t a b-confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)-{-# INLINE confusing #-}--liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) a-liftCurriedYoneda fa = Curried (`yap` fa)-{-# INLINE liftCurriedYoneda #-}--yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b-yap (Yoneda k) fa = Yoneda (\ab_r -> k (ab_r .) <*> fa)-{-# INLINE yap #-}--type IxLensLike f i s t a b = (i -> a -> f b) -> s -> f t--ifusing :: Functor f => IxLensLike (Yoneda f) i s t a b -> IxLensLike f i s t a b-ifusing t = \f -> lowerYoneda . t (\i a -> liftYoneda (f i a))-{-# INLINE ifusing #-}--iconfusing :: Applicative f => IxLensLike (Curried (Yoneda f)) i s t a b -> IxLensLike f i s t a b-iconfusing t = \f -> lowerYoneda . lowerCurried . t (\i a -> liftCurriedYoneda (f i a))-{-# INLINE iconfusing #-}--type FLensLike f s t a b = (forall x. a x -> f (b x)) -> s -> f t--ffusing :: Functor f => FLensLike (Yoneda f) s t a b -> FLensLike f s t a b-ffusing t = \f -> lowerYoneda . t (liftYoneda . f)-{-# INLINE ffusing #-}--fconfusing :: Applicative f => FLensLike (Curried (Yoneda f)) s t a b -> FLensLike f s t a b-fconfusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)-{-# INLINE fconfusing #-}------------------------------------------------------------------------------------ Curried----------------------------------------------------------------------------------newtype Curried f a = Curried { runCurried :: forall r. f (a -> r) -> f r }--instance Functor f => Functor (Curried f) where- fmap f (Curried g) = Curried (g . fmap (.f))- {-# INLINE fmap #-}--instance Functor f => Applicative (Curried f) where- pure a = Curried (fmap ($ a))- {-# INLINE pure #-}- Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))- {-# INLINE (<*>) #-}--liftCurried :: Applicative f => f a -> Curried f a-liftCurried fa = Curried (<*> fa)--lowerCurried :: Applicative f => Curried f a -> f a-lowerCurried (Curried f) = f (pure id)------------------------------------------------------------------------------------ Yoneda----------------------------------------------------------------------------------newtype Yoneda f a = Yoneda { runYoneda :: forall b. (a -> b) -> f b }--liftYoneda :: Functor f => f a -> Yoneda f a-liftYoneda a = Yoneda (\f -> fmap f a)--lowerYoneda :: Yoneda f a -> f a-lowerYoneda (Yoneda f) = f id--instance Functor (Yoneda f) where- fmap f m = Yoneda (\k -> runYoneda m (k . f))--instance Applicative f => Applicative (Yoneda f) where- pure a = Yoneda (\f -> pure (f a))- Yoneda m <*> Yoneda n = Yoneda (\f -> m (f .) <*> n id)
src/Data/Vec/DataFamily/SpineStrict.hs view
@@ -240,12 +240,10 @@ foldr = foldr -- foldl' = foldl' -#if MIN_VERSION_base(4,8,0) null = null length = length sum = sum product = product-#endif #ifdef MIN_VERSION_semigroupoids instance (N.SNatI m, n ~ 'S m) => I.Foldable1 (Vec n) where@@ -291,9 +289,7 @@ (<*>) = zipWith ($) _ *> x = x x <* _ = x-#if MIN_VERSION_base(4,10,0) liftA2 = zipWith-#endif instance N.SNatI n => Monad (Vec n) where return = pure@@ -335,25 +331,6 @@ -- Data.Functor.Classes ------------------------------------------------------------------------------- -#ifndef MIN_VERSION_transformers_compat-#define MIN_VERSION_transformers_compat(x,y,z) 0-#endif---#if MIN_VERSION_base(4,9,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers(0,5,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)-#define LIFTED_FUNCTOR_CLASSES 1-#endif-#endif-#endif--#if LIFTED_FUNCTOR_CLASSES- -- | @since 0.4 instance N.SNatI n => Eq1 (Vec n) where liftEq :: forall a b. (a -> b -> Bool) -> Vec n a -> Vec n b -> Bool@@ -388,16 +365,7 @@ $ sp 6 x . showString " ::: " . go 5 xs-#else--- | @since 0.4-instance N.SNatI n => Eq1 (Vec n) where eq1 = (==) --- | @since 0.4-instance N.SNatI n => Ord1 (Vec n) where compare1 = compare---- | @since 0.4-instance N.SNatI n => Show1 (Vec n) where showsPrec1 = showsPrec-#endif ------------------------------------------------------------------------------- -- Construction -------------------------------------------------------------------------------
− src/Data/Vec/DataFamily/SpineStrict/Pigeonhole.hs
@@ -1,295 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE Safe #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-module Data.Vec.DataFamily.SpineStrict.Pigeonhole (- Pigeonhole (..),- -- * Representable- gindex,- gtabulate,- gix,- -- ** Traversable with index- gtraverse,- gitraverse,- -- * Generic implementation- gfrom, GFrom,- gto, GTo,- GPigeonholeSize,- ) where--import Prelude (Functor (..), fst, uncurry, ($), (.))--import Control.Applicative (Applicative (..), (<$>))-import Control.Arrow (first)-import Data.Fin (Fin (..))-import Data.Functor.Confusing (confusing, fusing, iconfusing)-import Data.Functor.Identity (Identity (..))-import Data.Functor.Product (Product (..))-import Data.Nat (Nat (..))-import Data.Proxy (Proxy (..))-import Data.Vec.DataFamily.SpineStrict (Vec (..), tabulate)-import GHC.Generics (M1 (..), Par1 (..), U1 (..), (:*:) (..))--import qualified Control.Lens.Yocto as YLens-import qualified Data.Fin as F-import qualified Data.Fin.Enum as F-import qualified Data.Type.Nat as N-import qualified Data.Vec.DataFamily.SpineStrict as V-import qualified GHC.Generics as G--#ifdef MIN_VERSION_transformers_compat-import Control.Monad.Trans.Instances ()-#endif---- $setup--- >>> :set -XDeriveGeneric--- >>> import Control.Applicative (Const (..))--- >>> import Data.Char (toUpper)--- >>> import Data.Functor.Identity (Identity (..))--- >>> import Data.Void (absurd)--- >>> import GHC.Generics (Generic, Generic1)--- >>> import Prelude (Int, Show, Char, Integer)--- >>> import Data.Proxy (Proxy (..))--- >>> import qualified Control.Lens as Lens--- >>> import Data.Fin (Fin (..))--- >>> import Data.Vec.DataFamily.SpineStrict (Vec (..))------------------------------------------------------------------------------------ Class------------------------------------------------------------------------------------ | Generic pigeonholes.------ /Examples:/------ >>> from (Identity 'a')--- 'a' ::: VNil------ >>> data Values a = Values a a a deriving (Generic1)--- >>> instance Pigeonhole Values--- >>> from (Values 1 2 3)--- 1 ::: 2 ::: 3 ::: VNil----class Pigeonhole f where- -- | The size of a pigeonhole- type PigeonholeSize f :: Nat- type PigeonholeSize f = GPigeonholeSize f-- -- | Converts a value to vector- from :: f x -> Vec (PigeonholeSize f) x- default from :: (G.Generic1 f, GFrom f, PigeonholeSize f ~ GPigeonholeSize f) => f x -> Vec (PigeonholeSize f) x- from = gfrom-- -- | Converts back from vector.- to :: Vec (PigeonholeSize f) x -> f x- default to :: (G.Generic1 f, GTo f, PigeonholeSize f ~ GPigeonholeSize f) => Vec (PigeonholeSize f) x -> f x- to = gto---- | @'Identity' x@ ~ @x ^ 1@-instance Pigeonhole Identity------ | @'Proxy' x@ ~ @x ^ 0@-instance Pigeonhole Proxy where- type PigeonholeSize Proxy = 'Z- from _ = VNil- to _ = Proxy---- | @'Product' f g x@ ~ @x ^ (size f + size g)@-instance (Pigeonhole f, Pigeonhole g, N.SNatI (PigeonholeSize f)) => Pigeonhole (Product f g) where- type PigeonholeSize (Product f g) = N.Plus (PigeonholeSize f) (PigeonholeSize g)-- to = f . V.split where f (a, b) = Pair (to a) (to b)- from = uncurry (V.++) . g where g (Pair a b) = (from a, from b)------------------------------------------------------------------------------------ Generic representable------------------------------------------------------------------------------------ | Index.------ >>> gindex (Identity 'y') (Proxy :: Proxy Int)--- 'y'------ >>> data Key = Key1 | Key2 | Key3 deriving (Generic)--- >>> data Values a = Values a a a deriving (Generic1)------ >>> gindex (Values 'a' 'b' 'c') Key2--- 'b'----gindex- :: ( G.Generic i, F.GFrom i, G.Generic1 f, GFrom f- , F.GEnumSize i ~ GPigeonholeSize f, N.SNatI (GPigeonholeSize f)- )- => f a -> i -> a-gindex fa i = gfrom fa V.! F.gfrom i---- | Tabulate.------ >>> gtabulate (\() -> 'x') :: Identity Char--- Identity 'x'------ >>> gtabulate absurd :: Proxy Integer--- Proxy------ >>> gtabulate absurd :: Proxy Integer--- Proxy----gtabulate- :: ( G.Generic i, F.GTo i, G.Generic1 f, GTo f- , F.GEnumSize i ~ GPigeonholeSize f, N.SNatI (GPigeonholeSize f)- )- => (i -> a) -> f a-gtabulate idx = gto $ tabulate (idx . F.gto)---- | A lens. @i -> Lens' (t a) a@------ >>> Lens.view (gix ()) (Identity 'x')--- 'x'------ >>> Lens.over (gix ()) toUpper (Identity 'x')--- Identity 'X'----gix :: ( G.Generic i, F.GFrom i, G.Generic1 t, GTo t, GFrom t- , F.GEnumSize i ~ GPigeonholeSize t, N.SNatI (GPigeonholeSize t)- , Functor f- )- => i -> (a -> f a) -> t a -> f (t a)-gix i = fusing $ \ab ta -> gto <$> ix (F.gfrom i) ab (gfrom ta)------------------------------------------------------------------------------------ Vendored in ix------------------------------------------------------------------------------------ | Index lens.----ix :: forall n f a. (N.SNatI n, Functor f) => Fin n -> YLens.LensLike' f (Vec n a) a-ix = getIxLens $ N.induction1 start step where- start :: IxLens f 'Z a- start = IxLens F.absurd-- step :: IxLens f m a -> IxLens f ('S m) a- step (IxLens l) = IxLens $ \i -> case i of- FZ -> _head- FS j -> _tail . l j--newtype IxLens f n a = IxLens { getIxLens :: Fin n -> YLens.LensLike' f (Vec n a) a }--_head :: YLens.Lens' (Vec ('S n) a) a-_head f (x ::: xs) = (::: xs) <$> f x-{-# INLINE _head #-}---- | Head lens. /Note:/ @lens@ 'Lens._head' is a 'Lens.Traversal''.-_tail :: YLens.Lens' (Vec ('S n) a) (Vec n a)-_tail f (x ::: xs) = (x :::) <$> f xs-{-# INLINE _tail #-}------------------------------------------------------------------------------------ Generic traversable with index------------------------------------------------------------------------------------ | Generic traverse.------ __Don't use__, rather use @DeriveTraversable@-gtraverse- :: ( G.Generic1 t, GFrom t, GTo t- , N.SNatI (GPigeonholeSize t)- , Applicative f- )- => (a -> f b) -> t a -> f (t b)-gtraverse = confusing $ \afb ta -> gto <$> V.traverse afb (gfrom ta)-{-# INLINE gtraverse #-}---- | Traverse with index.------ >>> data Key = Key1 | Key2 | Key3 deriving (Show, Generic)--- >>> data Values a = Values a a a deriving (Generic1)------ >>> gitraverse (\i a -> Const [(i :: Key, a)]) (Values 'a' 'b' 'c')--- Const [(Key1,'a'),(Key2,'b'),(Key3,'c')]----gitraverse- :: ( G.Generic i, F.GTo i- , G.Generic1 t, GFrom t, GTo t- , F.GEnumSize i ~ GPigeonholeSize t, N.SNatI (GPigeonholeSize t)- , Applicative f- )- => (i -> a -> f b) -> t a -> f (t b)-gitraverse = iconfusing $ \iafb ta -> gto <$> V.itraverse (\i a -> iafb (F.gto i) a) (gfrom ta)-{-# INLINE gitraverse #-}------------------------------------------------------------------------------------ PigeonholeSize------------------------------------------------------------------------------------ | Compute the size from the type.-type GPigeonholeSize c = PigeonholeSizeRep (G.Rep1 c) N.Nat0--type family PigeonholeSizeRep (c :: * -> *) (n :: Nat) :: Nat where- PigeonholeSizeRep (a :*: b ) n = PigeonholeSizeRep a (PigeonholeSizeRep b n)- PigeonholeSizeRep (M1 _d _c a) n = PigeonholeSizeRep a n- PigeonholeSizeRep Par1 n = 'N.S n- PigeonholeSizeRep U1 n = n------------------------------------------------------------------------------------ From------------------------------------------------------------------------------------ | Generic version of 'from'.-gfrom :: (G.Generic1 c, GFrom c) => c a -> Vec (GPigeonholeSize c) a-gfrom = \x -> gfromRep1 (G.from1 x) VNil---- | Constraint for the class that computes 'gfrom'.-type GFrom c = GFromRep1 (G.Rep1 c)--class GFromRep1 (c :: * -> *) where- gfromRep1 :: c x -> Vec n x -> Vec (PigeonholeSizeRep c n) x--instance (GFromRep1 a, GFromRep1 b) => GFromRep1 (a :*: b) where- gfromRep1 (x :*: y) z = gfromRep1 x (gfromRep1 y z)--instance GFromRep1 a => GFromRep1 (M1 d c a) where- gfromRep1 (M1 a) z = gfromRep1 a z--instance GFromRep1 Par1 where- gfromRep1 (Par1 x) z = x ::: z--instance GFromRep1 U1 where- gfromRep1 _U1 z = z------------------------------------------------------------------------------------ To------------------------------------------------------------------------------------ | Generic version of 'to'.-gto :: forall c a. (G.Generic1 c, GTo c) => Vec (GPigeonholeSize c) a -> c a-gto = \xs -> G.to1 $ fst (gtoRep1 xs :: (G.Rep1 c a, Vec 'N.Z a))---- | Constraint for the class that computes 'gto'.-type GTo c = GToRep1 (G.Rep1 c)--class GToRep1 (c :: * -> *) where- gtoRep1 :: Vec (PigeonholeSizeRep c n) x -> (c x, Vec n x)--instance GToRep1 a => GToRep1 (M1 d c a) where- gtoRep1 = first M1 . gtoRep1--instance (GToRep1 a, GToRep1 b) => GToRep1 (a :*: b) where- gtoRep1 xs =- let (a, ys) = gtoRep1 xs- (b, zs) = gtoRep1 ys- in (a :*: b, zs)--instance GToRep1 Par1 where- gtoRep1 (x ::: xs) = (Par1 x, xs)--instance GToRep1 U1 where- gtoRep1 xs = (U1, xs)
src/Data/Vec/Lazy.hs view
@@ -183,12 +183,10 @@ foldr = foldr foldl' = foldl' -#if MIN_VERSION_base(4,8,0) null = null length = length sum = sum product = product-#endif instance I.Traversable (Vec n) where traverse = traverse@@ -229,9 +227,7 @@ (<*>) = zipWith ($) _ *> x = x x <* _ = x-#if MIN_VERSION_base(4,10,0) liftA2 = zipWith-#endif instance N.SNatI n => Monad (Vec n) where return = pure@@ -277,23 +273,6 @@ -- Data.Functor.Classes ------------------------------------------------------------------------------- -#ifndef MIN_VERSION_transformers_compat-#define MIN_VERSION_transformers_compat(x,y,z) 0-#endif--#if MIN_VERSION_base(4,9,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers(0,5,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)-#define LIFTED_FUNCTOR_CLASSES 1-#endif-#endif-#endif--#if LIFTED_FUNCTOR_CLASSES -- | @since 0.4 instance Eq1 (Vec n) where liftEq _eq VNil VNil = True@@ -311,16 +290,6 @@ $ sp 6 x . showString " ::: " . liftShowsPrec sp sl 5 xs-#else--- | @since 0.4-instance Eq1 (Vec n) where eq1 = (==)---- | @since 0.4-instance Ord1 (Vec n) where compare1 = compare---- | @since 0.4-instance Show1 (Vec n) where showsPrec1 = showsPrec-#endif ------------------------------------------------------------------------------- -- Construction
src/Data/Vec/Pull.hs view
@@ -148,9 +148,7 @@ (<*>) = zipWith ($) _ *> x = x x <* _ = x-#if MIN_VERSION_base(4,10,0) liftA2 = zipWith-#endif instance Monad (Vec n) where return = pure
− test/Inspection/DataFamily/SpineStrict/Pigeonhole.hs
@@ -1,119 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}--- {-# OPTIONS_GHC -dsuppress-all #-}-{-# OPTIONS_GHC -dsuppress-idinfo #-}-{-# OPTIONS_GHC -dsuppress-coercions #-}-{-# OPTIONS_GHC -dsuppress-type-applications #-}-{-# OPTIONS_GHC -dsuppress-module-prefixes #-}-{-# OPTIONS_GHC -dsuppress-type-signatures #-}--- {-# OPTIONS_GHC -dsuppress-uniques #-}--- This makes gix tests pass, default is 60-{-# OPTIONS_GHC -funfolding-use-threshold=240 #-}-module Inspection.DataFamily.SpineStrict.Pigeonhole where--import Data.Functor.Compat ((<&>))-import Data.Vec.DataFamily.SpineStrict.Pigeonhole- (gindex, gitraverse, gix, gtabulate, gtraverse)-import GHC.Generics (Generic, Generic1)-import Test.Inspection------------------------------------------------------------------------------------ Simple type----------------------------------------------------------------------------------data Key = Key1 | Key2 | Key3 | Key4 | Key5 deriving (Show, Generic)-data Values a = Values a a a a a deriving (Show, Generic1)------------------------------------------------------------------------------------ Simple----------------------------------------------------------------------------------lhsSimple :: Char-lhsSimple = gindex (Values 'a' 'b' 'c' 'd' 'e' ) Key2--rhsSimple :: Char-rhsSimple = 'b'--inspect $ 'lhsSimple === 'rhsSimple------------------------------------------------------------------------------------ Index----------------------------------------------------------------------------------lhsIndex :: Values a -> Key -> a-lhsIndex = gindex--rhsIndex :: Values a -> Key -> a-rhsIndex (Values x _ _ _ _) Key1 = x-rhsIndex (Values _ x _ _ _) Key2 = x-rhsIndex (Values _ _ x _ _) Key3 = x-rhsIndex (Values _ _ _ x _) Key4 = x-rhsIndex (Values _ _ _ _ x) Key5 = x--inspect $ hasNoGenerics 'lhsIndex-inspect $ 'lhsIndex === 'rhsIndex------------------------------------------------------------------------------------ Tabulate----------------------------------------------------------------------------------lhsTabulate :: (Key -> a) -> Values a-lhsTabulate = gtabulate--rhsTabulate :: (Key -> a) -> Values a-rhsTabulate f = Values (f Key1) (f Key2) (f Key3) (f Key4) (f Key5)--inspect $ hasNoGenerics 'lhsTabulate-inspect $ 'lhsTabulate === 'rhsTabulate------------------------------------------------------------------------------------ Ix----------------------------------------------------------------------------------type LensLike' f s a = (a -> f a) -> s -> f s--lhsIx :: Functor f => Key -> LensLike' f (Values a) a-lhsIx = gix--rhsIx :: Functor f => Key -> LensLike' f (Values a) a-rhsIx Key1 f (Values x1 x2 x3 x4 x5) = f x1 <&> \x1' -> Values x1' x2 x3 x4 x5-rhsIx Key2 f (Values x1 x2 x3 x4 x5) = f x2 <&> \x2' -> Values x1 x2' x3 x4 x5-rhsIx Key3 f (Values x1 x2 x3 x4 x5) = f x3 <&> \x3' -> Values x1 x2 x3' x4 x5-rhsIx Key4 f (Values x1 x2 x3 x4 x5) = f x4 <&> \x4' -> Values x1 x2 x3 x4' x5-rhsIx Key5 f (Values x1 x2 x3 x4 x5) = f x5 <&> \x5' -> Values x1 x2 x3 x4 x5'--inspect $ hasNoGenerics 'lhsIx-inspect $ 'lhsIx === 'rhsIx------------------------------------------------------------------------------------ Indexed traverse----------------------------------------------------------------------------------lhsTraverse :: Applicative f => (a -> f b) -> Values a -> f (Values b)-lhsTraverse f xs = gtraverse f xs--rhsTraverse :: Applicative f => (a -> f b) -> Values a -> f (Values b)-rhsTraverse f (Values x y z u v) = pure Values- <*> f x- <*> f y- <*> f z- <*> f u- <*> f v--inspect $ hasNoGenerics 'lhsTraverse-inspect $ 'lhsTraverse === 'rhsTraverse--lhsITraverse :: Applicative f => (Key -> a -> f b) -> Values a -> f (Values b)-lhsITraverse f xs = gitraverse f xs--rhsITraverse :: Applicative f => (Key -> a -> f b) -> Values a -> f (Values b)-rhsITraverse f (Values x y z u v) = pure Values- <*> f Key1 x- <*> f Key2 y- <*> f Key3 z- <*> f Key4 u- <*> f Key5 v--inspect $ hasNoGenerics 'lhsITraverse-inspect $ 'lhsITraverse === 'rhsITraverse
vec.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: vec-version: 0.4.1+version: 0.5.1.1 synopsis: Vec: length-indexed (sized) list category: Data, Dependent Types description:@@ -70,16 +70,17 @@ build-type: Simple extra-source-files: ChangeLog.md tested-with:- GHC ==7.8.4- || ==7.10.3- || ==8.0.2- || ==8.2.2- || ==8.4.4- || ==8.6.5+ GHC ==8.6.5 || ==8.8.4- || ==8.10.4- || ==9.0.1- || ==9.2.1+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.6+ || ==9.8.4+ || ==9.10.3+ || ==9.12.2+ || ==9.14.1 source-repository head type: git@@ -111,50 +112,37 @@ hs-source-dirs: src exposed-modules: Data.Vec.DataFamily.SpineStrict- Data.Vec.DataFamily.SpineStrict.Pigeonhole Data.Vec.Lazy Data.Vec.Lazy.Inline Data.Vec.Pull other-modules: Control.Lens.Yocto- Data.Functor.Confusing SafeCompat -- GHC boot libs build-depends:- , base >=4.7 && <4.17- , deepseq >=1.3.0.1 && <1.5- , transformers >=0.3.0.0 && <0.7-- if !impl(ghc >=8.0)- build-depends: semigroups >=0.18.4 && <0.21-- -- Ensure Data.Functor.Classes is always available- if impl(ghc >=7.10)- build-depends: transformers >=0.4.2.0-- else- build-depends: transformers-compat ^>=0.6.5 || ^>=0.7.1+ , base >=4.12.0.0 && <4.23+ , deepseq >=1.4.4.0 && <1.6 -- siblings- build-depends: fin ^>=0.2.1+ build-depends: fin ^>=0.3.1 -- other dependencies build-depends:- , boring ^>=0.2- , hashable >=1.2.7.0 && <1.5- , indexed-traversable ^>=0.1.1- , QuickCheck ^>=2.14.2+ , boring ^>=0.2.2+ , hashable ^>=1.4.4.0 || ^>=1.5.0.0+ , indexed-traversable ^>=0.1.4+ , QuickCheck ^>=2.14.2 || ^>=2.15.0.1 || ^>=2.18.0.0 if flag(distributive)- build-depends: distributive >=0.5.3 && <0.7+ build-depends: distributive ^>=0.6.2 if flag(adjunctions)- build-depends: adjunctions ^>=4.4+ build-depends: adjunctions ^>=4.4.2 if flag(semigroupoids)- build-depends: semigroupoids ^>=5.3.5+ build-depends: semigroupoids ^>=6.0.1 other-extensions: CPP@@ -167,7 +155,6 @@ -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode - x-docspec-extra-packages: void x-docspec-extra-packages: lens test-suite inspection@@ -176,22 +163,16 @@ other-modules: Inspection Inspection.DataFamily.SpineStrict- Inspection.DataFamily.SpineStrict.Pigeonhole ghc-options: -Wall -fprint-explicit-kinds hs-source-dirs: test default-language: Haskell2010 build-depends: , base- , base-compat , fin- , inspection-testing ^>=0.4.2.2- , tagged+ , inspection-testing ^>=0.5.0.3 || ^>=0.6 , vec - if !impl(ghc >=8.0)- buildable: False- benchmark bench type: exitcode-stdio-1.0 main-is: Bench.hs@@ -201,7 +182,7 @@ other-modules: DotProduct build-depends: , base- , criterion >=1.4.0.0 && <1.6+ , criterion ^>=1.6.3.0 , fin , vec , vector