microlens-th 0.1.0.0 → 0.1.1.0
raw patch · 3 files changed
+286/−137 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Lens.Micro.TH: lensRulesFor :: [(String, String)] -> LensRules
+ Lens.Micro.TH: makeLensesFor :: [(String, String)] -> Name -> DecsQ
Files
- CHANGELOG.md +11/−0
- microlens-th.cabal +4/−4
- src/Lens/Micro/TH.hs +271/−133
+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# 0.1.1.0++* Added `makeLensesFor` (and `lensRulesFor`).++# 0.1.0.1++* Wrote a bit of documentation.++# 0.1.0.0++Initial release.
microlens-th.cabal view
@@ -1,6 +1,6 @@ name: microlens-th-version: 0.1.0.0-synopsis: Automatic generation of record lenses for 'microlens'.+version: 0.1.1.0+synopsis: Automatic generation of record lenses for microlens description: This package lets you automatically generate lenses for data types; code was extracted from the lens package, and therefore generated lenses are@@ -12,10 +12,10 @@ maintainer: Artyom <yom@artyom.me> homepage: http://github.com/aelve/microlens bug-reports: http://github.com/aelve/microlens/issues--- copyright: category: Data, Lenses build-type: Simple--- extra-source-files: README.md+extra-source-files:+ CHANGELOG.md cabal-version: >=1.10 source-repository head
src/Lens/Micro/TH.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE- CPP- , TemplateHaskell- , RankNTypes- , FlexibleContexts+CPP,+TemplateHaskell,+RankNTypes,+FlexibleContexts #-} #ifndef MIN_VERSION_template_haskell@@ -18,14 +18,16 @@ -- $compatnote Getter, Fold,- -- * Make lenses+ -- * Making lenses makeLenses,+ makeLensesFor, makeLensesWith, makeFields, -- * Default lens rules LensRules, DefName(..), lensRules,+ lensRulesFor, defaultFieldRules, camelCaseFields, -- * Configuring lens rules@@ -68,9 +70,7 @@ type Getter s a = forall r. Getting r s a type Fold s a = forall r. Applicative (Const r) => Getting r s a ------ Lens functions which would've been in Lens.Micro if it wasn't "micro".---+-- Lens functions which would've been in Lens.Micro if it wasn't “micro” elemOf :: Eq a => Getting (Endo [a]) s a -> a -> s -> Bool elemOf l x = elem x . toListOf l@@ -85,16 +85,10 @@ _ForallT f (ForallT a b c) = (\(x, y, z) -> ForallT x y z) <$> f (a, b, c) _ForallT _ other = pure other -_head :: Traversal' [a] a-_head f (a:as) = (:as) <$> f a-_head _ [] = pure []- coerce :: Const r a -> Const r b coerce = Const . getConst ------ Utilities.---+-- Utilities -- | Modify element at some index in a list. setIx :: Int -> a -> [a] -> [a]@@ -119,17 +113,224 @@ fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ] #endif ---+overHead :: (a -> a) -> [a] -> [a]+overHead _ [] = []+overHead f (x:xs) = f x : xs+ -- Control.Lens.TH--- +{- |+Generate lenses for a data type or a newtype.++To use, you have to enable Template Haskell:++@+{-# LANGUAGE TemplateHaskell #-}+@++Then, after declaring the datatype (let's say @Foo@), add @makeLenses ''Foo@+on a separate line:++@+data Foo = Foo {+ _x :: Int,+ _y :: Bool }++makeLenses ''Foo+@++This would generate the following lenses, which can be used to access the+fields of @Foo@:++@+x :: 'Lens'' Foo Int+x f foo = (\\x' -> f {_x = x'}) '<$>' f (_x foo)++y :: 'Lens'' Foo Bool+y f foo = (\\y' -> f {_y = y'}) '<$>' f (_y foo)+@++If you don't want a lens to be generated for some field, don't prefix it with+an @_@.++When the data type has type parameters, it's possible for a lens to do a+polymorphic update – i.e. change the type of the thing along with changing+the type of the field. For instance, with this type:++@+data Foo a = Foo {+ _x :: a,+ _y :: Bool }+@++the following lenses would be generated:++@+x :: 'Lens' (Foo a) (Foo b) a b+y :: 'Lens'' (Foo a) Bool+@++However, when there are several fields using the same type parameter,+type-changing updates are no longer possible:++@+data Foo a = Foo {+ _x :: a,+ _y :: a }+@++generates++@+x :: 'Lens'' (Foo a) a+y :: 'Lens'' (Foo a) a+@++Next thing. When the type has several constructors, some of fields may not be+/always/ present – for those, a 'Traversal' is generated instead. For+instance, in this example @y@ can be present or absent:++@+data FooBar+ = Foo { _x :: Int, _y :: Bool }+ | Bar { _x :: Int }+@++and the following accessors would be generated:++@+x :: 'Lens'' FooBar Int+y :: 'Traversal'' FooBar Bool+@++So, to get @_y@, you'd have to either use ('^?') if you're not sure it's+there, or ('^?!') if you're absolutely sure (and if you're wrong, you'll get+an exception). Setting and updating @_y@ can be done as usual.+-} makeLenses :: Name -> DecsQ makeLenses = makeFieldOptics lensRules --- | Build lenses with a custom configuration.+{- |+Like 'makeLenses', but lets you choose your own names for lenses:++@+data Foo = Foo {foo :: Int, bar :: Bool}++'makeLensesFor' [(\"foo\", \"fooLens\"), (\"bar\", \"_bar\")] ''Foo+@++would create lenses called @fooLens@ and @_bar@. This is useful, for instance,+when you don't want to prefix your fields with underscores and want to prefix+/lenses/ with underscores instead.++If you give the same name to different fields, it will generate a 'Traversal'+instead:++@+data Foo = Foo {slot1, slot2, slot3 :: Int}++'makeLensesFor' [(\"slot1\", \"slots\"),+ (\"slot2\", \"slots\"),+ (\"slot3\", \"slots\")] ''Foo+@+-}+makeLensesFor :: [(String, String)] -> Name -> DecsQ+makeLensesFor fields = makeFieldOptics (lensRulesFor fields)++{- |+Generate lenses with custom parameters.++This function lets you customise generated lenses; to see what exactly can be+changed, look at 'LensRules'. 'makeLenses' is implemented with+'makeLensesWith' – it uses the 'lensRules' configuration (which you can build+upon – see the “Configuring lens rules” section).++Here's an example of generating lenses that would use lazy patterns:++@+data Foo = Foo {_x, _y :: Int}++'makeLensesWith' ('lensRules' '&' 'generateLazyPatterns' '.~' True) ''Foo+@++When there are several modifications to the rules, the code looks nicer when+you use 'flip':++@+'flip' 'makeLensesWith' ''Foo $+ 'lensRules'+ '&' 'generateLazyPatterns' '.~' True+ '&' 'generateSignatures' '.~' False+@+-} makeLensesWith :: LensRules -> Name -> DecsQ makeLensesWith = makeFieldOptics +{- |+Generate overloaded lenses.++This lets you deal with several data types having same fields. For instance,+let's say you have @Foo@ and @Bar@, and both have a field named @x@. To+avoid those fields clashing, you would have to use prefixes:++@+data Foo a = Foo {+ fooX :: Int,+ fooY :: a }++data Bar = Bar {+ barX :: Char }+@++However, if you use 'makeFields' on both @Foo@ and @Bar@ now, it would+generate lenses called @x@ and @y@ – and @x@ would be able to access both+@fooX@ and @barX@! This is done by generating a separate class for each+field, and making relevant types instances of that class:++@+class HasX s a | s -> a where+ x :: 'Lens'' s a++instance HasX (Foo a) Int where+ x :: 'Lens'' (Foo a) Int+ x = ...++instance HasX Bar Char where+ x :: 'Lens'' Bar Char+ x = ...+++class HasY s a | s -> a where+ y :: 'Lens'' s a++instance HasY (Foo a) a where+ y :: 'Lens'' (Foo a) a+ y = ...+@++(There's a minor drawback, tho: you can't perform type-changing updates with+these lenses.)++If you only want to make lenses for some fields, you can prefix them with+underscores – the rest would be untouched. If no fields are prefixed with+underscores, lenses would be created for all fields.++The prefix must be the same as the name of the name of the data type (/not/+the constructor).++If you want to use 'makeFields' on types declared in different modules, you+can do it, but then you would have to export the @Has*@ classes from one of+the modules – 'makeFields' creates a class if it's not in scope yet, so the+class must be in scope or else there would be duplicate classes and you would+get an “Ambiguous occurrence” error.++Finally, 'makeFields' is implemented as @'makeLenses' 'camelCaseFields'@, so+you can build on 'camelCaseFields' if you want to customise behavior of+'makeFields'.+-}+makeFields :: Name -> DecsQ+makeFields = makeFieldOptics camelCaseFields+ -- | Generate "simple" optics even when type-changing optics are possible. -- (e.g. 'Lens'' instead of 'Lens') simpleLenses :: Lens' LensRules Bool@@ -152,19 +353,35 @@ generateUpdateableOptics f r = fmap (\x -> r { _allowUpdates = x}) (f (_allowUpdates r)) --- | Generate optics using lazy pattern matches. This can--- allow fields of an undefined value to be initialized with lenses,--- and is the default behavior.------ The downside of this flag is that it can lead to space-leaks and--- code-size/compile-time increases when generated for large records.------ When using lazy optics the strict optic can be recovered by composing--- with '$!'------ @--- strictOptic = ($!) . lazyOptic--- @+{- |+Generate optics using lazy pattern matches. This can allow fields of an+undefined value to be initialized with lenses:++@+data Foo = Foo {_x :: Int, _y :: Bool}+ deriving Show++'makeLensesWith' ('lensRules' '&' 'generateLazyPatterns' '.~' True) ''Foo+@++@+> 'undefined' '&' x '.~' 8 '&' y '.~' True+Foo {_x = 8, _y = True}+@++(Without 'generateLazyPatterns', the result would be just 'undefined'.)++The downside of this flag is that it can lead to space-leaks and+code-size\/compile-time increases when generated for large records. By+default this flag is turned off, and strict optics are generated.++When you have a lazy optic, you can get a strict optic from it by composing+with ('$!'):++@+strictOptic = ('$!') . lazyOptic+@+-} generateLazyPatterns :: Lens' LensRules Bool generateLazyPatterns f r = fmap (\x -> r { _lazyPatterns = x}) (f (_lazyPatterns r))@@ -206,6 +423,16 @@ _ -> [] } +-- | Used in 'makeLensesFor'.+lensRulesFor ::+ [(String, String)] {- ^ [(Field Name, Lens Name)] -} ->+ LensRules+lensRulesFor fields = lensRules & lensField .~ mkNameLookup fields++mkNameLookup :: [(String,String)] -> Name -> [Name] -> Name -> [DefName]+mkNameLookup kvs _ _ field =+ [ TopName (mkName v) | (k,v) <- kvs, k == nameBase field]+ camelCaseFields :: LensRules camelCaseFields = defaultFieldRules @@ -218,16 +445,13 @@ return (MethodName (mkName cls) (mkName method)) where- expectedPrefix = optUnderscore ++ over _head toLower (nameBase tyName)+ expectedPrefix = optUnderscore ++ overHead toLower (nameBase tyName) optUnderscore = ['_' | any (isPrefixOf "_" . nameBase) fields ] computeMethod (x:xs) | isUpper x = Just (toLower x : xs) computeMethod _ = Nothing -makeFields :: Name -> DecsQ-makeFields = makeFieldOptics camelCaseFields- defaultFieldRules :: LensRules defaultFieldRules = LensRules { _simpleLenses = True@@ -240,9 +464,7 @@ , _fieldToDef = camelCaseNamer } --- -- Language.Haskell.TH.Lens--- -- | Has a 'Name' class HasName t where@@ -319,9 +541,7 @@ substTypeVars :: HasTypeVars t => Map Name Name -> t -> t substTypeVars m = over typeVars $ \n -> fromMaybe n (Map.lookup n m) --- -- FieldTH.hs--- ------------------------------------------------------------------------ -- Field generation entry point@@ -556,84 +776,7 @@ clauses = makeFieldClauses rules opticType cons -{-- --------------------------------------------------------------------------- Classy class generator----------------------------------------------------------------------------makeClassyDriver ::- LensRules ->- Name ->- Name ->- Type {- ^ Outer 's' type -} ->- [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->- DecsQ-makeClassyDriver rules className methodName s defs = sequenceA (cls ++ inst)-- where- cls | _generateClasses rules = [makeClassyClass className methodName s defs]- | otherwise = []-- inst = [makeClassyInstance rules className methodName s defs]---makeClassyClass ::- Name ->- Name ->- Type {- ^ Outer 's' type -} ->- [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->- DecQ-makeClassyClass className methodName s defs = do- let ss = map (stabToS . view (_2 . _2)) defs- (sub,s') <- unifyTypes (s : ss)- c <- newName "c"- let vars = toListOf typeVars s'- fd | null vars = []- | otherwise = [FunDep [c] vars]--- classD (cxt[]) className (map PlainTV (c:vars)) fd- $ sigD methodName (return (''Lens' `conAppsT` [VarT c, s']))- : concat- [ [sigD defName (return ty)- ,valD (varP defName) (normalB body) []- ] ++- inlinePragma defName- | (TopName defName, (_, stab, _)) <- defs- , let body = appsE [varE '(.), varE methodName, varE defName]- , let ty = quantifyType' (Set.fromList (c:vars))- (stabToContext stab)- $ stabToOptic stab `conAppsT`- [VarT c, applyTypeSubst sub (stabToA stab)]- ]---makeClassyInstance ::- LensRules ->- Name ->- Name ->- Type {- ^ Outer 's' type -} ->- [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->- DecQ-makeClassyInstance rules className methodName s defs = do- methodss <- traverse (makeFieldOptic rules') defs-- instanceD (cxt[]) (return instanceHead)- $ valD (varP methodName) (normalB (varE 'id)) []- : map return (concat methodss)-- where- instanceHead = className `conAppsT` (s : map VarT vars)- vars = toListOf typeVars s- rules' = rules { _generateSigs = False- , _generateClasses = False- }---}-------------------------------------------------------------------------- -- Field class generation ------------------------------------------------------------------------ @@ -734,18 +877,6 @@ (normalB body) [] -{----- | Build a clause that constructs an Iso-makeIsoClause :: Name -> ClauseQ-makeIsoClause conName = clause [] (normalB (appsE [varE 'iso, destruct, construct])) []- where- destruct = do x <- newName "x"- lam1E (conP conName [varP x]) (varE x)-- construct = conE conName--}- ------------------------------------------------------------------------ -- Unification logic ------------------------------------------------------------------------@@ -816,6 +947,13 @@ -- Field generation parameters ------------------------------------------------------------------------ +{- |+Rules used to generate lenses. You can't create them from scratch, but you+can customise already existing ones with lenses in the “Configuring lens+rules” section.++For an example, see 'makeLensesWith'.+-} data LensRules = LensRules { _simpleLenses :: Bool , _generateSigs :: Bool@@ -829,10 +967,12 @@ -- type name to class name and top method } --- | Name to give to generated field optics.+{- |+Name to give to a generated lens.+-} data DefName- = TopName Name -- ^ Simple top-level definiton name- | MethodName Name Name -- ^ makeFields-style class name and method name+ = TopName Name -- ^ Simple top-level definiton name+ | MethodName Name Name -- ^ 'makeFields'-style class name and method name deriving (Show, Eq, Ord) ------------------------------------------------------------------------@@ -884,9 +1024,7 @@ #endif --- -- Control.Lens.Internal.TH--- -- | Apply arguments to a type constructor. conAppsT :: Name -> [Type] -> Type