├── .gitignore ├── Control └── Lens │ └── Generic.hs ├── LICENSE ├── README.md ├── Setup.hs └── generic-lens.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virtualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | cabal.config 12 | -------------------------------------------------------------------------------- /Control/Lens/Generic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric, TypeFamilies, TypeOperators, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, FlexibleContexts, RankNTypes #-} 2 | -- | Build van Laarhoven lenses from Generic data structures 3 | -- 4 | -- = Example Usage (in GHCi) 5 | -- 6 | -- > > :set -XDeriveGeneric -XStandaloneDeriving -XFlexibleContexts -XFlexibleInstances 7 | -- > > import Control.Lens.Generic 8 | -- > > import Control.Monad.Identity 9 | -- > > import GHC.Generics 10 | -- > > import Control.Lens 11 | -- > > data Employee f = Employee (f String) (f Int) deriving Generic 12 | -- > > let Employee (LensFor name) (LensFor age) = lenses 13 | -- 14 | -- Now you can do things like 15 | -- 16 | -- > > let x = Employee (return "Frank") (return 2) :: Employee Identity 17 | -- > > runIdentity (x ^. name) 18 | -- > "Frank" 19 | -- > > let y = x & name .~ return "Bob" 20 | -- > > runIdentity (y ^. name) 21 | -- > "Bob" 22 | -- 23 | -- You can also define the lenses at the top of your module as expected 24 | -- 25 | -- > Employee (LensFor name) (LensFor age) = lenses 26 | -- 27 | -- The generated lenses have the correct polymorphic van Laarhoven type: 28 | -- 29 | -- > > :type name 30 | -- > name 31 | -- > :: Functor f => 32 | -- > (t String -> f (t String)) -> Employee t -> f (Employee t) 33 | 34 | module Control.Lens.Generic 35 | ( lenses, LensFor(..) ) where 36 | 37 | import Data.Functor 38 | import Data.Typeable 39 | 40 | import GHC.Generics 41 | 42 | type GenericLensesFor m a = GenericLenses a m (Rep (a m)) 43 | newtype LensFor a c x = LensFor (forall f. Functor f => (a x -> f (a x)) -> c a -> f (c a)) 44 | 45 | type family GenericLenses c m a where 46 | GenericLenses c m (D1 d a) = D1 d (GenericLenses c m a) 47 | GenericLenses c m (C1 d a) = C1 d (GenericLenses c m a) 48 | GenericLenses c m (S1 d a) = S1 d (GenericLenses c m a) 49 | GenericLenses c m (K1 R (m x)) = K1 R (LensFor m c x) 50 | GenericLenses c m (a :*: b) = GenericLenses c m a :*: GenericLenses c m b 51 | GenericLenses c m U1 = U1 52 | 53 | class GLenses c m a where 54 | glenses :: (forall f. Functor f => (a p -> f (a p)) -> c m -> f (c m)) -> GenericLenses c m a p 55 | instance GLenses c m a => GLenses c m (D1 d a) where 56 | glenses (set :: forall f. Functor f => (D1 d a p -> f (D1 d a p)) -> c m -> f (c m)) = M1 $ glenses (\modifier -> set ((M1 <$>) . modifier . unM1)) :: D1 d (GenericLenses c m a) p 57 | instance GLenses c m a => GLenses c m (C1 d a) where 58 | glenses (set :: forall f. Functor f => (C1 d a p -> f (C1 d a p)) -> c m -> f (c m)) = M1 $ glenses (\modifier -> set ((M1 <$>) . modifier . unM1)) :: C1 d (GenericLenses c m a) p 59 | instance GLenses c m a => GLenses c m (S1 d a) where 60 | glenses (set :: forall f. Functor f => (S1 d a p -> f (S1 d a p)) -> c m -> f (c m)) = M1 $ glenses (\modifier -> set ((M1 <$>) . modifier . unM1)) :: S1 d (GenericLenses c m a) p 61 | instance (GLenses c m a, GLenses c m b) => GLenses c m (a :*: b) where 62 | glenses (set :: forall f. Functor f => ((a :*: b) p -> f ((a :*: b) p)) -> c m -> f (c m)) = glenses modifyLeft :*: glenses modifyRight :: GenericLenses c m (a :*: b) p 63 | where modifyLeft :: forall f. Functor f => (a p -> f (a p)) -> c m -> f (c m) 64 | modifyLeft modifier = set (\(a :*: b) -> (:*: b) <$> modifier a) 65 | modifyRight :: forall f. Functor f => (b p -> f (b p)) -> c m -> f (c m) 66 | modifyRight modifier = set (\(a :*: b) -> (a :*:) <$> modifier b) 67 | instance GLenses c m (K1 R (m a)) where 68 | glenses (set :: forall f. Functor f => (K1 R (m a) p -> f (K1 R (m a) p)) -> c m -> f (c m)) = K1 (LensFor modify) 69 | where modify :: forall f. Functor f => (m a -> f (m a)) -> c m -> f (c m) 70 | modify modifier = set ((K1 <$>) . modifier . unK1) 71 | 72 | lenses' :: ( GLenses a m (Rep (a m)) 73 | , Generic (a m), Generic (a (LensFor m a)) 74 | , GenericLensesFor m a ~ Rep (a (LensFor m a)) ) => Proxy a -> Proxy m -> a (LensFor m a) 75 | lenses' (_ :: Proxy a) (_ :: Proxy m) = to (glenses modify) 76 | where modify :: forall f. Functor f => (Rep (a m) () -> f (Rep (a m) ())) -> a m -> f (a m) 77 | modify modifier = (to <$>) . modifier . from 78 | 79 | lenses :: ( GLenses a m (Rep (a m)) 80 | , Generic (a m), Generic (a (LensFor m a)) 81 | , GenericLensesFor m a ~ Rep (a (LensFor m a)) ) => a (LensFor m a) 82 | lenses = inj lenses' 83 | where inj :: (Proxy a -> Proxy m -> a (LensFor m a)) -> a (LensFor m a) 84 | inj f = f Proxy Proxy 85 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Travis Athougies 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # generic-lens 2 | 3 | Automatically make lenses from data structures implementing Generic 4 | 5 | ## Example Usage (in GHCi) 6 | 7 | > :set -XDeriveGeneric -XStandaloneDeriving -XFlexibleContexts -XFlexibleInstances 8 | > import Control.Lens.Generic 9 | > import Control.Monad.Identity 10 | > import GHC.Generics 11 | > import Control.Lens 12 | > data Employee f = Employee (f String) (f Int) deriving Generic 13 | > let Employee (LensFor name) (LensFor age) = lenses 14 | 15 | Now you can do things like: 16 | 17 | > let x = Employee (return "Frank") (return 2) :: Employee Identity 18 | > runIdentity (x ^. name) 19 | "Frank" 20 | > let y = x & name .~ return "Bob" 21 | > runIdentity (y ^. name) 22 | "Bob" 23 | 24 | You can also define the lenses at the top of your module as expected 25 | 26 | Employee (LensFor name) (LensFor age) = lenses 27 | 28 | The generated lenses have the correct polymorphic van Laarhoven type: 29 | 30 | > :type name 31 | name 32 | :: Functor f => 33 | (t String -> f (t String)) -> Employee t -> f (Employee t) 34 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /generic-lens.cabal: -------------------------------------------------------------------------------- 1 | -- Initial generic-lens.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: generic-lens 5 | version: 0.1.0.0 6 | synopsis: Provides a mechanism to automatically derive fclabels lenses from Generic data types 7 | -- description: 8 | homepage: http://travis.athougies.net 9 | license: MIT 10 | license-file: LICENSE 11 | author: Travis Athougies 12 | maintainer: travis@athougies.net 13 | copyright: Copyright (c) 2015 Travis Athougies 14 | category: Data 15 | build-type: Simple 16 | cabal-version: >=1.10 17 | 18 | library 19 | exposed-modules: Control.Lens.Generic 20 | default-extensions: DeriveGeneric 21 | TypeFamilies 22 | TypeOperators 23 | MultiParamTypeClasses 24 | FlexibleInstances 25 | ScopedTypeVariables 26 | FlexibleContexts 27 | build-depends: base >=4.7 && <4.8, ghc-prim 28 | default-language: Haskell2010 --------------------------------------------------------------------------------