ral-lens (empty) → 0.1
raw patch · 8 files changed
+384/−0 lines, 8 filesdep +basedep +bindep +fin
Dependencies added: base, bin, fin, lens, ral
Files
- ChangeLog.md +5/−0
- LICENSE +17/−0
- ral-lens.cabal +54/−0
- src/Data/RAList/Lens.hs +46/−0
- src/Data/RAList/NonEmpty/Lens.hs +67/−0
- src/Data/RAVec/Lens.hs +58/−0
- src/Data/RAVec/NonEmpty/Lens.hs +78/−0
- src/Data/RAVec/Tree/Lens.hs +59/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Version history for ral++## 0.1++- First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,17 @@+SPDX-License-Identifier: GPL-2.0-or-later++Copyright (c) 2019 Oleg Grenrus <oleg.grenrus@iki.fi>++ This library is free software: you may copy, redistribute and/or modify it+ under the terms of the GNU General Public License as published by the+ Free Software Foundation, either version 2 of the License, or (at your+ option) any later version.++ This library is distributed in the hope that it will be useful, but+ WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU+ General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program (see `LICENSE.GPLv2` and `LICENSE.GPLv3`).+ If not, see <https://www.gnu.org/licenses/gpl-3.0.html>.
+ ral-lens.cabal view
@@ -0,0 +1,54 @@+cabal-version: 2.2+name: ral-lens+version: 0.1+synopsis: Length-indexed random access lists: lens utilities.+category: Data, Dependent Types, Singletons, Lens+description:+ This package provides [lenses](https://hackage.haskell.org/package/lens) and instances+ for data types in [ral](https://hackage.haskell.org/package/ral) package.++homepage: https://github.com/phadej/vec+bug-reports: https://github.com/phadej/vec/issues+license: GPL-2.0-or-later+license-file: LICENSE+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg.Grenrus <oleg.grenrus@iki.fi>+copyright: (c) 2019 Oleg Grenrus+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+ || ==8.8.1++source-repository head+ type: git+ location: https://github.com/phadej/vec.git+ subdir: ral-lens++library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -fprint-explicit-kinds+ exposed-modules:+ Data.RAList.Lens+ Data.RAList.NonEmpty.Lens+ Data.RAVec.Lens+ Data.RAVec.NonEmpty.Lens+ Data.RAVec.Tree.Lens++ build-depends:+ , base >=4.7 && <4.14+ , bin ^>=0.1+ , fin ^>=0.1.1+ , lens >=4.16 && <4.19+ , ral ^>=0.1++-- dump-core+-- if impl(ghc >= 8.0)+-- build-depends: dump-core+-- ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html
+ src/Data/RAList/Lens.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.RAList.Lens (+ -- * Indexing+ ix,+ ) where++import Control.Applicative (Applicative (..), (<$>))+import Prelude (Int)++import qualified Control.Lens as L+import qualified Data.RAList.NonEmpty.Lens as NE++import Data.RAList++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++ix :: forall f a. Applicative f => Int -> L.LensLike' f (RAList a) a+ix _ _ Empty = pure Empty+ix i f (NonEmpty xs) = NonEmpty <$> NE.ix i f xs++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex Int RAList where+ imap = imap++instance L.FoldableWithIndex Int RAList where+ ifoldMap = ifoldMap++instance L.TraversableWithIndex Int RAList where+ itraverse = itraverse++instance L.Each (RAList a) (RAList b) a b++type instance L.Index (RAList a) = Int+type instance L.IxValue (RAList a) = a++instance L.Ixed (RAList a) where+ ix = ix
+ src/Data/RAList/NonEmpty/Lens.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.RAList.NonEmpty.Lens (+ -- * Indexing+ ix,+ ) where++import Control.Applicative (Applicative (pure), (<$>))+import Prelude (Int, Num (..), Ord (..), div, otherwise)++import qualified Control.Lens as L+import qualified Data.RAList.Tree as Tr++import Data.RAList.NonEmpty++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++ix :: forall f a. Applicative f => Int -> L.LensLike' f (NERAList a) a+ix i0 f (NE xs) = NE <$> go 1 i0 xs where+ go :: forall t. TreeIx t => Int -> Int -> NERAList' t a -> f (NERAList' t a)+ go s i (Last t) = Last <$> treeIx s i f t+ go s i (Cons0 r) = Cons0 <$> go (s + s) i r+ go s i (Cons1 t r)+ | i < s = (`Cons1` r) <$> treeIx s i f t+ | otherwise = (t `Cons1`) <$> go (s + s) (i - s) r++class TreeIx t where+ treeIx :: Applicative f => Int -> Int -> (a -> f a) -> t a -> f (t a)++instance TreeIx Tr.Leaf where+ treeIx _ 0 f (Tr.Lf x) = Tr.Lf <$> f x+ treeIx _ _ _ leaf = pure leaf++instance TreeIx t => TreeIx (Tr.Node t) where+ treeIx s i f node@(Tr.Nd x y)+ | i < s2 = (`Tr.Nd` y) <$> treeIx s2 i f x+ | i < s = (x `Tr.Nd`) <$> treeIx s2 (i - s2) f x+ | otherwise = pure node+ where+ s2 = s `div` 2++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex Int NERAList where+ imap = imap++instance L.FoldableWithIndex Int NERAList where+ ifoldMap = ifoldMap++instance L.TraversableWithIndex Int NERAList where+ itraverse = itraverse++instance L.Each (NERAList a) (NERAList b) a b++type instance L.Index (NERAList a) = Int+type instance L.IxValue (NERAList a) = a++instance L.Ixed (NERAList a) where+ ix = ix
+ src/Data/RAVec/Lens.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.RAVec.Lens (+ -- * Indexing+ ix,+ ) where++import Control.Applicative ((<$>))+import Data.Bin.Pos (Pos (..))+import Prelude ()++import qualified Control.Lens as L+import qualified Data.RAVec.NonEmpty.Lens as NE++import Data.RAVec++-- $setup+-- >>> import Control.Lens ((^.), (&), (.~), (^?), (#))+-- >>> import Prelude+-- >>> import qualified Data.Type.Bin as B++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++-- | Index lens.+--+-- >>> let Just ral = fromList "xyz" :: Maybe (RAVec B.Bin3 Char)+-- >>> ral & ix maxBound .~ 'Z'+-- NonEmpty (NE (Cons1 (Leaf 'x') (Last (Node (Leaf 'y') (Leaf 'Z')))))+ix :: Pos b -> L.Lens' (RAVec b a) a+ix (Pos n) f (NonEmpty x) = NonEmpty <$> NE.ix n f x++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex (Pos b) (RAVec b) where+ imap = imap++instance L.FoldableWithIndex (Pos b) (RAVec b) where+ ifoldMap = ifoldMap+ ifoldr = ifoldr++instance L.TraversableWithIndex (Pos b) (RAVec b) where+ itraverse = itraverse++instance L.Each (RAVec n a) (RAVec n b) a b where+ each = traverse++type instance L.Index (RAVec n a) = Pos n+type instance L.IxValue (RAVec n a) = a++instance L.Ixed (RAVec b a) where+ ix = ix
+ src/Data/RAVec/NonEmpty/Lens.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.RAVec.NonEmpty.Lens (+ -- * Indexing+ ix, ix',+ ) where++import Control.Applicative ((<$>))+import Data.BinP.PosP (PosP (..), PosP' (..))+import Prelude ()++import qualified Control.Lens as L+import qualified Data.RAVec.Tree.Lens as Tree++import Data.RAVec.NonEmpty++-- $setup+-- >>> import Control.Lens ((^.), (&), (.~), (^?), (#))+-- >>> import Prelude+-- >>> import qualified Data.Type.Bin as B++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++ix :: PosP b -> L.Lens' (NERAVec b a) a+ix (PosP i) f (NE xs) = NE <$> ix' i f xs++ix' :: PosP' n b -> L.Lens' (NERAVec' n b a) a+ix' (AtEnd i) f (Last t) = Last <$> Tree.ix i f t+ix' (There0 i) f (Cons0 r) = Cons0 <$> ix' i f r+ix' (There1 i) f (Cons1 t r) = (t `Cons1`) <$> ix' i f r+ix' (Here i) f (Cons1 t r) = (`Cons1` r) <$> Tree.ix i f t++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex (PosP b) (NERAVec b) where+ imap = imap++instance L.FunctorWithIndex (PosP' n b) (NERAVec' n b) where+ imap = imap'++instance L.FoldableWithIndex (PosP b) (NERAVec b) where+ ifoldMap = ifoldMap+ ifoldr = ifoldr++instance L.FoldableWithIndex (PosP' n b) (NERAVec' n b) where+ ifoldMap = ifoldMap'+ ifoldr = ifoldr'++instance L.TraversableWithIndex (PosP b) (NERAVec b) where+ itraverse = itraverse++instance L.TraversableWithIndex (PosP' n b) (NERAVec' n b) where+ itraverse = itraverse'++instance L.Each (NERAVec n a) (NERAVec n b) a b where+ each = traverse++instance L.Each (NERAVec' n m a) (NERAVec' n m b) a b where+ each = traverse'++type instance L.Index (NERAVec b a) = PosP b+type instance L.IxValue (NERAVec b a) = a++type instance L.Index (NERAVec' n b a) = PosP' n b+type instance L.IxValue (NERAVec' n b a) = a++instance L.Ixed (NERAVec b a) where+ ix = ix++instance L.Ixed (NERAVec' n b a) where+ ix = ix'
+ src/Data/RAVec/Tree/Lens.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.RAVec.Tree.Lens (+ -- * Indexing+ ix,+ ) where++import Prelude ()+import Control.Applicative ((<$>))+import Data.Wrd (Wrd (..))++import qualified Control.Lens as L++import Data.RAVec.Tree++-- $setup+-- >>> import Control.Lens ((^.), (&), (.~), (^?), (#))+-- >>> import Prelude++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++-- | Index lens.+--+-- >>> let tree = Node (Node (Leaf 'a') (Leaf 'b')) (Node (Leaf 'c') (Leaf 'd'))+-- >>> tree & ix (W1 $ W0 WE) .~ 'z'+-- Node (Node (Leaf 'a') (Leaf 'b')) (Node (Leaf 'z') (Leaf 'd'))+--+ix :: Wrd n -> L.Lens' (Tree n a) a+ix WE f (Leaf x) = Leaf <$> f x+ix (W0 is) f (Node x y) = (`Node` y) <$> ix is f x+ix (W1 is) f (Node x y) = (x `Node`) <$> ix is f y++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance L.FunctorWithIndex (Wrd n) (Tree n) where+ imap = imap++instance L.FoldableWithIndex (Wrd n) (Tree n) where+ ifoldMap = ifoldMap+ ifoldr = ifoldr+ ifoldl = ifoldl++instance L.TraversableWithIndex (Wrd n) (Tree n) where+ itraverse = itraverse++instance L.Each (Tree n a) (Tree n b) a b++type instance L.Index (Tree n a) = Wrd n+type instance L.IxValue (Tree n a) = a++instance L.Ixed (Tree n a) where+ ix = ix