vec 0.2 → 0.3

raw patch · 10 files changed

+742/−457 lines, 10 filesdep +QuickCheckdep +transformers-compatdep −lensdep ~adjunctionsdep ~basedep ~base-compatPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, transformers-compat

Dependencies removed: lens

Dependency ranges changed: adjunctions, base, base-compat, fin, inspection-testing

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−1
• src/Control/Lens/Yocto.hs +116/−0
• src/Data/Vec/DataFamily/SpineStrict.hs +150/−141
• src/Data/Vec/DataFamily/SpineStrict/Pigeonhole.hs +51/−12
• src/Data/Vec/Lazy.hs +137/−138
• src/Data/Vec/Lazy/Inline.hs +71/−57
• src/Data/Vec/Pull.hs +93/−87
• test/Inspection.hs +32/−0
• test/Inspection/DataFamily/SpineStrict.hs +24/−0
• vec.cabal +59/−21

@@ -1,6 +1,14 @@ # Revision history for vec -## 0.1.2+## 0.3++- Split `lens` utilities into [`vec-lens`](https://hackage.haskell.org/package/vec-lens) package.+- Add `snoc` and `reverse` operations+- Add `repeat`+- Drop dependency on `base-compat`+- Add explicit `tabulate`++## 0.2  - Add `Data.Vec.DataFamily.SpineStrict.gix` - Add `Data.Vec.DataFamily.SpineStrict.ix` requires `InlineInduction`

@@ -0,0 +1,116 @@+{-# LANGUAGE CPP        #-}+{-# LANGUAGE RankNTypes #-}+-- | A small module defining the least you need to support+-- van-Laarhoven lenses without depending on @lens@ or @microlens@ or ...+--+-- See @lens@ package for the documentation.+--+-- I copy this around.+--+-- Assumes GHC-7.8 / base-4.7; with "Data.Coerce".+--+-- <https://en.wikipedia.org/wiki/Yocto->+module Control.Lens.Yocto (+    -- * Types+    Optic, Optic',+    LensLike, LensLike',+    Lens, Lens',+    Traversal, Traversal',+#ifdef MIN_VERSION_profunctors+    Prism, Prism',+    Iso, Iso',+#endif+    -- * Operations+    view, set, over,+    -- * Operators+    (<&>),+    -- * Constructors+#ifdef MIN_VERSION_profunctors+    iso,+    prism,+    prism',+#endif+    )where++import Control.Applicative   (Applicative (..), Const (..))+import Data.Coerce           (coerce)+import Data.Functor.Identity (Identity (..))+import Prelude               (Functor (..), const, (.))++#ifdef MIN_VERSION_profunctors+import Data.Profunctor (Choice (..), Profunctor (..))+import Prelude         (Either (..), Maybe, either, maybe, (.))+#endif++#if MIN_VERSION_base(4,11,0)+import Data.Functor        ((<&>))+#endif++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++type Optic p f s t a b = p a (f b) -> p s (f t)+type Optic' p f s a = Optic p f s s a a++type LensLike f s t a b = Optic (->) f s t a b+type LensLike' f s a = LensLike f s s a a++type Lens s t a b = forall f. Functor f => LensLike f s t a b+type Lens' s a = Lens s s a a++type Traversal s t a b = forall f. Applicative f => LensLike f s t a b+type Traversal' s a = Lens s s a a++#ifdef MIN_VERSION_profunctors+type Prism s t a b = forall p f. (Choice p, Applicative f) => Optic p f s t a b+type Prism' s a = Prism s s a a++type Iso s t a b = forall p f. (Profunctor p, Functor f) => Optic p f s t a b+type Iso' s a = Iso s s a a+#endif++-------------------------------------------------------------------------------+-- Operations+-------------------------------------------------------------------------------++view :: LensLike' (Const a) s a -> s -> a+view l = coerce (l Const)+{-# INLINE view #-}++set :: LensLike Identity s t a b -> b -> s -> t+set l = over l . const+{-# INLINE set #-}++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+-------------------------------------------------------------------------------++#ifdef MIN_VERSION_profunctors+iso :: (s -> a) -> (b -> t) -> Iso s t a b+iso sa bt = dimap sa (fmap bt)+{-# INLINE iso #-}++prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b+prism bt seta = dimap seta (either pure (fmap bt)) . right'+{-# INLINE prism #-}++prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b+prism' bs sma = prism bs (\s -> maybe (Left s) Right (sma s))+{-# INLINE prism' #-}+#endif

@@ -60,21 +60,19 @@     -- * Conversions     toPull,     fromPull,-    _Pull,     toList,     fromList,-    _Vec,     fromListPrefix,     reifyList,     -- * Indexing     (!),-    ix,-    _Cons,-    _head,-    _tail,+    tabulate,     cons,+    snoc,     head,     tail,+    -- * Reverse+    reverse,     -- * Concatenation and splitting     (++),     split,@@ -97,12 +95,15 @@     map,     imap,     traverse,+#ifdef MIN_VERSION_semigroupoids     traverse1,+#endif     itraverse,     itraverse_,     -- * Zipping     zipWith,     izipWith,+    repeat,     -- * Monadic     bind,     join,@@ -112,34 +113,54 @@     ensureSpine,     ) where -import Prelude ()-import Prelude.Compat+import Prelude        (Bool (..), Eq (..), Functor (..), Int, Maybe (..), Monad (..),-       Monoid (..), Num (..), Ord (..), Ordering (EQ), Show (..), ShowS, const,-       flip, id, seq, showParen, showString, ($), (&&), (.), (<$>))+       Num (..), Ord (..), Ordering (EQ), Show (..), ShowS, const, flip, id,+       seq, showParen, showString, uncurry, ($), (&&), (.)) -import Control.Applicative (Applicative (..), liftA2)+import Control.Applicative (Applicative (..), liftA2, (<$>)) import Control.DeepSeq     (NFData (..))-import Data.Distributive   (Distributive (..)) import Data.Fin            (Fin (..))-import Data.Functor.Apply  (Apply (..))-import Data.Functor.Rep    (Representable (..), distributeRep) import Data.Hashable       (Hashable (..))-import Data.Nat+import Data.Monoid         (Monoid (..))+import Data.Nat            (Nat (..)) import Data.Semigroup      (Semigroup (..))  --- Instances-import qualified Control.Lens               as I-import qualified Data.Foldable              as I (Foldable (..))+import qualified Data.Foldable    as I (Foldable (..))+import qualified Data.Traversable as I (Traversable (..))+import qualified Test.QuickCheck  as QC++#ifdef MIN_VERSION_adjunctions+import qualified Data.Functor.Rep as I (Representable (..))+#endif++#ifdef MIN_VERSION_distributive+import Data.Distributive (Distributive (..))+#endif++#ifdef MIN_VERSION_semigroupoids+import Data.Functor.Apply (Apply (..))+ import qualified Data.Functor.Bind          as I (Bind (..)) import qualified Data.Semigroup.Foldable    as I (Foldable1 (..)) import qualified Data.Semigroup.Traversable as I (Traversable1 (..))-import qualified Data.Traversable           as I (Traversable (..))+#endif +-- vec siblings import qualified Data.Fin      as F import qualified Data.Type.Nat as N import qualified Data.Vec.Pull as P +-- $setup+-- >>> :set -XScopedTypeVariables -XDataKinds+-- >>> import Data.Proxy (Proxy (..))+-- >>> import Prelude (Char, not, uncurry, error)++-------------------------------------------------------------------------------+-- Type+-------------------------------------------------------------------------------+ infixr 5 :::  -- | Vector, i.e. length-indexed list.@@ -210,14 +231,17 @@     product = product #endif +#ifdef MIN_VERSION_semigroupoids instance (N.InlineInduction m, n ~ 'S m) => I.Foldable1 (Vec n) where     foldMap1 = foldMap1 +instance (N.InlineInduction m, n ~ 'S m) => I.Traversable1 (Vec n) where+    traverse1 = traverse1+#endif+ instance N.InlineInduction n => I.Traversable (Vec n) where     traverse = traverse -instance (N.InlineInduction m, n ~ 'S m) => I.Traversable1 (Vec n) where-    traverse1 = traverse1  instance (NFData a, N.InlineInduction n) => NFData (Vec n a) where     rnf = getRnf (N.inlineInduction1 z s) where@@ -248,13 +272,17 @@     (>>=)  = bind     _ >> x = x +#ifdef MIN_VERSION_distributive instance N.InlineInduction n => Distributive (Vec n) where-    distribute = distributeRep+    distribute f = tabulate (\k -> fmap (! k) f) -instance N.InlineInduction n => Representable (Vec n) where+#ifdef MIN_VERSION_adjunctions+instance N.InlineInduction n => I.Representable (Vec n) where     type Rep (Vec n) = Fin n-    tabulate = fromPull . tabulate-    index    = index . toPull+    tabulate = tabulate+    index    = (!)+#endif+#endif  instance (Semigroup a, N.InlineInduction n) => Semigroup (Vec n a) where     (<>) = zipWith (<>)@@ -263,62 +291,17 @@     mempty = pure mempty     mappend = zipWith mappend +#ifdef MIN_VERSION_semigroupoids instance N.InlineInduction n => Apply (Vec n) where     (<.>) = zipWith ($)     _ .> x = x     x <. _ = x+    liftF2 = zipWith  instance N.InlineInduction n => I.Bind (Vec n) where     (>>-) = bind     join  = join--instance N.InlineInduction n => I.FunctorWithIndex (Fin n) (Vec n) where-    imap = imap--instance N.InlineInduction n => I.FoldableWithIndex (Fin n) (Vec n) where-    ifoldMap = ifoldMap-    ifoldr   = ifoldr--instance N.InlineInduction n => I.TraversableWithIndex (Fin n) (Vec n) where-    itraverse = itraverse--instance N.InlineInduction n => I.Each (Vec n a) (Vec n b) a b where-    each = traverse--type instance I.Index (Vec n a)   = Fin n-type instance I.IxValue (Vec n a) = a---- | 'Vec' doesn't have 'I.At' instance, as we __cannot__ remove value from 'Vec'.--- See 'ix' in "Data.Vec.DataFamily.SpineStrict" module for an 'I.Lens' (not 'I.Traversal').-instance N.InlineInduction n => I.Ixed (Vec n a) where-    ix = ix--instance I.Field1 (Vec ('S n) a) (Vec ('S n) a) a a where-    _1 = _head--instance I.Field2 (Vec ('S ('S n)) a) (Vec ('S ('S n)) a) a a where-    _2 = _tail . _head--instance I.Field3 (Vec ('S ('S ('S n))) a) (Vec ('S ('S ('S n))) a) a a where-    _3 = _tail . _tail . _head--instance I.Field4 (Vec ('S ('S ('S ('S n)))) a) (Vec ('S ('S ('S ('S n)))) a) a a where-    _4 = _tail . _tail . _tail . _head--instance I.Field5 (Vec ('S ('S ('S ('S ('S n))))) a) (Vec ('S ('S ('S ('S ('S n))))) a) a a where-    _5 = _tail . _tail . _tail . _tail . _head--instance I.Field6 (Vec ('S ('S ('S ('S ('S ('S n)))))) a) (Vec ('S ('S ('S ('S ('S ('S n)))))) a) a a where-    _6 = _tail . _tail . _tail . _tail . _tail . _head--instance I.Field7 (Vec ('S ('S ('S ('S ('S ('S ('S n))))))) a) (Vec ('S ('S ('S ('S ('S ('S ('S n))))))) a) a a where-    _7 = _tail . _tail . _tail . _tail . _tail . _tail . _head--instance I.Field8 (Vec ('S ('S ('S ('S ('S ('S ('S ('S n)))))))) a) (Vec ('S ('S ('S ('S ('S ('S ('S ('S n)))))))) a) a a where-    _8 = _tail . _tail . _tail . _tail . _tail . _tail . _tail . _head--instance I.Field9 (Vec ('S ('S ('S ('S ('S ('S ('S ('S ('S n))))))))) a) (Vec ('S ('S ('S ('S ('S ('S ('S ('S ('S n))))))))) a) a a where-    _9 = _tail . _tail . _tail . _tail . _tail . _tail . _tail . _tail . _head+#endif  ------------------------------------------------------------------------------- -- Construction@@ -364,10 +347,6 @@  newtype FromPull n a = FromPull { getFromPull :: P.Vec n a -> Vec n a } --- | An 'I.Iso' from 'toPull' and 'fromPull'.-_Pull :: N.InlineInduction n => I.Iso (Vec n a) (Vec n b) (P.Vec n a) (P.Vec n b)-_Pull = I.iso toPull fromPull- -- | Convert 'Vec' to list. -- -- >>> toList $ 'f' ::: 'o' ::: 'o' ::: VNil@@ -408,20 +387,6 @@  newtype FromList n a = FromList { getFromList :: [a] -> Maybe (Vec n a) } --- | Prism from list.------ >>> "foo" ^? _Vec :: Maybe (Vec N.Nat3 Char)--- Just ('f' ::: 'o' ::: 'o' ::: VNil)------ >>> "foo" ^? _Vec :: Maybe (Vec N.Nat2 Char)--- Nothing------ >>> _Vec # (True ::: False ::: VNil)--- [True,False]----_Vec :: N.InlineInduction n => I.Prism' [a] (Vec n a)-_Vec = I.prism' toList fromList- -- | Convert list @[a]@ to @'Vec' n a@. -- Returns 'Nothing' if input list is too short. --@@ -476,55 +441,28 @@ (!) :: N.InlineInduction n => Vec n a -> Fin n -> a (!) = flip flipIndex --- | Index lens.------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) ^. ix (FS FZ)--- 'b'------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) & ix (FS FZ) .~ 'x'--- 'a' ::: 'x' ::: 'c' ::: VNil----ix :: forall n a. N.InlineInduction n => Fin n -> I.Lens' (Vec n a) a-ix = getIxLens $ N.inlineInduction1 start step where-    start :: IxLens 'Z a-    start = IxLens F.absurd--    step :: IxLens m a -> IxLens ('S m) a-    step (IxLens l) = IxLens $ \i -> case i of-        FZ   -> _head-        FS j -> _tail . l j--newtype IxLens n a = IxLens { getIxLens :: Fin n -> I.Lens' (Vec n a) a }---- | Match on non-empty 'Vec'.------ /Note:/ @lens@ 'I._Cons' is a 'I.Prism'.--- In fact, @'Vec' n a@ cannot have an instance of 'I.Cons' as types don't match.----_Cons :: I.Iso (Vec ('S n) a) (Vec ('S n) b) (a, Vec n a) (b, Vec n b)-_Cons = I.iso (\(x ::: xs) -> (x, xs)) (\(x, xs) -> x ::: xs)---- | Head lens. /Note:/ @lens@ 'I._head' is a 'I.Traversal''.------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) ^. _head--- 'a'------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) & _head .~ 'x'--- 'x' ::: 'b' ::: 'c' ::: VNil+-- | Tabulating, inverse of '!'. ---_head :: I.Lens' (Vec ('S n) a) a-_head f (x ::: xs) = (::: xs) <$> f x-{-# INLINE head #-}---- | Head lens. /Note:/ @lens@ 'I._head' is a 'I.Traversal''.-_tail :: I.Lens' (Vec ('S n) a) (Vec n a)-_tail f (x ::: xs) = (x :::) <$> f xs-{-# INLINE _tail #-}+-- >>> tabulate id :: Vec N.Nat3 (Fin N.Nat3)+-- 0 ::: 1 ::: 2 ::: VNil+tabulate :: N.InlineInduction n => (Fin n -> a) -> Vec n a+tabulate = fromPull . P.tabulate  -- | Cons an element in front of a 'Vec'. cons :: a -> Vec n a -> Vec ('S n) a cons = (:::) +-- | Add a single element at the end of a 'Vec'.+snoc :: forall n a. N.InlineInduction n => Vec n a -> a -> Vec ('S n) a+snoc xs x = getSnoc (N.inlineInduction1 start step) xs where+    start :: Snoc 'Z a+    start = Snoc $ \ys -> x ::: ys++    step :: Snoc m a -> Snoc ('S m) a+    step (Snoc rec) = Snoc $ \(y ::: ys) -> y ::: rec ys++newtype Snoc n a = Snoc { getSnoc :: Vec n a -> Vec ('S n) a }+ -- | The first element of a 'Vec'. head :: Vec ('S n) a -> a head (x ::: _) = x@@ -534,6 +472,27 @@ tail (_ ::: xs) = xs  -------------------------------------------------------------------------------+-- Reverse+-------------------------------------------------------------------------------++-- | Reverse 'Vec'.+--+-- >>> reverse ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'c' ::: 'b' ::: 'a' ::: VNil+--+-- @since 0.2.1+--+reverse :: forall n a. N.InlineInduction n => Vec n a -> Vec n a+reverse = getReverse (N.inlineInduction1 start step) where+    start :: Reverse 'Z a+    start = Reverse $ \_ -> VNil++    step :: N.InlineInduction m => Reverse m a -> Reverse ('S m) a+    step (Reverse rec) = Reverse $ \(x ::: xs) -> snoc (rec xs) x++newtype Reverse n a = Reverse { getReverse :: Vec n a -> Vec n a }++------------------------------------------------------------------------------- -- Concatenation ------------------------------------------------------------------------------- @@ -655,6 +614,7 @@  newtype Traverse f a n b = Traverse { getTraverse :: Vec n a -> f (Vec n b) } +#ifdef MIN_VERSION_semigroupoids -- | Apply an action to non-empty 'Vec', yielding a 'Vec' of results. traverse1 :: forall n f a b. (Apply f, N.InlineInduction n) => (a -> f b) -> Vec ('S n) a -> f (Vec ('S n) b) traverse1 f = getTraverse1 $ N.inlineInduction1 start step where@@ -665,6 +625,7 @@     step (Traverse1 go) = Traverse1 $ \(x ::: xs) -> liftF2 (:::) (f x) (go xs)  newtype Traverse1 f a n b = Traverse1 { getTraverse1 :: Vec ('S n) a -> f (Vec ('S n) b) }+#endif  -- | Apply an action to every element of a 'Vec' and its index, yielding a 'Vec' of results. itraverse :: forall n f a b. (Applicative f, N.InlineInduction n) => (Fin n -> a -> f b) -> Vec n a -> f (Vec n b)@@ -816,6 +777,15 @@  newtype IZipWith a b c n = IZipWith { getIZipWith :: (Fin n -> a -> b -> c) -> Vec n a -> Vec n b -> Vec n c } +-- | Repeat value+--+-- >>> repeat 'x' :: Vec N.Nat3 Char+-- 'x' ::: 'x' ::: 'x' ::: VNil+--+-- @since 0.2.1+repeat :: N.InlineInduction n => x -> Vec n x+repeat x = N.inlineInduction1 VNil (x :::)+ ------------------------------------------------------------------------------- -- Monadic -------------------------------------------------------------------------------@@ -869,11 +839,23 @@  -- | Ensure spine. ----- >>> view (ix F.fin1) $ set (ix F.fin1) 'x' (error "err" :: Vec N.Nat2 Char)+-- If we have an undefined 'Vec',+--+-- >>> let v = error "err" :: Vec N.Nat3 Char+--+-- And insert data into it later:+--+-- >>> let setHead :: a -> Vec ('S n) a -> Vec ('S n) a; setHead x (_ ::: xs) = x ::: xs+--+-- Then without a spine, it will fail:+--+-- >>> head $ setHead 'x' v -- *** Exception: err -- ... ----- >>> view (ix F.fin1) $ set (ix F.fin1) 'x' $ ensureSpine (error "err" :: Vec N.Nat2 Char)+-- But with the spine, it won't:+--+-- >>> head $ setHead 'x' $ ensureSpine v -- 'x' -- ensureSpine :: N.InlineInduction n => Vec n a -> Vec n a@@ -887,11 +869,38 @@ newtype EnsureSpine n a = EnsureSpine { getEnsureSpine :: Vec n a -> Vec n a }  ---------------------------------------------------------------------------------- Doctest+-- QuickCheck ------------------------------------------------------------------------------- --- $setup--- >>> :set -XScopedTypeVariables--- >>> import Control.Lens ((^.), (&), (.~), (^?), (#), set, view)--- >>> import Data.Proxy (Proxy (..))--- >>> import Prelude.Compat (Char, not, uncurry, error)+instance N.SNatI n => QC.Arbitrary1 (Vec n) where+    liftArbitrary = liftArbitrary+    liftShrink    = liftShrink++liftArbitrary :: forall n a. N.SNatI n => QC.Gen a -> QC.Gen (Vec n a)+liftArbitrary arb = getArb $ N.induction1 (Arb (return VNil)) step where+    step :: Arb m a -> Arb ('S m) a+    step (Arb rec) = Arb $ (:::) <$> arb <*> rec++newtype Arb n a = Arb { getArb :: QC.Gen (Vec n a) }++liftShrink :: forall n a. N.SNatI n => (a -> [a]) -> Vec n a -> [Vec n a]+liftShrink shr = getShr $ N.induction1 (Shr $ \VNil -> []) step where+    step :: Shr m a -> Shr ('S m) a+    step (Shr rec) = Shr $ \(x ::: xs) ->+        uncurry (:::) <$> QC.liftShrink2 shr rec (x, xs)++newtype Shr n a = Shr { getShr :: Vec n a -> [Vec n a] }++instance (N.SNatI n, QC.Arbitrary a) => QC.Arbitrary (Vec n a) where+    arbitrary = QC.arbitrary1+    shrink    = QC.shrink1++instance (N.SNatI n, QC.CoArbitrary a) => QC.CoArbitrary (Vec n a) where+    coarbitrary v = case N.snat :: N.SNat n of+        N.SZ -> QC.variant (0 :: Int)+        N.SS -> QC.variant (1 :: Int) . (case v of (x ::: xs) -> QC.coarbitrary (x, xs))++instance (N.SNatI n, QC.Function a) => QC.Function (Vec n a) where+    function = case N.snat :: N.SNat n of+        N.SZ -> QC.functionMap (\VNil -> ()) (\() -> VNil)+        N.SS -> QC.functionMap (\(x ::: xs) -> (x, xs)) (\(x,xs) -> x ::: xs)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE DefaultSignatures     #-}@@ -24,31 +25,37 @@     GPigeonholeSize,     ) where -import Prelude ()-import Prelude.Compat+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.Functor.Rep                (tabulate)-import Data.Nat                        (Nat)+import Data.Nat                        (Nat (..)) import Data.Proxy                      (Proxy (..))-import Data.Vec.DataFamily.SpineStrict (Vec (..))+import Data.Vec.DataFamily.SpineStrict (Vec (..), tabulate) import GHC.Generics                    ((:*:) (..), M1 (..), Par1 (..), U1 (..)) +import qualified Control.Lens.Yocto              as Lens+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 Control.Lens (view, over) -- >>> import Data.Char (toUpper) -- >>> import Data.Void (absurd) -- >>> import GHC.Generics (Generic, Generic1)+-- >>> import Prelude (Int, Show, Char, Integer)  ------------------------------------------------------------------------------- -- Class@@ -118,13 +125,13 @@  -- | Tabulate. ----- >>> tabulate (\() -> 'x') :: Identity Char+-- >>> gtabulate (\() -> 'x') :: Identity Char -- Identity 'x' ----- >>> tabulate absurd :: Proxy Integer+-- >>> gtabulate absurd :: Proxy Integer -- Proxy ----- >>> tabulate absurd :: Proxy Integer+-- >>> gtabulate absurd :: Proxy Integer -- Proxy -- gtabulate@@ -136,10 +143,10 @@  -- | A lens. @i -> Lens' (t a) a@ ----- >>> view (gix ()) (Identity 'x')+-- >>> Lens.view (gix ()) (Identity 'x') -- 'x' ----- >>> over (gix ()) toUpper (Identity 'x')+-- >>> Lens.over (gix ()) toUpper (Identity 'x') -- Identity 'X' -- gix :: ( G.Generic i, F.GFrom i, G.Generic1 t, GTo t, GFrom t@@ -147,8 +154,40 @@        , Functor f        )     => i -> (a -> f a) -> t a -> f (t a)-gix i = fusing $ \ab ta -> gto <$> V.ix (F.gfrom i) ab (gfrom ta)+gix i = fusing $ \ab ta -> gto <$> ix (F.gfrom i) ab (gfrom ta) +-------------------------------------------------------------------------------+-- Vendored in ix+-------------------------------------------------------------------------------++-- | Index lens.+--+-- >>> Lens.view (ix (FS FZ)) ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'b'+--+-- >>> Lens.set (ix (FS FZ)) 'x' ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'a' ::: 'x' ::: 'c' ::: VNil+--+ix :: forall n f a. (N.InlineInduction n, Functor f) => Fin n -> Lens.LensLike' f (Vec n a) a+ix = getIxLens $ N.inlineInduction1 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 -> Lens.LensLike' f (Vec n a) a }++_head :: Lens.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 :: Lens.Lens' (Vec ('S n) a) (Vec n a)+_tail f (x ::: xs) = (x :::) <$> f xs+{-# INLINE _tail #-}  ------------------------------------------------------------------------------- -- Generic traversable with index

@@ -21,21 +21,19 @@     -- * Conversions     toPull,     fromPull,-    _Pull,     toList,     fromList,-    _Vec,     fromListPrefix,     reifyList,     -- * Indexing     (!),-    ix,-    _Cons,-    _head,-    _tail,+    tabulate,     cons,+    snoc,     head,     tail,+    -- * Reverse+    reverse,     -- * Concatenation and splitting     (++),     split,@@ -59,12 +57,15 @@     map,     imap,     traverse,+#ifdef MIN_VERSION_semigroupoids     traverse1,+#endif     itraverse,     itraverse_,     -- * Zipping     zipWith,     izipWith,+    repeat,     -- * Monadic     bind,     join,@@ -74,36 +75,55 @@     VecEach (..),     )  where -import Prelude ()-import Prelude.Compat+import Prelude        (Bool (..), Eq (..), Functor (..), Int, Maybe (..), Monad (..),-       Monoid (..), Num (..), Ord (..), Show (..), id, seq, showParen,-       showString, ($), (.), (<$>))+       Num (..), Ord (..), Show (..), id, seq, uncurry, showParen, showString, ($), (.)) -import Control.Applicative (Applicative (..))+import Control.Applicative (Applicative (..), (<$>)) import Control.DeepSeq     (NFData (..))-import Control.Lens        ((<&>))-import Data.Distributive   (Distributive (..))+import Control.Lens.Yocto  ((<&>)) import Data.Fin            (Fin (..))-import Data.Functor.Apply  (Apply (..))-import Data.Functor.Rep    (Representable (..), distributeRep) import Data.Hashable       (Hashable (..))-import Data.Nat+import Data.Monoid         (Monoid (..))+import Data.Nat            (Nat (..)) import Data.Semigroup      (Semigroup (..)) import Data.Typeable       (Typeable)  --- Instances-import qualified Control.Lens               as I-import qualified Data.Foldable              as I (Foldable (..))+import qualified Data.Foldable    as I (Foldable (..))+import qualified Data.Traversable as I (Traversable (..))+import qualified Test.QuickCheck  as QC++#ifdef MIN_VERSION_adjunctions+import qualified Data.Functor.Rep as I (Representable (..))+#endif++#ifdef MIN_VERSION_distributive+import Data.Distributive (Distributive (..))+#endif++#ifdef MIN_VERSION_semigroupoids+import Data.Functor.Apply (Apply (..))+ import qualified Data.Functor.Bind          as I (Bind (..)) import qualified Data.Semigroup.Foldable    as I (Foldable1 (..)) import qualified Data.Semigroup.Traversable as I (Traversable1 (..))-import qualified Data.Traversable           as I (Traversable (..))+#endif +-- vec siblings import qualified Data.Fin      as F import qualified Data.Type.Nat as N import qualified Data.Vec.Pull as P +-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Data.Proxy (Proxy (..))+-- >>> import Prelude (Char, not, uncurry)++-------------------------------------------------------------------------------+-- Type+-------------------------------------------------------------------------------+ infixr 5 :::  -- | Vector, i.e. length-indexed list.@@ -142,14 +162,16 @@     product = product #endif -instance n ~ 'S m => I.Foldable1 (Vec n) where-    foldMap1 = foldMap1- instance I.Traversable (Vec n) where     traverse = traverse +#ifdef MIN_VERSION_semigroupoids+instance n ~ 'S m => I.Foldable1 (Vec n) where+    foldMap1 = foldMap1+ instance n ~ 'S m => I.Traversable1 (Vec n) where     traverse1 = traverse1+#endif  instance NFData a => NFData (Vec n a) where     rnf VNil       = ()@@ -162,7 +184,7 @@         `hashWithSalt` xs  instance N.SNatI n => Applicative (Vec n) where-    pure x = N.induction1 VNil (x :::)+    pure   = repeat     (<*>)  = zipWith ($)     _ *> x = x     x <* _ = x@@ -175,13 +197,17 @@     (>>=)  = bind     _ >> x = x +#ifdef MIN_VERSION_distributive instance N.SNatI n => Distributive (Vec n) where-    distribute = distributeRep+    distribute f = tabulate (\k -> fmap (! k) f) -instance N.SNatI n => Representable (Vec n) where+#ifdef MIN_VERSION_adjunctions+instance N.SNatI n => I.Representable (Vec n) where     type Rep (Vec n) = Fin n-    tabulate = fromPull . tabulate-    index    = index . toPull+    tabulate = tabulate+    index    = (!)+#endif+#endif  instance Semigroup a => Semigroup (Vec n a) where     (<>) = zipWith (<>)@@ -190,62 +216,17 @@     mempty = pure mempty     mappend = zipWith mappend +#ifdef MIN_VERSION_semigroupoids instance Apply (Vec n) where-    (<.>) = zipWith ($)+    (<.>)  = zipWith ($)     _ .> x = x     x <. _ = x+    liftF2 = zipWith  instance I.Bind (Vec n) where     (>>-) = bind     join  = join--instance I.FunctorWithIndex (Fin n) (Vec n) where-    imap = imap--instance I.FoldableWithIndex (Fin n) (Vec n) where-    ifoldMap = ifoldMap-    ifoldr   = ifoldr--instance I.TraversableWithIndex (Fin n) (Vec n) where-    itraverse = itraverse--instance I.Each (Vec n a) (Vec n b) a b where-    each = traverse--type instance I.Index (Vec n a)   = Fin n-type instance I.IxValue (Vec n a) = a---- | 'Vec' doesn't have 'I.At' instance, as we __cannot__ remove value from 'Vec'.--- See 'ix' in "Data.Vec.Lazy" module for an 'I.Lens' (not 'I.Traversal').-instance I.Ixed (Vec n a) where-    ix = ix--instance I.Field1 (Vec ('S n) a) (Vec ('S n) a) a a where-    _1 = _head--instance I.Field2 (Vec ('S ('S n)) a) (Vec ('S ('S n)) a) a a where-    _2 = _tail . _head--instance I.Field3 (Vec ('S ('S ('S n))) a) (Vec ('S ('S ('S n))) a) a a where-    _3 = _tail . _tail . _head--instance I.Field4 (Vec ('S ('S ('S ('S n)))) a) (Vec ('S ('S ('S ('S n)))) a) a a where-    _4 = _tail . _tail . _tail . _head--instance I.Field5 (Vec ('S ('S ('S ('S ('S n))))) a) (Vec ('S ('S ('S ('S ('S n))))) a) a a where-    _5 = _tail . _tail . _tail . _tail . _head--instance I.Field6 (Vec ('S ('S ('S ('S ('S ('S n)))))) a) (Vec ('S ('S ('S ('S ('S ('S n)))))) a) a a where-    _6 = _tail . _tail . _tail . _tail . _tail . _head--instance I.Field7 (Vec ('S ('S ('S ('S ('S ('S ('S n))))))) a) (Vec ('S ('S ('S ('S ('S ('S ('S n))))))) a) a a where-    _7 = _tail . _tail . _tail . _tail . _tail . _tail . _head--instance I.Field8 (Vec ('S ('S ('S ('S ('S ('S ('S ('S n)))))))) a) (Vec ('S ('S ('S ('S ('S ('S ('S ('S n)))))))) a) a a where-    _8 = _tail . _tail . _tail . _tail . _tail . _tail . _tail . _head--instance I.Field9 (Vec ('S ('S ('S ('S ('S ('S ('S ('S ('S n))))))))) a) (Vec ('S ('S ('S ('S ('S ('S ('S ('S ('S n))))))))) a) a a where-    _9 = _tail . _tail . _tail . _tail . _tail . _tail . _tail . _tail . _head+#endif  ------------------------------------------------------------------------------- -- Construction@@ -296,10 +277,6 @@     N.SZ -> VNil     N.SS -> f FZ ::: fromPull (P.Vec (f . FS)) --- | An 'I.Iso' from 'toPull' and 'fromPull'.-_Pull :: N.SNatI n => I.Iso (Vec n a) (Vec n b) (P.Vec n a) (P.Vec n b)-_Pull = I.iso toPull fromPull- -- | Convert 'Vec' to list. -- -- >>> toList $ 'f' ::: 'o' ::: 'o' ::: VNil@@ -334,20 +311,6 @@  newtype FromList n a = FromList { getFromList :: [a] -> Maybe (Vec n a) } --- | Prism from list.------ >>> "foo" ^? _Vec :: Maybe (Vec N.Nat3 Char)--- Just ('f' ::: 'o' ::: 'o' ::: VNil)------ >>> "foo" ^? _Vec :: Maybe (Vec N.Nat2 Char)--- Nothing------ >>> _Vec # (True ::: False ::: VNil)--- [True,False]----_Vec :: N.SNatI n => I.Prism' [a] (Vec n a)-_Vec = I.prism' toList fromList- -- | Convert list @[a]@ to @'Vec' n a@. -- Returns 'Nothing' if input list is too short. --@@ -392,47 +355,25 @@ (!) (_ ::: xs) (FS n) = xs ! n (!) VNil n = case n of {} --- | Index lens.------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) ^. ix (FS FZ)--- 'b'------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) & ix (FS FZ) .~ 'x'--- 'a' ::: 'x' ::: 'c' ::: VNil----ix :: Fin n -> I.Lens' (Vec n a) a-ix FZ     f (x ::: xs) = (::: xs) <$> f x-ix (FS n) f (x ::: xs) = (x :::)  <$> ix n f xs---- | Match on non-empty 'Vec'.------ /Note:/ @lens@ 'I._Cons' is a 'I.Prism'.--- In fact, @'Vec' n a@ cannot have an instance of 'I.Cons' as types don't match.----_Cons :: I.Iso (Vec ('S n) a) (Vec ('S n) b) (a, Vec n a) (b, Vec n b)-_Cons = I.iso (\(x ::: xs) -> (x, xs)) (\(x, xs) -> x ::: xs)---- | Head lens. /Note:/ @lens@ 'I._head' is a 'I.Traversal''.------ >>> ('a' ::: 'b' ::: 'c' ::: VNil) ^. _head--- 'a'+-- | Tabulating, inverse of '!'. ----- >>> ('a' ::: 'b' ::: 'c' ::: VNil) & _head .~ 'x'--- 'x' ::: 'b' ::: 'c' ::: VNil+-- >>> tabulate id :: Vec N.Nat3 (Fin N.Nat3)+-- 0 ::: 1 ::: 2 ::: VNil ---_head :: I.Lens' (Vec ('S n) a) a-_head f (x ::: xs) = (::: xs) <$> f x-{-# INLINE head #-}---- | Head lens. /Note:/ @lens@ 'I._head' is a 'I.Traversal''.-_tail :: I.Lens' (Vec ('S n) a) (Vec n a)-_tail f (x ::: xs) = (x :::) <$> f xs-{-# INLINE _tail #-}+tabulate :: N.SNatI n => (Fin n -> a) -> Vec n a+tabulate = fromPull . P.tabulate  -- | Cons an element in front of a 'Vec'. cons :: a -> Vec n a -> Vec ('S n) a cons = (:::) +-- | Add a single element at the end of a 'Vec'.+--+-- @since 0.2.1+snoc :: Vec n a -> a -> Vec ('S n) a+snoc VNil       x = x ::: VNil+snoc (y ::: ys) x = y ::: snoc ys x+ -- | The first element of a 'Vec'. head :: Vec ('S n) a -> a head (x ::: _) = x@@ -442,6 +383,21 @@ tail (_ ::: xs) = xs  -------------------------------------------------------------------------------+-- Reverse+-------------------------------------------------------------------------------++-- | Reverse 'Vec'.+--+-- >>> reverse ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'c' ::: 'b' ::: 'a' ::: VNil+--+-- @since 0.2.1+--+reverse :: Vec n a -> Vec n a+reverse VNil       = VNil+reverse (x ::: xs) = snoc (reverse xs) x++------------------------------------------------------------------------------- -- Concatenation ------------------------------------------------------------------------------- @@ -534,17 +490,19 @@     go VNil       = pure VNil     go (x ::: xs) = (:::) <$> f x <*> go xs +#ifdef MIN_VERSION_semigroupoids -- | Apply an action to non-empty 'Vec', yielding a 'Vec' of results. traverse1 :: forall n f a b. Apply f => (a -> f b) -> Vec ('S n) a -> f (Vec ('S n) b) traverse1 f = go where     go :: Vec ('S m) a -> f (Vec ('S m) b)     go (x ::: VNil)         = (::: VNil) <$> f x     go (x ::: xs@(_ ::: _)) = (:::) <$> f x <.> go xs+#endif  -- | Apply an action to every element of a 'Vec' and its index, yielding a 'Vec' of results. itraverse :: Applicative f => (Fin n -> a -> f b) -> Vec n a -> f (Vec n b) itraverse _ VNil       = pure VNil-itraverse f (x ::: xs) = (:::) <$> f FZ x <*> I.itraverse (f . FS) xs+itraverse f (x ::: xs) = (:::) <$> f FZ x <*> itraverse (f . FS) xs  -- | Apply an action to every element of a 'Vec' and its index, ignoring the results. itraverse_ :: Applicative f => (Fin n -> a -> f b) -> Vec n a -> f ()@@ -596,8 +554,10 @@  -- | Yield the length of a 'Vec'. /O(n)/ length :: Vec n a -> Int-length VNil = 0-length (_ ::: xs) = 1 + length xs+length = go 0 where+    go :: Int -> Vec n a -> Int+    go !acc VNil       = acc+    go  acc (_ ::: xs) = go (1 + acc) xs  -- | Test whether a 'Vec' is empty. /O(1)/ null :: Vec n a -> Bool@@ -632,6 +592,15 @@ izipWith _ VNil       VNil       = VNil izipWith f (x ::: xs) (y ::: ys) = f FZ x y ::: izipWith (f . FS) xs ys +-- | Repeat a value.+--+-- >>> repeat 'x' :: Vec N.Nat3 Char+-- 'x' ::: 'x' ::: 'x' ::: VNil+--+-- @since 0.2.1+repeat :: N.SNatI n => x -> Vec n x+repeat x = N.induction1 VNil (x :::)+ ------------------------------------------------------------------------------- -- Monadic -------------------------------------------------------------------------------@@ -690,7 +659,10 @@ -- -- where @betterDslMagic@ can be defined using 'traverseWithVec'. ---class I.Each s t a b => VecEach s t a b | s -> a, t -> b, s b -> t, t a -> s where+-- Moreally @lens@ 'Each' should be a superclass, but+-- there's no strict need for it.+--+class VecEach s t a b | s -> a, t -> b, s b -> t, t a -> s where     mapWithVec :: (forall n. N.InlineInduction n => Vec n a -> Vec n b) -> s -> t     traverseWithVec :: Applicative f => (forall n. N.InlineInduction n => Vec n a -> f (Vec n b)) -> s -> f t @@ -716,11 +688,38 @@         x' ::: y' ::: z' ::: u' ::: VNil -> (x', y', z', u')  ---------------------------------------------------------------------------------- Doctest+-- QuickCheck ------------------------------------------------------------------------------- --- $setup--- >>> :set -XScopedTypeVariables--- >>> import Control.Lens ((^.), (&), (.~), (^?), (#))--- >>> import Data.Proxy (Proxy (..))--- >>> import Prelude.Compat (Char, not, uncurry)+instance N.SNatI n => QC.Arbitrary1 (Vec n) where+    liftArbitrary = liftArbitrary+    liftShrink    = liftShrink++liftArbitrary :: forall n a. N.SNatI n => QC.Gen a -> QC.Gen (Vec n a)+liftArbitrary arb = getArb $ N.induction1 (Arb (return VNil)) step where+    step :: Arb m a -> Arb ('S m) a+    step (Arb rec) = Arb $ (:::) <$> arb <*> rec++newtype Arb n a = Arb { getArb :: QC.Gen (Vec n a) }++liftShrink :: forall n a. N.SNatI n => (a -> [a]) -> Vec n a -> [Vec n a]+liftShrink shr = getShr $ N.induction1 (Shr $ \VNil -> []) step where+    step :: Shr m a -> Shr ('S m) a+    step (Shr rec) = Shr $ \(x ::: xs) ->+        uncurry (:::) <$> QC.liftShrink2 shr rec (x, xs)++newtype Shr n a = Shr { getShr :: Vec n a -> [Vec n a] }++instance (N.SNatI n, QC.Arbitrary a) => QC.Arbitrary (Vec n a) where+    arbitrary = QC.arbitrary1+    shrink    = QC.shrink1++instance (N.SNatI n, QC.CoArbitrary a) => QC.CoArbitrary (Vec n a) where+    coarbitrary v = case N.snat :: N.SNat n of+        N.SZ -> QC.variant (0 :: Int)+        N.SS -> QC.variant (1 :: Int) . (case v of (x ::: xs) -> QC.coarbitrary (x, xs))++instance (N.SNatI n, QC.Function a) => QC.Function (Vec n a) where+    function = case N.snat :: N.SNat n of+        N.SZ -> QC.functionMap (\VNil -> ()) (\() -> VNil)+        N.SS -> QC.functionMap (\(x ::: xs) -> (x, xs)) (\(x,xs) -> x ::: xs)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE GADTs                 #-}@@ -20,19 +21,15 @@     -- * Conversions     toPull,     fromPull,-    _Pull,     toList,     fromList,-    _Vec,     fromListPrefix,     reifyList,     -- * Indexing     (!),-    ix,-    _Cons,-    _head,-    _tail,+    tabulate,     cons,+    snoc,     head,     tail,     -- * Concatenation and splitting@@ -41,6 +38,8 @@     concatMap,     concat,     chunks,+    -- * Reverse+    reverse,     -- * Folds     foldMap,     foldMap1,@@ -57,12 +56,15 @@     map,     imap,     traverse,+#ifdef MIN_VERSION_semigroupoids     traverse1,+#endif     itraverse,     itraverse_,     -- * Zipping     zipWith,     izipWith,+    repeat,     -- * Monadic     bind,     join,@@ -72,27 +74,33 @@     VecEach (..)     )  where -import Prelude ()-import Prelude.Compat-       (Applicative (..), Int, Maybe (..), Monoid (..), Num (..), const, flip,-       id, ($), (.), (<$>))+import Prelude (Int, Maybe (..), Num (..), const, flip, id, ($), (.)) -import Control.Applicative (liftA2)+import Control.Applicative (Applicative (pure, (*>)), liftA2, (<$>)) import Data.Fin            (Fin (..))-import Data.Functor.Apply  (Apply, liftF2)-import Data.Nat+import Data.Monoid         (Monoid (..))+import Data.Nat            (Nat (..)) import Data.Semigroup      (Semigroup (..)) import Data.Vec.Lazy        (Vec (..), VecEach (..), cons, empty, head, null, reifyList, singleton,-       tail, _Cons, _head, _tail)+       tail)  --- Instances-import qualified Control.Lens as I +#ifdef MIN_VERSION_semigroupoids+import Data.Functor.Apply  (Apply, liftF2)+#endif++-- vec siblings import qualified Data.Fin      as F import qualified Data.Type.Nat as N import qualified Data.Vec.Pull as P +-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Data.Proxy (Proxy (..))+-- >>> import Prelude (Char, not, uncurry, Bool (..))+ ------------------------------------------------------------------------------- -- Conversions -------------------------------------------------------------------------------@@ -121,10 +129,6 @@  newtype FromPull n a = FromPull { getFromPull :: P.Vec n a -> Vec n a } --- | An 'I.Iso' from 'toPull' and 'fromPull'.-_Pull :: N.InlineInduction n => I.Iso (Vec n a) (Vec n b) (P.Vec n a) (P.Vec n b)-_Pull = I.iso toPull fromPull- -- | Convert 'Vec' to list. -- -- >>> toList $ 'f' ::: 'o' ::: 'o' ::: VNil@@ -165,20 +169,6 @@  newtype FromList n a = FromList { getFromList :: [a] -> Maybe (Vec n a) } --- | Prism from list.------ >>> "foo" ^? _Vec :: Maybe (Vec N.Nat3 Char)--- Just ('f' ::: 'o' ::: 'o' ::: VNil)------ >>> "foo" ^? _Vec :: Maybe (Vec N.Nat2 Char)--- Nothing------ >>> _Vec # (True ::: False ::: VNil)--- [True,False]----_Vec :: N.InlineInduction n => I.Prism' [a] (Vec n a)-_Vec = I.prism' toList fromList- -- | Convert list @[a]@ to @'Vec' n a@. -- Returns 'Nothing' if input list is too short. --@@ -225,27 +215,50 @@ (!) :: N.InlineInduction n => Vec n a -> Fin n -> a (!) = flip flipIndex --- | Index lens.+-- | Tabulating, inverse of '!'. ----- >>> ('a' ::: 'b' ::: 'c' ::: VNil) ^. ix (FS FZ)--- 'b'+-- >>> tabulate id :: Vec N.Nat3 (Fin N.Nat3)+-- 0 ::: 1 ::: 2 ::: VNil ----- >>> ('a' ::: 'b' ::: 'c' ::: VNil) & ix (FS FZ) .~ 'x'--- 'a' ::: 'x' ::: 'c' ::: VNil+tabulate :: N.InlineInduction n => (Fin n -> a) -> Vec n a+tabulate = fromPull . P.tabulate++-- | Add a single element at the end of a 'Vec'. ---ix :: N.InlineInduction n => Fin n -> I.Lens' (Vec n a) a-ix = getIxLens $ N.inlineInduction1 start step where-    start :: IxLens 'Z a-    start = IxLens F.absurd+-- @since 0.2.1+--+snoc :: forall n a. N.InlineInduction n => Vec n a -> a -> Vec ('S n) a+snoc xs x = getSnoc (N.inlineInduction1 start step) xs where+    start :: Snoc 'Z a+    start = Snoc $ \ys -> x ::: ys -    step :: IxLens m a -> IxLens ('S m) a-    step (IxLens l) = IxLens $ \i -> case i of-        FZ   -> _head-        FS j -> _tail . l j+    step :: Snoc m a -> Snoc ('S m) a+    step (Snoc rec) = Snoc $ \(y ::: ys) -> y ::: rec ys -newtype IxLens n a = IxLens { getIxLens :: Fin n -> I.Lens' (Vec n a) a }+newtype Snoc n a = Snoc { getSnoc :: Vec n a -> Vec ('S n) a }  -------------------------------------------------------------------------------+-- Reverse+-------------------------------------------------------------------------------++-- | Reverse 'Vec'.+--+-- >>> reverse ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'c' ::: 'b' ::: 'a' ::: VNil+--+-- @since 0.2.1+--+reverse :: forall n a. N.InlineInduction n => Vec n a -> Vec n a+reverse = getReverse (N.inlineInduction1 start step) where+    start :: Reverse 'Z a+    start = Reverse $ \_ -> VNil++    step :: N.InlineInduction m => Reverse m a -> Reverse ('S m) a+    step (Reverse rec) = Reverse $ \(x ::: xs) -> snoc (rec xs) x++newtype Reverse n a = Reverse { getReverse :: Vec n a -> Vec n a }++------------------------------------------------------------------------------- -- Concatenation ------------------------------------------------------------------------------- @@ -365,6 +378,7 @@  newtype Traverse f a n b = Traverse { getTraverse :: Vec n a -> f (Vec n b) } +#ifdef MIN_VERSION_semigroupoids -- | Apply an action to non-empty 'Vec', yielding a 'Vec' of results. traverse1 :: forall n f a b. (Apply f, N.InlineInduction n) => (a -> f b) -> Vec ('S n) a -> f (Vec ('S n) b) traverse1 f = getTraverse1 $ N.inlineInduction1 start step where@@ -375,6 +389,7 @@     step (Traverse1 go) = Traverse1 $ \(x ::: xs) -> liftF2 (:::) (f x) (go xs)  newtype Traverse1 f a n b = Traverse1 { getTraverse1 :: Vec ('S n) a -> f (Vec ('S n) b) }+#endif  -- | Apply an action to every element of a 'Vec' and its index, yielding a 'Vec' of results. itraverse :: forall n f a b. (Applicative f, N.InlineInduction n) => (Fin n -> a -> f b) -> Vec n a -> f (Vec n b)@@ -518,6 +533,15 @@  newtype IZipWith a b c n = IZipWith { getIZipWith :: (Fin n -> a -> b -> c) -> Vec n a -> Vec n b -> Vec n c } +-- | Repeat value+--+-- >>> repeat 'x' :: Vec N.Nat3 Char+-- 'x' ::: 'x' ::: 'x' ::: VNil+--+-- @since 0.2.1+repeat :: N.InlineInduction n => x -> Vec n x+repeat x = N.inlineInduction1 VNil (x :::)+ ------------------------------------------------------------------------------- -- Monadic -------------------------------------------------------------------------------@@ -564,13 +588,3 @@     step (Universe go) = Universe (FZ ::: map FS go)  newtype Universe n = Universe { getUniverse :: Vec n (Fin n) }------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup--- >>> :set -XScopedTypeVariables--- >>> import Control.Lens ((^.), (&), (.~), (^?), (#))--- >>> import Data.Proxy (Proxy (..))--- >>> import Prelude.Compat (Char, Bool (..), not, uncurry)

@@ -6,6 +6,7 @@ {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-} -- | Pull/representable @'Vec' n a = 'Fin' n -> a@. -- -- The module tries to have same API as "Data.Vec.Lazy", missing bits:@@ -19,17 +20,17 @@     -- * Conversions     toList,     fromList,-    _Vec,     fromListPrefix,     reifyList,     -- * Indexing     (!),-    ix,-    _Cons,-    _head,-    _tail,+    tabulate,+    cons,+    snoc,     head,     tail,+    -- * Reverse+    reverse,     -- * Folds     foldMap,     foldMap1,@@ -49,6 +50,7 @@     -- * Zipping     zipWith,     izipWith,+    repeat,     -- * Monadic     bind,     join,@@ -56,31 +58,51 @@     universe,     ) where -import Prelude ()-import Prelude.Compat+import Prelude        (Bool (..), Eq (..), Functor (..), Int, Maybe (..), Monad (..),-       Monoid (..), Num (..), all, const, id, ($), (.), (<$>))+       Num (..), all, const, id, ($), (.)) -import Control.Applicative (Applicative (..))-import Control.Lens        ((<&>))-import Data.Distributive   (Distributive (..))+import Control.Applicative (Applicative (..), (<$>)) import Data.Fin            (Fin (..))-import Data.Functor.Apply  (Apply (..))-import Data.Functor.Rep    (Representable (..))-import Data.Nat+import Data.List.NonEmpty  (NonEmpty (..))+import Data.Monoid         (Monoid (..))+import Data.Nat            (Nat (..)) import Data.Proxy          (Proxy (..)) import Data.Semigroup      (Semigroup (..)) import Data.Typeable       (Typeable)  --- Instances-import qualified Control.Lens            as I-import qualified Data.Foldable           as I (Foldable (..))+import qualified Data.Foldable as I (Foldable (..))++#ifdef MIN_VERSION_adjunctions+import qualified Data.Functor.Rep as I (Representable (..))+#endif++#ifdef MIN_VERSION_distributive+import Data.Distributive   (Distributive (..))+#endif++#ifdef MIN_VERSION_semigroupoids+import Data.Functor.Apply (Apply (..))+ import qualified Data.Functor.Bind       as I (Bind (..)) import qualified Data.Semigroup.Foldable as I (Foldable1 (..))+#endif +-- vec siblings import qualified Data.Fin      as F import qualified Data.Type.Nat as N +-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Data.Proxy (Proxy (..))+-- >>> import Prelude (Char, Bool (..), not)+-- >>> import qualified Data.Vec.Lazy as L++-------------------------------------------------------------------------------+-- Type+-------------------------------------------------------------------------------+ -- | Easily fuseable 'Vec'. -- -- It unpurpose don't have /bad/ (fusion-wise) instances, like 'Traversable'.@@ -97,8 +119,13 @@ instance N.SNatI n => I.Foldable (Vec n) where     foldMap = foldMap +#ifdef MIN_VERSION_semigroupoids+instance (N.SNatI m, n ~ 'S m)  => I.Foldable1 (Vec n) where+    foldMap1 = foldMap1+#endif+ instance Applicative (Vec n) where-    pure   = Vec . pure+    pure   = repeat     (<*>)  = zipWith ($)     _ *> x = x     x <* _ = x@@ -111,13 +138,17 @@     (>>=)  = bind     _ >> x = x +#ifdef MIN_VERSION_distributive instance Distributive (Vec n) where     distribute = Vec . distribute . fmap unVec -instance Representable (Vec n) where+#ifdef MIN_VERSION_adjunctions+instance I.Representable (Vec n) where     type Rep (Vec n) = Fin n     tabulate = Vec     index    = unVec+#endif+#endif  instance Semigroup a => Semigroup (Vec n a) where     Vec a <> Vec b = Vec (a <> b)@@ -126,21 +157,17 @@     mempty = Vec mempty     Vec a `mappend` Vec b = Vec (mappend a b) +#ifdef MIN_VERSION_semigroupoids instance Apply (Vec n) where     (<.>)  = zipWith ($)     _ .> x = x     x <. _ = x+    liftF2 = zipWith  instance I.Bind (Vec n) where     (>>-) = bind     join  = join--instance I.FunctorWithIndex (Fin n) (Vec n) where-    imap = imap--instance N.SNatI n => I.FoldableWithIndex (Fin n) (Vec n) where-    ifoldMap = ifoldMap-    ifoldr   = ifoldr+#endif  ------------------------------------------------------------------------------- -- Construction@@ -192,10 +219,6 @@  newtype FromList n a = FromList { getFromList :: [a] -> Maybe (Vec n a) } --- | Prism from list.-_Vec :: N.SNatI n => I.Prism' [a] (Vec n a)-_Vec = I.prism' toList fromList- -- | Convert list @[a]@ to @'Vec' n a@. -- Returns 'Nothing' if input list is too short. --@@ -234,52 +257,24 @@ (!) :: Vec n a -> Fin n -> a (!) = unVec --- | Index lens.------ >>> ('a' L.::: 'b' L.::: 'c' L.::: L.VNil) ^. L._Pull . ix (FS FZ)--- 'b'------ >>> ('a' L.::: 'b' L.::: 'c' L.::: L.VNil) & L._Pull . ix (FS FZ) .~ 'x'--- 'a' ::: 'x' ::: 'c' ::: VNil----ix :: Fin n -> I.Lens' (Vec n a) a-ix i f (Vec v) = f (v i) <&> \a -> Vec $ \j ->-    if i == j-    then a-    else v j---- | Match on non-empty 'Vec'.------ /Note:/ @lens@ 'I._Cons' is a 'I.Prism'.--- In fact, @'Vec' n a@ cannot have an instance of 'I.Cons' as types don't match.----_Cons :: I.Iso (Vec ('S n) a) (Vec ('S n) b) (a, Vec n a) (b, Vec n b)-_Cons = I.iso (\(Vec v) -> (v FZ, Vec (v . FS))) (\(x, xs) -> cons x xs)---- | Head lens. /Note:/ @lens@ 'I._head' is a 'I.Traversal''.------ >>> ('a' L.::: 'b' L.::: 'c' L.::: L.VNil) ^. L._Pull . _head--- 'a'------ >>> ('a' L.::: 'b' L.::: 'c' L.::: L.VNil) & L._Pull . _head .~ 'x'--- 'x' ::: 'b' ::: 'c' ::: VNil----_head :: I.Lens' (Vec ('S n) a) a-_head f (Vec v) = f (v FZ) <&> \a -> Vec $ \j -> case j of-    FZ -> a-    _   -> v j-{-# INLINE head #-}---- | Head lens. /Note:/ @lens@ 'I._head' is a 'I.Traversal''.-_tail :: I.Lens' (Vec ('S n) a) (Vec n a)-_tail f (Vec v) = f (Vec (v . FS)) <&> \xs -> cons (v FZ) xs-{-# INLINE _tail #-}+-- Tabulating, inverse of '!'.+tabulate :: (Fin n -> a) -> Vec n a+tabulate = Vec +-- | Cons an element in front of a 'Vec'. cons :: a -> Vec n a -> Vec ('S n) a cons x (Vec v) = Vec $ \i -> case i of     FZ   -> x     FS j -> v j +-- | Add a single element at the end of a 'Vec'.+--+-- @since 0.2.1+snoc :: forall a n. N.InlineInduction n => Vec n a -> a -> Vec ('S n) a+snoc (Vec xs) x = Vec $ \i -> case F.isMax i of+    Nothing -> x+    Just i' -> xs i'+ -- | The first element of a 'Vec'. head :: Vec ('S n) a -> a head (Vec v) = v FZ@@ -289,16 +284,27 @@ tail (Vec v) = Vec (v . FS)  -------------------------------------------------------------------------------+-- Reverse+-------------------------------------------------------------------------------++-- | Reverse 'Vec'.+--+-- @since 0.2.1+--+reverse :: forall n a. N.InlineInduction n => Vec n a -> Vec n a+reverse (Vec v) = Vec (v . F.mirror)++------------------------------------------------------------------------------- -- Mapping ------------------------------------------------------------------------------- --- | >>> over L._Pull (map not) (True L.::: False L.::: L.VNil)+-- | >>> L.fromPull $ map not $ L.toPull $ True L.::: False L.::: L.VNil -- False ::: True ::: VNil -- map :: (a -> b) -> Vec n a -> Vec n b map f (Vec v) = Vec (f . v) --- | >>> over L._Pull (imap (,)) ('a' L.::: 'b' L.::: 'c' L.::: L.VNil)+-- | >>> L.fromPull $ imap (,) $ L.toPull $ 'a' L.::: 'b' L.::: 'c' L.::: L.VNil -- (0,'a') ::: (1,'b') ::: (2,'c') ::: VNil -- imap :: (Fin n -> a -> b) -> Vec n a -> Vec n b@@ -312,18 +318,23 @@ foldMap :: (Monoid m, N.SNatI n) => (a -> m) -> Vec n a -> m foldMap f (Vec v) = I.foldMap (f . v) F.universe --- | See 'I.Foldable1'.-foldMap1 :: (Semigroup s, N.SNatI n) => (a -> s) -> Vec ('S n) a -> s-foldMap1 f (Vec v) = I.foldMap1 (f . v) F.universe1- -- | See 'I.FoldableWithIndex'. ifoldMap :: (Monoid m, N.SNatI n) => (Fin n -> a -> m) -> Vec n a -> m ifoldMap f (Vec v) = I.foldMap (\i -> f i (v i)) F.universe +-- | See 'I.Foldable1'.+foldMap1 :: (Semigroup s, N.SNatI n) => (a -> s) -> Vec ('S n) a -> s+foldMap1 f (Vec v) = neFoldMap (f . v) F.universe1+ -- | There is no type-class for this :( ifoldMap1 :: (Semigroup s, N.SNatI n) => (Fin ('S n) -> a -> s) -> Vec ('S n) a -> s-ifoldMap1 f (Vec v) = I.foldMap1 (\i -> f i (v i)) F.universe1+ifoldMap1 f (Vec v) = neFoldMap (\i -> f i (v i)) F.universe1 +neFoldMap :: Semigroup s => (a -> s) -> NonEmpty a -> s+neFoldMap f (z :| zs) = go z zs where+    go x []       = f x+    go x (y : ys) = f x <> go y ys+ -- | Right fold. foldr :: N.SNatI n => (a -> b -> b) -> b -> Vec n a -> b foldr f z (Vec v) = I.foldr (\a b -> f (v a) b) z F.universe@@ -370,6 +381,12 @@ izipWith :: (Fin n -> a -> b -> c) -> Vec n a -> Vec n b -> Vec n c izipWith f (Vec xs) (Vec ys) = Vec $ \i -> f i (xs i) (ys i) +-- | Repeat value+--+-- @since 0.2.1+repeat :: x -> Vec n x+repeat = Vec . pure+ ------------------------------------------------------------------------------- -- Monadic -------------------------------------------------------------------------------@@ -392,14 +409,3 @@ -- 0 ::: 1 ::: 2 ::: VNil universe :: N.SNatI n => Vec n (Fin n) universe = Vec id------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup--- >>> :set -XScopedTypeVariables--- >>> import Control.Lens ((^.), (&), (.~), over)--- >>> import Data.Proxy (Proxy (..))--- >>> import Prelude.Compat (Char, Bool (..), not)--- >>> import qualified Data.Vec.Lazy as L

@@ -87,3 +87,35 @@  inspect $ 'lhsJoin  === 'rhsJoin inspect $ 'lhsJoin' =/= 'rhsJoin++-------------------------------------------------------------------------------+-- snoc+-------------------------------------------------------------------------------++lhsSnoc :: Vec N.Nat3 Char+lhsSnoc = I.snoc ('a' ::: 'b' ::: VNil) 'c'++lhsSnoc' :: Vec N.Nat3 Char+lhsSnoc' = L.snoc ('a' ::: 'b' ::: VNil) 'c'++rhsSnoc :: Vec N.Nat3 Char+rhsSnoc = 'a' ::: 'b' ::: 'c' ::: VNil++inspect $ 'lhsSnoc  === 'rhsSnoc+inspect $ 'lhsSnoc' =/= 'rhsSnoc++-------------------------------------------------------------------------------+-- reverse+-------------------------------------------------------------------------------++lhsReverse :: Vec N.Nat3 Char+lhsReverse = I.reverse $ 'c' ::: 'b' ::: 'a' ::: VNil++lhsReverse' :: Vec N.Nat3 Char+lhsReverse' = L.reverse $ 'c' ::: 'b' ::: 'a' ::: VNil++rhsReverse :: Vec N.Nat3 Char+rhsReverse = 'a' ::: 'b' ::: 'c' ::: VNil++inspect $ 'lhsReverse  === 'rhsReverse+inspect $ 'lhsReverse' =/= 'rhsReverse

@@ -69,3 +69,27 @@ rhsJoin = 'a' ::: 'd' ::: VNil  inspect $ 'lhsJoin  === 'rhsJoin++-------------------------------------------------------------------------------+-- snoc+-------------------------------------------------------------------------------++lhsSnoc :: Vec N.Nat3 Char+lhsSnoc = I.snoc ('a' ::: 'b' ::: VNil) 'c'++rhsSnoc :: Vec N.Nat3 Char+rhsSnoc = 'a' ::: 'b' ::: 'c' ::: VNil++inspect $ 'lhsSnoc  === 'rhsSnoc++-------------------------------------------------------------------------------+-- reverse+-------------------------------------------------------------------------------++lhsReverse :: Vec N.Nat3 Char+lhsReverse = I.reverse $ 'c' ::: 'b' ::: 'a' ::: VNil++rhsReverse :: Vec N.Nat3 Char+rhsReverse = 'a' ::: 'b' ::: 'c' ::: VNil++inspect $ 'lhsReverse  === 'rhsReverse

@@ -1,6 +1,6 @@-cabal-version:      >=1.10+cabal-version:      2.2 name:               vec-version:            0.2+version:            0.3 synopsis:           Vec: length-indexed (sized) list category:           Data, Dependent Types description:@@ -29,6 +29,8 @@   .   This package uses [fin](https://hackage.haskell.org/package/fin), i.e. not @GHC.TypeLits@, for indexes.   .+  For @lens@ or @optics@ support see [vec-lens](https://hackage.haskell.org/package/vec-lens) and [vec-optics](https://hackage.haskell.org/package/vec-optics) packages respectively.+  .   See [Hasochism: the pleasure and pain of dependently typed haskell programming](https://doi.org/10.1145/2503778.2503786)   by Sam Lindley and Conor McBride for answers to /how/ and /why/.   Read [APLicative Programming with Naperian Functors](https://doi.org/10.1007/978-3-662-54434-1_21)@@ -60,7 +62,7 @@  homepage:           https://github.com/phadej/vec bug-reports:        https://github.com/phadej/vec/issues-license:            BSD3+license:            BSD-3-Clause license-file:       LICENSE author:             Oleg Grenrus <oleg.grenrus@iki.fi> maintainer:         Oleg.Grenrus <oleg.grenrus@iki.fi>@@ -79,8 +81,31 @@ source-repository head   type:     git   location: https://github.com/phadej/vec.git+  subdir:   vec +flag adjunctions+  description: Depend on @adjunctions@ to provide its instances+  manual:      True+  default:     True++flag distributive+  description:+    Depend on @distributive@ to provide its instances. Turning on, disables @adjunctions@ too.++  manual:      True+  default:     True++flag semigroupoids+  description:+    Depend on @semigroupoids@ to provide its instances, and `traverse1`.++  manual:      True+  default:     True+ library+  default-language: Haskell2010+  ghc-options:      -Wall -fprint-explicit-kinds+  hs-source-dirs:   src   exposed-modules:     Data.Vec.DataFamily.SpineStrict     Data.Vec.DataFamily.SpineStrict.Pigeonhole@@ -88,32 +113,45 @@     Data.Vec.Lazy.Inline     Data.Vec.Pull -  other-modules:    Data.Functor.Confusing+  other-modules:+    Control.Lens.Yocto+    Data.Functor.Confusing++  -- GHC boot libs   build-depends:-      adjunctions    >=4.4     && <4.5-    , base           >=4.6     && <4.14-    , base-compat    >=0.9.3   && <0.12-    , deepseq        >=1.3.0.1 && <1.5-    , distributive   >=0.5.3   && <0.7-    , fin            >=0.1     && <0.2-    , hashable       >=1.2.7.0 && <1.4-    , lens           >=4.16    && <4.19-    , semigroupoids  >=5.2.2   && <5.4-    , transformers   >=0.3.0.0 && <0.6+    , base          >=4.7     && <4.14+    , deepseq       >=1.3.0.1 && <1.5+    , transformers  >=0.3.0.0 && <0.6    if !impl(ghc >=8.0)     build-depends: semigroups >=0.18.4 && <0.20 -  ghc-options:      -Wall -fprint-explicit-kinds-  hs-source-dirs:   src+  if !impl(ghc >=7.10)+    build-depends: transformers-compat ^>=0.6.5++  -- siblings+  build-depends:    fin ^>=0.1.1++  -- other dependencies+  build-depends:+    , hashable    >=1.2.7.0 && <1.4+    , QuickCheck  ^>=2.13.2++  if flag(distributive)+    build-depends: distributive >=0.5.3 && <0.7++    if flag(adjunctions)+      build-depends: adjunctions ^>=4.4++  if flag(semigroupoids)+    build-depends: semigroupoids >=5.2.2 && <5.4+   other-extensions:     CPP     FlexibleContexts     GADTs     TypeOperators -  default-language: Haskell2010- test-suite inspection   type:             exitcode-stdio-1.0   main-is:          Main.hs@@ -126,10 +164,10 @@   hs-source-dirs:   test   default-language: Haskell2010   build-depends:-      base+    , base     , base-compat     , fin-    , inspection-testing  >=0.4.2.2 && <0.5+    , inspection-testing  ^>=0.4.2.2     , tagged     , vec @@ -144,7 +182,7 @@   default-language: Haskell2010   other-modules:    DotProduct   build-depends:-      base+    , base     , criterion  >=1.4.0.0 && <1.6     , fin     , vec