diff --git a/pointless-lenses.cabal b/pointless-lenses.cabal --- a/pointless-lenses.cabal +++ b/pointless-lenses.cabal @@ -1,5 +1,5 @@ Name: pointless-lenses -Version: 0.0.8 +Version: 0.0.9 License: BSD3 License-file: LICENSE Author: Alcino Cunha , Hugo Pacheco @@ -19,11 +19,11 @@ extra-source-files: README, Test.hs Build-type: Simple -Cabal-Version: >= 1.2.3 +Cabal-Version: >= 1.4 Library Hs-Source-Dirs: src - Build-Depends: base >= 3 && < 5, derive >= 2.5.4, pointless-haskell >= 0.0.7, containers >= 0.4.0.0, QuickCheck >= 2.4.0.1, haskell98, process + Build-Depends: base >= 3 && < 5, derive >= 2.5.4, pointless-haskell >= 0.0.7, containers >= 0.4.0.0, QuickCheck >= 2.4.0.1, process exposed-modules: Generics.Pointless.Lenses.Combinators, Generics.Pointless.Lenses.RecursionPatterns, @@ -42,4 +42,4 @@ Data.Relation, Data.Shape - extensions: MultiParamTypeClasses, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, TypeOperators, TypeFamilies, GADTs, Rank2Types + extensions: MultiParamTypeClasses, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, TypeOperators, TypeFamilies, GADTs, Rank2Types, ViewPatterns diff --git a/src/Generics/Pointless/Lenses/Examples/Examples.hs b/src/Generics/Pointless/Lenses/Examples/Examples.hs --- a/src/Generics/Pointless/Lenses/Examples/Examples.hs +++ b/src/Generics/Pointless/Lenses/Examples/Examples.hs @@ -26,8 +26,7 @@ import Generics.Pointless.Lenses.Combinators import Generics.Pointless.Lenses.PartialCombinators import Generics.Pointless.Lenses.RecursionPatterns -import Debug.Trace -import Prelude hiding (replicate) +import Prelude {-# RULES "mapId" @@ -88,10 +87,17 @@ -- * Lenses over lists and natural numbers --- | List length lens. +-- | List length (efficient version using primitive integers) length_lns :: a -> Lens [a] Nat -length_lns a = nat_lns _L (\_ -> id_lns -|-< snd_lns (a!)) +length_lns a = Lens get' put' create' + where get' xs = Nat $ Prelude.length xs + put' (Nat n,xs) = Prelude.take n (xs ++ repeat a) + create' (Nat n) = Prelude.replicate n a +-- | List length lens using a catamorphism on naturals. +length_lns' :: a -> Lens [a] Nat +length_lns' a = nat_lns _L (\_ -> id_lns -|-< snd_lns (a!)) + -- | List zipping lens. zip_lns :: Lens ([a],[b]) [(a,b)] zip_lns = ana_lns _L (((!<) c -|-< distp_lns) .< coassocl_lns .< dists_lns .< (out_lns ><< out_lns)) @@ -137,9 +143,17 @@ h = (snd_lns _L -|-< (id_lns ><< swap_lns) .< assocr_lns) .< distl_lns .< (out_lns ><< id_lns) t = ann :: Ann (K [a] :+!: (K a :*!: I)) --- | Addition of two natural numbers. +-- | Addition of two natural (efficient version using integers) plus_lns :: Lens (Nat,Nat) Nat -plus_lns = hylo_lns (ann::Ann (From Nat)) f g +plus_lns = Lens get' put' create' + where get' (Nat x,Nat y) = Nat (x + y) + put' (Nat z,(Nat x,Nat y)) | z > x = (Nat z,Nat (z-x)) + | otherwise = (Nat z,nzero) + create' (Nat z) = (Nat z,nzero) + +-- | Addition of two natural numbers using an hylomorphism on naturals. +plus_lns' :: Lens (Nat,Nat) Nat +plus_lns' = hylo_lns (ann::Ann (From Nat)) f g where f = inn_lns .< (out_lns \/$< id_lns) g = (snd_lns bang -|-< id_lns) .< distl_lns .< (out_lns ><< id_lns) diff --git a/src/Generics/Pointless/Lenses/Examples/Imdb.hs b/src/Generics/Pointless/Lenses/Examples/Imdb.hs --- a/src/Generics/Pointless/Lenses/Examples/Imdb.hs +++ b/src/Generics/Pointless/Lenses/Examples/Imdb.hs @@ -81,7 +81,7 @@ boxoffices = sumn_lns .< filter_right_pf .< map_pf (outMaybe_lns .< snd_lns dcountry) reviews :: (Lens [Review] Nat) -reviews = length_pf dcomment .< concat_pf .< map_pf (snd_lns duser) +reviews = length_lns dcomment .< concat_pf .< map_pf (snd_lns duser) tv :: Lens TV [Episode] tv = concat_pf .< map_pf (snd_lns dyear) @@ -117,7 +117,7 @@ boxoffices_opt = cataList_lns aux where aux = ((\/<) (inl . bang) l r) .< coassocl_lns .< f - l = innNat_lns .< (((!<) inl) -|-< id_lns) .< coassocl_lns .< (id_lns -|-< (outNat_lns .< plus_pf)) + l = innNat_lns .< (((!<) inl) -|-< id_lns) .< coassocl_lns .< (id_lns -|-< (outNat_lns .< plus_lns)) r = snd_lns bang f = (id_lns -|-< (coswap_lns .< distl_lns .< ((outMaybe_lns .< (snd_lns dcountry)) ><< id_lns))) diff --git a/src/Generics/Pointless/Lenses/Examples/MapExamples.hs b/src/Generics/Pointless/Lenses/Examples/MapExamples.hs --- a/src/Generics/Pointless/Lenses/Examples/MapExamples.hs +++ b/src/Generics/Pointless/Lenses/Examples/MapExamples.hs @@ -22,6 +22,7 @@ import Generics.Pointless.Lenses import Generics.Pointless.Lenses.Combinators import Generics.Pointless.Lenses.Examples.Recs +import Generics.Pointless.Lenses.Examples.Examples -- ** map ! . filter_left . map (map f -|- map g) @@ -74,19 +75,19 @@ women_hand :: Lens [Person] Nat women_hand = Lens get' put' create' where - get' [] = Zero + get' [] = nzero get' ((nm,M):ps) = get' ps - get' ((nm,F):ps) = Succ (get' ps) - create' Zero = [] - create' (Succ n) = ("woman",F) : create' n - put' (Zero,[]) = [] + get' ((nm,F):ps) = nsucc (get' ps) + create' (Nat 0) = [] + create' (Nat (pred -> n)) = ("woman",F) : create' (Nat n) + put' (Nat 0,[]) = [] put' (n,(nm,M):ps) = (nm,M) : put' (n,ps) - put' (Zero,(nm,F):ps) = put' (Zero,ps) - put' (Succ n,[]) = ("woman",F) : create' n - put' (Succ n,(nm,F):ps) = (nm,F) : put' (n,ps) + put' (Nat 0,(nm,F):ps) = put' (Nat 0,ps) + put' (Nat (pred -> n),[]) = ("woman",F) : create' (Nat n) + put' (Nat (pred -> n),(nm,F):ps) = (nm,F) : put' (Nat n,ps) women_pf :: Lens [Person] Nat -women_pf = length_pf _L .< filter_right_pf .< map_pf (outGender_lns .< snd_lns (pnt "woman" . bang)) +women_pf = length_lns _L .< filter_right_pf .< map_pf (outGender_lns .< snd_lns (pnt "woman" . bang)) women_opt :: Lens [Person] Nat women_opt = cataList_lns ((innNat_lns .< (id_lns -|-< snd_lns bang) .\/< snd_lns bang) .< f) diff --git a/src/Generics/Pointless/Lenses/Examples/Recs.hs b/src/Generics/Pointless/Lenses/Examples/Recs.hs --- a/src/Generics/Pointless/Lenses/Examples/Recs.hs +++ b/src/Generics/Pointless/Lenses/Examples/Recs.hs @@ -22,14 +22,15 @@ import Generics.Pointless.Functors import Generics.Pointless.Lenses import Generics.Pointless.Lenses.Combinators +import Generics.Pointless.Lenses.Examples.Examples innNat :: Either One Nat -> Nat -innNat (Left _) = Zero -innNat (Right n) = Succ n +innNat (Left _) = nzero +innNat (Right n) = nsucc n outNat :: Nat -> Either One Nat -outNat Zero = Left _L -outNat (Succ n) = Right n +outNat (Nat 0) = Left _L +outNat (Nat n) = Right (Nat $ pred n) innNat_lns :: Lens (Either One Nat) Nat innNat_lns = Lens innNat (outNat . fst) outNat @@ -179,16 +180,8 @@ -- ** Examples -length_pf :: a -> Lens [a] Nat -length_pf v = cataList_lns (innNat_lns .< (id_lns -|-< snd_lns (v!))) - -plus_pf :: Lens (Nat,Nat) Nat -plus_pf = hyloNeNat_lns f g - where f = innNat_lns .< (outNat_lns \/$< id_lns) - g = (snd_lns bang -|-< id_lns) .< distl_lns .< (outNat_lns ><< id_lns) - sum_pf :: Lens [Nat] Nat -sum_pf = cataList_lns (innNat_lns .< (id_lns #\/< (outNat_lns .< plus_pf))) +sum_pf = cataList_lns (innNat_lns .< (id_lns #\/< (outNat_lns .< plus_lns))) cat_pf :: Lens ([a],[a]) [a] cat_pf = hyloNeList_lns g h