vec-optics (empty) → 0.3
raw patch · 8 files changed
+632/−0 lines, 8 filesdep +basedep +findep +optics-core
Dependencies added: base, fin, optics-core, vec
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- src/Data/Vec/DataFamily/SpineStrict/Optics.hs +169/−0
- src/Data/Vec/Lazy/Inline/Optics.hs +94/−0
- src/Data/Vec/Lazy/Optics.hs +163/−0
- src/Data/Vec/Optics/Instances.hs +7/−0
- src/Data/Vec/Pull/Optics.hs +110/−0
- vec-optics.cabal +54/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for vec++## 0.3++- Split out of `vec`
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017-2019, Oleg Grenrus++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 Oleg Grenrus 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.
+ src/Data/Vec/DataFamily/SpineStrict/Optics.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Vec.DataFamily.SpineStrict.Optics (+ -- * Indexing+ ix,+ _Cons,+ _head,+ _tail,+ -- * Conversions+ _Pull,+ _Vec,+ ) where++import Control.Applicative ((<$>))+import Data.Fin (Fin (..))+import Data.Nat (Nat (..))+import Prelude (Functor (..), ($), (.))++import qualified Data.Fin as F+import qualified Data.Type.Nat as N+import qualified Data.Vec.Pull as P+import qualified Optics.Core as L++import Data.Vec.DataFamily.SpineStrict++-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Prelude (Maybe (..), Char, Bool (..))+-- >>> import Optics.Core (over, view, set, (%), review, preview)++type LensLikeVL f s t a b = (a -> f b) -> s -> f t+type LensLikeVL' f s a = LensLikeVL f s s a a++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++-- | Match on non-empty 'Vec'.+--+-- /Note:/ @lens@ 'L._Cons' is a 'L.Prism'.+-- In fact, @'Vec' n a@ cannot have an instance of 'L.Cons' as types don't match.+--+_Cons :: L.Iso (Vec ('S n) a) (Vec ('S n) b) (a, Vec n a) (b, Vec n b)+_Cons = L.iso (\(x ::: xs) -> (x, xs)) (\(x, xs) -> x ::: xs)++-- | Head lens. /Note:/ @lens@ 'L._head' is a 'L.Traversal''.+--+-- >>> view _head ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'a'+--+-- >>> set _head 'x' ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'x' ::: 'b' ::: 'c' ::: VNil+--+_head :: L.Lens' (Vec ('S n) a) a+_head = L.lensVL headVL+{-# INLINE _head #-}++headVL :: Functor f => LensLikeVL' f (Vec ('S n) a) a+headVL f (x ::: xs) = (::: xs) <$> f x+{-# INLINE headVL #-}++-- | Tail lens.+_tail :: L.Lens' (Vec ('S n) a) (Vec n a)+_tail = L.lensVL tailVL+{-# INLINE _tail #-}++tailVL :: Functor f => LensLikeVL' f (Vec ('S n) a) (Vec n a)+tailVL f (x ::: xs) = (x :::) <$> f xs+{-# INLINE tailVL #-}++-- | An 'I.Iso' from 'toPull' and 'fromPull'.+_Pull :: N.InlineInduction n => L.Iso (Vec n a) (Vec n b) (P.Vec n a) (P.Vec n b)+_Pull = L.iso toPull fromPull++-- | Prism from list.+--+-- >>> preview _Vec "foo" :: Maybe (Vec N.Nat3 Char)+-- Just ('f' ::: 'o' ::: 'o' ::: VNil)+--+-- >>> preview _Vec "foo" :: Maybe (Vec N.Nat2 Char)+-- Nothing+--+-- >>> review _Vec (True ::: False ::: VNil)+-- [True,False]+--+_Vec :: N.InlineInduction n => L.Prism' [a] (Vec n a)+_Vec = L.prism' toList fromList++-- | Index lens.+--+-- >>> view (ix (FS FZ)) ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'b'+--+-- >>> set (ix (FS FZ)) 'x' ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'a' ::: 'x' ::: 'c' ::: VNil+--+ix :: forall n a. N.InlineInduction n => Fin n -> L.Lens' (Vec n a) a+ix i = L.lensVL (ixVL i)+{-# INLINE ix #-}++ixVL :: forall n f a. (N.InlineInduction n, Functor f) => Fin n -> LensLikeVL' f (Vec n a) a+ixVL = 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 -> headVL+ FS j -> tailVL . l j+{-# INLINE ixVL #-}++newtype IxLens f n a = IxLens { getIxLens :: Fin n -> LensLikeVL' f (Vec n a) a }++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance N.InlineInduction n => L.FunctorWithIndex (Fin n) (Vec n) where+ imap = imap++instance N.InlineInduction n => L.FoldableWithIndex (Fin n) (Vec n) where+ ifoldMap = ifoldMap+ ifoldr = ifoldr++instance N.InlineInduction n => L.TraversableWithIndex (Fin n) (Vec n) where+ itraverse = itraverse++instance N.InlineInduction n => L.Each (Fin n) (Vec n a) (Vec n b) a b where++type instance L.Index (Vec n a) = Fin n+type instance L.IxValue (Vec n a) = a++-- | 'Vec' doesn't have 'L.At' instance, as we __cannot__ remove value from 'Vec'.+-- See 'ix' in "Data.Vec.DataFamily.SpineStrict" module for an 'L.Lens' (not 'L.Traversal').+instance N.InlineInduction n => L.Ixed (Vec n a) where+ type IxKind (Vec n a) = L.A_Lens+ ix = ix++instance L.Field1 (Vec ('S n) a) (Vec ('S n) a) a a where+ _1 = _head++instance L.Field2 (Vec ('S ('S n)) a) (Vec ('S ('S n)) a) a a where+ _2 = L.lensVL $ tailVL . headVL++instance L.Field3 (Vec ('S ('S ('S n))) a) (Vec ('S ('S ('S n))) a) a a where+ _3 = L.lensVL $ tailVL . tailVL . headVL++instance L.Field4 (Vec ('S ('S ('S ('S n)))) a) (Vec ('S ('S ('S ('S n)))) a) a a where+ _4 = L.lensVL $ tailVL . tailVL . tailVL . headVL++instance L.Field5 (Vec ('S ('S ('S ('S ('S n))))) a) (Vec ('S ('S ('S ('S ('S n))))) a) a a where+ _5 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . headVL++instance L.Field6 (Vec ('S ('S ('S ('S ('S ('S n)))))) a) (Vec ('S ('S ('S ('S ('S ('S n)))))) a) a a where+ _6 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . headVL++instance L.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 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . headVL++instance L.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 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . headVL++instance L.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 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . headVL
+ src/Data/Vec/Lazy/Inline/Optics.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Vec.Lazy.Inline.Optics (+ -- * Indexing+ ix,+ _Cons,+ _head,+ _tail,+ -- * Conversions+ _Pull,+ _Vec,+ ) where++import Control.Applicative ((<$>))+import Data.Fin (Fin (..))+import Data.Nat (Nat (..))+import Data.Vec.Lazy.Optics (_Cons, _head, _tail)+import Prelude (Functor, ($), (.))++import qualified Data.Fin as F+import qualified Data.Type.Nat as N+import qualified Data.Vec.Pull as P+import qualified Optics.Core as L++import Data.Vec.Lazy.Inline++-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Prelude (Maybe (..), Char, Bool (..))+-- >>> import Optics.Core (over, view, set, (%), review, preview)++type LensLikeVL f s t a b = (a -> f b) -> s -> f t+type LensLikeVL' f s a = LensLikeVL f s s a a++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++-- | Index lens.+--+-- >>> view (ix (FS FZ)) ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'b'+--+-- >>> set (ix (FS FZ)) 'x' ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'a' ::: 'x' ::: 'c' ::: VNil+--+ix :: forall n a. N.InlineInduction n => Fin n -> L.Lens' (Vec n a) a+ix i = L.lensVL (ixVL i)+{-# INLINE ix #-}++ixVL :: forall n f a. (N.InlineInduction n, Functor f) => Fin n -> LensLikeVL' f (Vec n a) a+ixVL = 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 -> headVL+ FS j -> tailVL . l j+{-# INLINE ixVL #-}++newtype IxLens f n a = IxLens { getIxLens :: Fin n -> LensLikeVL' f (Vec n a) a }++headVL :: Functor f => LensLikeVL' f (Vec ('S n) a) a+headVL f (x ::: xs) = (::: xs) <$> f x+{-# INLINE headVL #-}++tailVL :: Functor f => LensLikeVL' f (Vec ('S n) a) (Vec n a)+tailVL f (x ::: xs) = (x :::) <$> f xs+{-# INLINE tailVL #-}++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | An 'L.Iso' from 'toPull' and 'fromPull'.+_Pull :: N.InlineInduction n => L.Iso (Vec n a) (Vec n b) (P.Vec n a) (P.Vec n b)+_Pull = L.iso toPull fromPull++-- | Prism from list.+--+-- >>> preview _Vec "foo" :: Maybe (Vec N.Nat3 Char)+-- Just ('f' ::: 'o' ::: 'o' ::: VNil)+--+-- >>> preview _Vec "foo" :: Maybe (Vec N.Nat2 Char)+-- Nothing+--+-- >>> review _Vec (True ::: False ::: VNil)+-- [True,False]+--+_Vec :: N.InlineInduction n => L.Prism' [a] (Vec n a)+_Vec = L.prism' toList fromList
+ src/Data/Vec/Lazy/Optics.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Vec.Lazy.Optics (+ -- * Indexing+ ix,+ _Cons,+ _head,+ _tail,+ -- * Conversions+ _Pull,+ _Vec,+ ) where++import Control.Applicative ((<$>))+import Data.Fin (Fin (..))+import Data.Nat (Nat (..))+import Prelude ((.), Functor, ($))++import qualified Optics.Core as L+import qualified Data.Type.Nat as N+import qualified Data.Vec.Pull as P++import Data.Vec.Lazy++-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Prelude (Maybe (..), Char, Bool (..))+-- >>> import Optics.Core (over, view, set, (%), review, preview)++type LensLikeVL f s t a b = (a -> f b) -> s -> f t+type LensLikeVL' f s a = LensLikeVL f s s a a++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++-- | Index lens.+--+-- >>> view (ix (FS FZ)) ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'b'+--+-- >>> set (ix (FS FZ)) 'x' ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'a' ::: 'x' ::: 'c' ::: VNil+--+ix :: Fin n -> L.Lens' (Vec n a) a+ix i = L.lensVL (ixVL i)+{-# INLINE ix #-}++ixVL :: Functor f => Fin n -> LensLikeVL' f (Vec n a) a+ixVL FZ f (x ::: xs) = (::: xs) <$> f x+ixVL (FS n) f (x ::: xs) = (x :::) <$> ixVL n f xs++-- | Match on non-empty 'Vec'.+--+-- /Note:/ @lens@ 'L._Cons' is a 'L.Prism'.+-- In fact, @'Vec' n a@ cannot have an instance of 'L.Cons' as types don't match.+--+_Cons :: L.Iso (Vec ('S n) a) (Vec ('S n) b) (a, Vec n a) (b, Vec n b)+_Cons = L.iso (\(x ::: xs) -> (x, xs)) (\(x, xs) -> x ::: xs)++-- | Head lens. /Note:/ @lens@ 'L._head' is a 'L.Traversal''.+--+-- >>> view _head ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'a'+--+-- >>> set _head 'x' ('a' ::: 'b' ::: 'c' ::: VNil)+-- 'x' ::: 'b' ::: 'c' ::: VNil+--+_head :: L.Lens' (Vec ('S n) a) a+_head = L.lensVL headVL+{-# INLINE _head #-}++headVL :: Functor f => LensLikeVL' f (Vec ('S n) a) a+headVL f (x ::: xs) = (::: xs) <$> f x+{-# INLINE headVL #-}++-- | Tail lens.+_tail :: L.Lens' (Vec ('S n) a) (Vec n a)+_tail = L.lensVL tailVL+{-# INLINE _tail #-}++tailVL :: Functor f => LensLikeVL' f (Vec ('S n) a) (Vec n a)+tailVL f (x ::: xs) = (x :::) <$> f xs+{-# INLINE tailVL #-}++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | An 'I.Iso' from 'toPull' and 'fromPull'.+_Pull :: N.SNatI n => L.Iso (Vec n a) (Vec n b) (P.Vec n a) (P.Vec n b)+_Pull = L.iso toPull fromPull++-- | Prism from list.+--+-- >>> preview _Vec "foo" :: Maybe (Vec N.Nat3 Char)+-- Just ('f' ::: 'o' ::: 'o' ::: VNil)+--+-- >>> preview _Vec "foo" :: Maybe (Vec N.Nat2 Char)+-- Nothing+--+-- >>> review _Vec (True ::: False ::: VNil)+-- [True,False]+--+_Vec :: N.SNatI n => L.Prism' [a] (Vec n a)+_Vec = L.prism' toList fromList++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex (Fin n) (Vec n) where+ imap = imap++instance L.FoldableWithIndex (Fin n) (Vec n) where+ ifoldMap = ifoldMap+ ifoldr = ifoldr++instance L.TraversableWithIndex (Fin n) (Vec n) where+ itraverse = itraverse++instance L.Each (Fin n) (Vec n a) (Vec n b) a b where++type instance L.Index (Vec n a) = Fin n+type instance L.IxValue (Vec n a) = a++-- | 'Vec' doesn't have 'L.At' instance, as we __cannot__ remove value from 'Vec'.+-- See 'ix' in "Data.Vec.Lazy" module for an 'L.Optics' (not 'L.Traversal').+instance L.Ixed (Vec n a) where+ type IxKind (Vec n a) = L.A_Lens+ ix = ix++instance L.Field1 (Vec ('S n) a) (Vec ('S n) a) a a where+ _1 = _head++instance L.Field2 (Vec ('S ('S n)) a) (Vec ('S ('S n)) a) a a where+ _2 = L.lensVL $ tailVL . headVL++instance L.Field3 (Vec ('S ('S ('S n))) a) (Vec ('S ('S ('S n))) a) a a where+ _3 = L.lensVL $ tailVL . tailVL . headVL++instance L.Field4 (Vec ('S ('S ('S ('S n)))) a) (Vec ('S ('S ('S ('S n)))) a) a a where+ _4 = L.lensVL $ tailVL . tailVL . tailVL . headVL++instance L.Field5 (Vec ('S ('S ('S ('S ('S n))))) a) (Vec ('S ('S ('S ('S ('S n))))) a) a a where+ _5 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . headVL++instance L.Field6 (Vec ('S ('S ('S ('S ('S ('S n)))))) a) (Vec ('S ('S ('S ('S ('S ('S n)))))) a) a a where+ _6 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . headVL++instance L.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 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . headVL++instance L.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 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . headVL++instance L.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 = L.lensVL $ tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . tailVL . headVL
+ src/Data/Vec/Optics/Instances.hs view
@@ -0,0 +1,7 @@+-- | This module re-exports instances from all the modules defined+-- in @vec-lens@ package.+module Data.Vec.Optics.Instances () where++import Data.Vec.Lazy.Optics ()+import Data.Vec.Pull.Optics ()+import Data.Vec.DataFamily.SpineStrict.Optics ()
+ src/Data/Vec/Pull/Optics.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Vec.Pull.Optics (+ -- * Indexing+ ix,+ _Cons,+ _head,+ _tail,+ -- * Conversions+ _Vec,+ ) where++import Data.Fin (Fin (..))+import Data.Nat (Nat (..))+import Optics.Core ((<&>))++import qualified Data.Type.Nat as N+import qualified Optics.Core as L++import Data.Vec.Pull++-- $setup+-- >>> :set -XScopedTypeVariables+-- >>> import Optics.Core (over, view, set, (%))+-- >>> import qualified Data.Vec.Lazy as L+-- >>> import qualified Data.Vec.Lazy.Optics as L++type LensLikeVL f s t a b = (a -> f b) -> s -> f t+type LensLikeVL' f s a = LensLikeVL f s s a a++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++-- | Index lens.+--+-- 'a' ::: 'x' ::: 'c' ::: VNil+-- >>> view (L._Pull % ix (FS FZ)) ('a' L.::: 'b' L.::: 'c' L.::: L.VNil)+-- 'b'+--+-- >>> set (L._Pull % ix (FS FZ)) 'x' ('a' L.::: 'b' L.::: 'c' L.::: L.VNil)+-- 'a' ::: 'x' ::: 'c' ::: VNil+--+ix :: Fin n -> L.Lens' (Vec n a) a+ix i = L.lensVL (ixVL i)+{-# INLINE ix #-}++ixVL :: Functor f => Fin n -> LensLikeVL' f (Vec n a) a+ixVL i f (Vec v) = f (v i) <&> \a -> Vec $ \j ->+ if i == j+ then a+ else v j+{-# INLINE ixVL #-}++-- | Match on non-empty 'Vec'.+--+-- /Note:/ @lens@ 'L._Cons' is a 'L.Prism'.+-- In fact, @'Vec' n a@ cannot have an instance of 'L.Cons' as types don't match.+--+_Cons :: L.Iso (Vec ('S n) a) (Vec ('S n) b) (a, Vec n a) (b, Vec n b)+_Cons = L.iso (\(Vec v) -> (v FZ, Vec (v . FS))) (\(x, xs) -> cons x xs)++-- | Head lens. /Note:/ @lens@ 'L._head' is a 'L.Traversal''.+--+-- >>> view (L._Pull % _head) ('a' L.::: 'b' L.::: 'c' L.::: L.VNil)+-- 'a'+--+-- >>> set (L._Pull % _head) 'x' ('a' L.::: 'b' L.::: 'c' L.::: L.VNil)+-- 'x' ::: 'b' ::: 'c' ::: VNil+--+_head :: L.Lens' (Vec ('S n) a) a+_head = L.lensVL headVL+{-# INLINE _head #-}++headVL :: Functor f => LensLikeVL' f (Vec ('S n) a) a+headVL f (Vec v) = f (v FZ) <&> \a -> Vec $ \j -> case j of+ FZ -> a+ _ -> v j+{-# INLINE headVL #-}++-- | Tail lens.+_tail :: L.Lens' (Vec ('S n) a) (Vec n a)+_tail = L.lensVL tailVL+{-# INLINE _tail #-}++tailVL :: Functor f => LensLikeVL' f (Vec ('S n) a) (Vec n a)+tailVL f (Vec v) = f (Vec (v . FS)) <&> \xs -> cons (v FZ) xs+{-# INLINE tailVL #-}++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | Prism from list.+_Vec :: N.SNatI n => L.Prism' [a] (Vec n a)+_Vec = L.prism' toList fromList++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex (Fin n) (Vec n) where+ imap = imap++instance N.SNatI n => L.FoldableWithIndex (Fin n) (Vec n) where+ ifoldMap = ifoldMap+ ifoldr = ifoldr
+ vec-optics.cabal view
@@ -0,0 +1,54 @@+cabal-version: 2.2+name: vec-optics+version: 0.3+synopsis: Vec: length-indexed (sized) list: optics support+category: Data, Dependent Types, Optics+description:+ This package provides [optics](https://hackage.haskell.org/package/optics) and instances+ for data types in [vec](https://hackage.haskell.org/package/vec) package.+ .+ "Data.Vec.Optics.Instances" provides all the instances.+ the other modules provide some named optics too.++homepage: https://github.com/phadej/vec+bug-reports: https://github.com/phadej/vec/issues+license: BSD-3-Clause+license-file: LICENSE+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg.Grenrus <oleg.grenrus@iki.fi>+copyright: (c) 2017-2019 Oleg Grenrus+build-type: Simple+extra-source-files: ChangeLog.md+tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1++source-repository head+ type: git+ location: https://github.com/phadej/vec.git+ subdir: vec-optics++library+ default-language: Haskell2010+ ghc-options: -Wall -fprint-explicit-kinds+ hs-source-dirs: src+ exposed-modules:+ Data.Vec.DataFamily.SpineStrict.Optics+ Data.Vec.Lazy.Inline.Optics+ Data.Vec.Lazy.Optics+ Data.Vec.Optics.Instances+ Data.Vec.Pull.Optics++ -- GHC boot libs+ build-depends: base >=4.9 && <4.14++ -- siblings+ build-depends:+ , fin ^>=0.1.1+ , vec ^>=0.3++ -- other dependencies+ build-depends: optics-core ^>=0.2+ other-extensions:+ CPP+ FlexibleContexts+ GADTs+ TypeOperators