diff --git a/.ghci b/.ghci new file mode 100644 --- /dev/null +++ b/.ghci @@ -0,0 +1,1 @@ +:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h diff --git a/.gitignore b/.gitignore new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +dist +docs +wiki +TAGS +tags diff --git a/.vim.custom b/.vim.custom new file mode 100644 --- /dev/null +++ b/.vim.custom @@ -0,0 +1,22 @@ +" Add the following to your .vimrc to automatically load this on startup +" if filereadable(".vim.custom") +" so .vim.custom +" endif + +function StripTrailingWhitespace() + let myline=line(".") + let mycolumn = col(".") + silent %s/ *$// + call cursor(myline, mycolumn) +endfunction + +syntax on +set tags=TAGS;/ +set listchars=tab:‗‗,trail:‗ +set list + +map :exec ":!hasktags -x -c --ignore src" +" autocmd! bufwritepost *.hs :exec ":!hasktags -x -c --ignore src" + +au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() +au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown new file mode 100644 --- /dev/null +++ b/CHANGELOG.markdown @@ -0,0 +1,12 @@ +2.2 +--- +* Added `<&=`, `<&~`, `<|=`, and `<|~` +* Moved `<>~`, `<<>~`, `<>=`, and `<<>=` to `Data.Monoid.Lens` +* Template Haskell now uses eager binding to avoid adding dependencies. + +2.1 +--- +* Renamed `adjust` to `over` +* Added `au`, `auf` and `under` +* Added `Data.Monoid.Lens` +* Increased lower dependency bound on `mtl` for cleaner installation. diff --git a/config b/config new file mode 100644 --- /dev/null +++ b/config @@ -0,0 +1,16 @@ +-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix +-- +-- This is particularly useful for travis-ci to get it to stop complaining +-- about a broken build when everything is still correct on our end. +-- +-- This uses Luite Stegman's mirror of hackage provided by his 'hdiff' site instead +-- +-- To enable this, uncomment the before_script in .travis.yml + +remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive +remote-repo-cache: ~/.cabal/packages +world-file: ~/.cabal/world +build-summary: ~/.cabal/logs/build.log +remote-build-reporting: anonymous +install-dirs user +install-dirs global diff --git a/lens.cabal b/lens.cabal --- a/lens.cabal +++ b/lens.cabal @@ -1,6 +1,6 @@ name: lens category: Data, Lenses -version: 2.1 +version: 2.2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -33,7 +33,7 @@ . The core of this hierarchy looks like: . - <> + <> . You can compose any two elements of the hierarchy above using (.) from the Prelude, and you can use any element of the hierarchy as any type it links to above it. @@ -81,10 +81,15 @@ tested-with: GHC == 7.4.1 extra-source-files: .travis.yml + .ghci + .gitignore + .vim.custom + config examples/LICENSE examples/lens-examples.cabal examples/pong.hs README.markdown + CHANGELOG.markdown source-repository head type: git diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs --- a/src/Control/Lens/Setter.hs +++ b/src/Control/Lens/Setter.hs @@ -35,10 +35,10 @@ , mapOf , set , (.~), (%~) - , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (&&~), (<>~), (<.~) + , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (&&~), (<.~) -- * State Combinators , (.=), (%=) - , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (&&=), (<>=), (<.=) + , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (&&=), (<.=) , (<~) -- * Setter Internals , Setting @@ -53,10 +53,9 @@ import Control.Monad.State.Class as State import Data.Functor.Compose import Data.Functor.Identity -import Data.Monoid -infixr 4 .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, ||~, %~, <>~, <.~ -infix 4 .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, ||=, %=, <>=, <.= +infixr 4 .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, ||~, %~, <.~ +infix 4 .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, ||=, %=, <.= infixr 2 <~ ------------------------------------------------------------------------------ @@ -247,7 +246,7 @@ -- >>> set mapped () [1,2,3,4] -- [(),(),(),()] -- --- Note: Attempting to 'set' a 'Fold' or 'Getter' will fail at compile time with an +-- Note: Attempting to 'set' a 'Fold' or 'Getter' will fail at compile time with an -- relatively nice error message. -- -- @ @@ -462,22 +461,6 @@ l &&~ n = over l (&& n) {-# INLINE (&&~) #-} --- | Modify the target of a monoidally valued by 'mappend'ing another value. --- --- >>> :m + Control.Lens Data.Pair.Lens --- >>> both <>~ "!!!" $ ("hello","world") --- ("hello!!!","world!!!") --- --- @ --- (<>~) :: 'Monoid' c => 'Setter' a b c c -> c -> a -> b --- (<>~) :: 'Monoid' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b --- (<>~) :: 'Monoid' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b --- (<>~) :: 'Monoid' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b --- @ -(<>~) :: Monoid c => Setting a b c c -> c -> a -> b -l <>~ n = over l (`mappend` n) -{-# INLINE (<>~) #-} - ------------------------------------------------------------------------------ -- Using Setters with State ------------------------------------------------------------------------------ @@ -627,18 +610,6 @@ (||=) :: MonadState a m => SimpleSetting a Bool -> Bool -> m () l ||= b = State.modify (l ||~ b) {-# INLINE (||=) #-} - --- | Modify the target(s) of a 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' by 'mappend'ing a value. --- --- @ --- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m () --- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m () --- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m () --- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () --- @ -(<>=) :: (MonadState a m, Monoid b) => SimpleSetting a b -> b -> m () -l <>= b = State.modify (l <>~ b) -{-# INLINE (<>=) #-} -- | Run a monadic action, and set all of the targets of a 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to its result. -- diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs --- a/src/Control/Lens/TH.hs +++ b/src/Control/Lens/TH.hs @@ -142,21 +142,21 @@ makeIsoTo :: Name -> ExpQ makeIsoTo conName = lamE [varP (mkName "f"), conP conName [varP (mkName "a")]] $ - appsE [ varE (mkName "fmap") + appsE [ return (VarE 'fmap) , conE conName , varE (mkName "f") `appE` varE (mkName "a") ] makeIsoFrom :: Name -> ExpQ makeIsoFrom conName = lamE [varP (mkName "f"), varP (mkName "a")] $ - appsE [ varE (mkName "fmap") + appsE [ return (VarE 'fmap) , lamE [conP conName [varP (mkName "b")]] $ varE (mkName "b") , varE (mkName "f") `appE` (conE conName `appE` varE (mkName "a")) ] makeIsoBody :: Name -> Name -> (Name -> ExpQ) -> (Name -> ExpQ) -> DecQ makeIsoBody lensName conName f g = funD lensName [clause [] (normalB body) []] where - body = appsE [ varE (mkName "isomorphic") + body = appsE [ return (VarE 'isomorphic) , f conName , g conName ] @@ -261,7 +261,7 @@ errorClause :: Name -> Name -> Name -> ClauseQ errorClause lensName fieldName conName - = clause [] (normalB (varE (mkName "error") `appE` litE (stringL err))) [] + = clause [] (normalB (return (VarE 'error) `appE` litE (stringL err))) [] where err = show lensName ++ ": no matching field " ++ show fieldName ++ " in constructor " @@ -280,7 +280,7 @@ f <- newName "f" x <- newName "y" clause [varP f, conP conName $ map varP names] (normalB - (appsE [ varE (mkName "fmap") + (appsE [ return (VarE 'fmap) , lamE [varP x] $ appsE $ conE conName : map varE (element i .~ x $ names) , varE f `appE` varE (names^.element i) ])) [] diff --git a/src/Control/Lens/Type.hs b/src/Control/Lens/Type.hs --- a/src/Control/Lens/Type.hs +++ b/src/Control/Lens/Type.hs @@ -83,12 +83,12 @@ -- * Setting Functionally with Passthrough , (<%~), (<+~), (<-~), (<*~), (~) + , (<||~), (<&&~) -- * Setting State with Passthrough , (<%=), (<+=), (<-=), (<*=), (=) + , (<||=), (<&&=) -- * Cloning Lenses , clone @@ -111,12 +111,11 @@ import Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Reader import Data.Functor.Identity -import Data.Monoid infixr 4 %%~ infix 4 %%= -infixr 4 <+~, <*~, <-~, ~ -infix 4 <+=, <*=, <-=, = +infixr 4 <+~, <*~, <-~, ~') is more flexible. -(<<>~) :: Monoid m => LensLike ((,)m) a b m m -> m -> a -> (m, b) -l <<>~ m = l <%~ (`mappend` m) -{-# INLINE (<<>~) #-} - ------------------------------------------------------------------------------- -- Setting and Remembering State ------------------------------------------------------------------------------- @@ -608,14 +599,6 @@ (<&&=) :: MonadState a m => SimpleLensLike ((,)Bool) a Bool -> Bool -> m Bool l <&&= b = l <%= (&& b) {-# INLINE (<&&=) #-} - --- | 'mappend' a monoidal value onto the end of the target of a 'Lens' into --- your monad's state and return the result. --- --- When you do not need the result of the operation, ('<>=') is more flexible. -(<<>=) :: (MonadState a m, Monoid r) => SimpleLensLike ((,)r) a r -> r -> m r -l <<>= r = l <%= (`mappend` r) -{-# INLINE (<<>=) #-} -- | Provides access to 1st field of a tuple. class Field1 a b c d | a -> c, b -> d, a d -> b, b c -> a where diff --git a/src/Data/Bits/Lens.hs b/src/Data/Bits/Lens.hs --- a/src/Data/Bits/Lens.hs +++ b/src/Data/Bits/Lens.hs @@ -11,8 +11,8 @@ -- ---------------------------------------------------------------------------- module Data.Bits.Lens - ( (|~), (&~) - , (|=), (&=) + ( (|~), (&~), (<|~), (<&~) + , (|=), (&=), (<|=), (<&=) , bitAt , traverseBits ) where @@ -22,34 +22,114 @@ import Data.Bits import Data.Functor -infixr 4 |~, &~ -infix 4 |=, &= +infixr 4 |~, &~, <|~, <&~ +infix 4 |=, &=, <|=, <&= --- | Bitwise '.|.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter' +-- | Bitwise '.|.' the target(s) of a 'Lens' or 'Setter' -- -- >>> _2 |~ 6 $ ("hello",3) -- ("hello",7) +-- +-- @ +-- (|~) :: 'Bits' c => 'Setter' a b c c -> c -> a -> b +-- (|~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> b +-- (|~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> b +-- (|~) :: ('Monoid c', 'Bits' c) => 'Traversal' a b c c -> c -> a -> b +-- @ (|~):: Bits c => Setting a b c c -> c -> a -> b l |~ n = over l (.|. n) {-# INLINE (|~) #-} --- | Bitwise '.&.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter' +-- | Bitwise '.&.' the target(s) of a 'Lens' or 'Setter' -- -- >>> _2 &~ 7 $ ("hello",254) -- ("hello",6) +-- +-- @ +-- (&~) :: 'Bits' c => 'Setter' a b c c -> c -> a -> b +-- (&~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> b +-- (&~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> b +-- (&~) :: ('Monoid c', 'Bits' c) => 'Traversal' a b c c -> c -> a -> b +-- @ (&~) :: Bits c => Setting a b c c -> c -> a -> b l &~ n = over l (.&. n) {-# INLINE (&~) #-} -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.&.' with another value. +-- +-- @ +-- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Setter' a b -> b -> m () +-- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Iso' a b -> b -> m () +-- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m () +-- (&=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Traversal' a b -> b -> m () +-- @ (&=):: (MonadState a m, Bits b) => Simple Setting a b -> b -> m () l &= b = modify (l &~ b) {-# INLINE (&=) #-} -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value. +-- +-- @ +-- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Setter' a b -> b -> m () +-- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Iso' a b -> b -> m () +-- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m () +-- (|=):: ('MonadState' a m, 'Bits' b) => 'Simple' 'Traversal' a b -> b -> m () +-- @ (|=) :: (MonadState a m, Bits b) => Simple Setting a b -> b -> m () l |= b = modify (l |~ b) {-# INLINE (|=) #-} + +-- | Bitwise '.|.' the target(s) of a 'Lens' (or 'Traversal'), returning the result +-- (or a monoidal summary of all of the results). +-- +-- >>> _2 <|~ 6 $ ("hello",3) +-- (7,("hello",7)) +-- +-- @ +-- (\<|~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> (c, b) +-- (\<|~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> (c, b) +-- (\<|~) :: ('Bits' c, 'Monoid c) => 'Traversal' a b c c -> c -> a -> (c, b) +-- @ +(<|~):: Bits c => LensLike ((,) c) a b c c -> c -> a -> (c, b) +l <|~ n = l <%~ (.|. n) +{-# INLINE (<|~) #-} + +-- | Bitwise '.&.' the target(s) of a 'Lens' or 'Traversal', returning the result +-- (or a monoidal summary of all of the results). +-- +-- >>> _2 <&~ 7 $ ("hello",254) +-- (6,("hello",6)) +-- +-- @ +-- (\<&~) :: 'Bits' c => 'Iso' a b c c -> c -> a -> (c, b) +-- (\<&~) :: 'Bits' c => 'Lens' a b c c -> c -> a -> (c, b) +-- (\<&~) :: ('Bits' c, 'Monoid c) => 'Traversal' a b c c -> c -> a -> (c, b) +-- @ +(<&~) :: Bits c => LensLike ((,) c) a b c c -> c -> a -> (c, b) +l <&~ n = l <%~ (.&. n) +{-# INLINE (<&~) #-} + +-- | Modify the target(s) of a 'Simple' 'Lens' (or 'Traversal') by computing its bitwise '.&.' with another value, +-- returning the result (or a monoidal summary of all of the results traversed) +-- +-- @ +-- (\<&=) :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m b +-- (\<&=) :: ('MonadState' a m, 'Bits' b, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m b +-- @ +(<&=):: (MonadState a m, Bits b) => SimpleLensLike ((,)b) a b -> b -> m b +l <&= b = l <%= (.&. b) +{-# INLINE (<&=) #-} + +-- | Modify the target(s) of a 'Simple' 'Lens', (or 'Traversal') by computing its bitwise '.|.' with another value, +-- returning the result (or a monoidal summary of all of the results traversed) +-- +-- @ +-- (\<|=) :: ('MonadState' a m, 'Bits' b) => 'Simple' 'Lens' a b -> b -> m b +-- (\<|=) :: ('MonadState' a m, 'Bits' b, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m b +-- @ +(<|=) :: (MonadState a m, Bits b) => SimpleLensLike ((,)b) a b -> b -> m b +l <|= b = l <%= (.|. b) +{-# INLINE (<|=) #-} -- | This lens can be used to access the value of the nth bit in a number. -- diff --git a/src/Data/Monoid/Lens.hs b/src/Data/Monoid/Lens.hs --- a/src/Data/Monoid/Lens.hs +++ b/src/Data/Monoid/Lens.hs @@ -9,11 +9,62 @@ -- ---------------------------------------------------------------------------- module Data.Monoid.Lens - ( _dual, _endo, _all, _any, _sum, _product, _first, _last + ( (<>~), (<<>~) + , (<>=), (<<>=) + , _dual, _endo, _all, _any, _sum, _product, _first, _last ) where import Data.Monoid import Control.Lens +import Control.Monad.State.Class as State + +infixr 4 <>~, <<>~ +infix 4 <>=, <<>= + +-- | Modify the target of a monoidally valued by 'mappend'ing another value. +-- +-- >>> :m + Control.Lens Data.Pair.Lens +-- >>> both <>~ "!!!" $ ("hello","world") +-- ("hello!!!","world!!!") +-- +-- @ +-- (<>~) :: 'Monoid' c => 'Setter' a b c c -> c -> a -> b +-- (<>~) :: 'Monoid' c => 'Iso' a b c c -> c -> a -> b +-- (<>~) :: 'Monoid' c => 'Lens' a b c c -> c -> a -> b +-- (<>~) :: 'Monoid' c => 'Traversal' a b c c -> c -> a -> b +-- @ +(<>~) :: Monoid c => Setting a b c c -> c -> a -> b +l <>~ n = over l (`mappend` n) +{-# INLINE (<>~) #-} + +-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by 'mappend'ing a value. +-- +-- @ +-- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Setter' a b -> b -> m () +-- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Iso' a b -> b -> m () +-- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Lens' a b -> b -> m () +-- (<>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m () +-- @ +(<>=) :: (MonadState a m, Monoid b) => SimpleSetting a b -> b -> m () +l <>= b = State.modify (l <>~ b) +{-# INLINE (<>=) #-} + + +-- | 'mappend' a monoidal value onto the end of the target of a 'Lens' and +-- return the result +-- +-- When you do not need the result of the operation, ('<>~') is more flexible. +(<<>~) :: Monoid m => LensLike ((,)m) a b m m -> m -> a -> (m, b) +l <<>~ m = l <%~ (`mappend` m) +{-# INLINE (<<>~) #-} + +-- | 'mappend' a monoidal value onto the end of the target of a 'Lens' into +-- your monad's state and return the result. +-- +-- When you do not need the result of the operation, ('<>=') is more flexible. +(<<>=) :: (MonadState a m, Monoid r) => SimpleLensLike ((,)r) a r -> r -> m r +l <<>= r = l <%= (`mappend` r) +{-# INLINE (<<>=) #-} -- | Isomorphism for 'Dual' _dual :: Iso a b (Dual a) (Dual b)