packages feed

lens-family-th (empty) → 0.1.0.0

raw patch · 6 files changed

+247/−0 lines, 6 filesdep +basedep +template-haskellsetup-changed

Dependencies added: base, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Dan Burton++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Dan Burton nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Lens/Family/TH.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Derive lenses for "Lens.Family".+-- +-- Example usage:+-- +-- +-- > {-# LANGUAGE TemplateHaskell -#}+-- > +-- > import Lens.Family+-- > import Lens.Family.TH+-- > +-- > data Foo a = Foo { _bar :: Int, _baz :: a }+-- >            deriving (Show, Read, Eq, ord)+-- > $(mkLenses ''Foo)+-- +module Lens.Family.TH (mkLenses, mkLensesBy) where++import Language.Haskell.TH+import Lens.Family.THCore+++-- | Derive lenses for the record selectors in +-- a single-constructor data declaration,+-- or for the record selector in a newtype declaration.+mkLenses :: Name -> Q [Dec]+mkLenses = mkLensesBy defaultNameTransform++-- | Derive lenses with the provided name transformation function.+mkLensesBy :: (String -> String) -> Name -> Q [Dec]+mkLensesBy = deriveLenses deriveLensSig+++-- TODO+deriveLensSig :: Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]+deriveLensSig _ _ _ = return []+
+ Lens/Family/THCore.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TemplateHaskell #-}++-- | The shared functionality behind Lens.Family.TH and Lens.Family2.TH.+module Lens.Family.THCore (+   defaultNameTransform+  , LensTypeInfo+  , ConstructorFieldInfo+  , deriveLenses+  ) where++import Language.Haskell.TH+import Data.Char (toLower)++-- | By default, if the field name begins with an underscore,+-- then the underscore will simply be removed (and the new first character+-- lowercased if necessary). Otherwise, the suffix "Lens" will be added.+defaultNameTransform :: String -> String+defaultNameTransform ('_':c:rest) = toLower c : rest+defaultNameTransform n = n ++ "Lens"++-- | Information about the larger type the lens will operate on.+type LensTypeInfo = (Name, [TyVarBndr])++-- | Information about the smaller type the lens will operate on.+type ConstructorFieldInfo = (Name, Strict, Type)+++-- | The true workhorse of lens derivation. This macro is parameterized+-- by a macro that derives signatures, as well as a function that+-- transforms names.+deriveLenses ::+     (Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec])+     -- ^ the signature deriver+  -> (String -> String)+     -- ^ the name transformer+  -> Name -> Q [Dec]+deriveLenses sigDeriver nameTransform datatype = do+  typeInfo          <- extractLensTypeInfo datatype+  let derive1 = deriveLens sigDeriver nameTransform typeInfo+  constructorFields <- extractConstructorFields datatype+  concat `fmap` mapM derive1 constructorFields+++extractLensTypeInfo :: Name -> Q LensTypeInfo+extractLensTypeInfo datatype = do+  let datatypeStr = nameBase datatype+  i <- reify datatype+  return $ case i of+    TyConI (DataD    _ n ts _ _) -> (n, ts)+    TyConI (NewtypeD _ n ts _ _) -> (n, ts)+    _ -> error $ "Can't derive Lens for: "  ++ datatypeStr+              ++ ", type name required."+++extractConstructorFields :: Name -> Q [ConstructorFieldInfo]+extractConstructorFields datatype = do+  let datatypeStr = nameBase datatype+  i <- reify datatype+  return $ case i of+    TyConI (DataD    _ _ _ [RecC _ fs] _) -> fs+    TyConI (NewtypeD _ _ _ (RecC _ fs) _) -> fs+    TyConI (DataD    _ _ _ [_]         _) ->+      error $ "Can't derive Lens without record selectors: " ++ datatypeStr+    TyConI NewtypeD{} ->+      error $ "Can't derive Lens without record selectors: " ++ datatypeStr+    TyConI TySynD{} ->+      error $ "Can't derive Lens for type synonym: " ++ datatypeStr+    TyConI DataD{} ->+      error $ "Can't derive Lens for tagged union: " ++ datatypeStr+    _ ->+      error $ "Can't derive Lens for: "  ++ datatypeStr+           ++ ", type name required."+++-- Derive a lens for the given record selector+-- using the given name transformation function.+deriveLens :: (Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec])+           -> (String -> String)+           -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]+deriveLens sigDeriver nameTransform ty field = do+  let (fieldName, _fieldStrict, _fieldType) = field+      (_tyName, _tyVars) = ty  -- just to clarify what's here+      lensName = mkName $ nameTransform $ nameBase fieldName+  sig <- sigDeriver lensName ty field+  body <- deriveLensBody lensName fieldName+  return $ sig ++ [body]+++-- Given a record field name,+-- produces a single function declaration:+-- lensName f a = (\x -> a { field = x }) `fmap` f (field a)+deriveLensBody :: Name -> Name -> Q Dec+deriveLensBody lensName fieldName = funD lensName [defLine]+  where+    a = mkName "a"+    f = mkName "f"+    defLine = clause pats (normalB body) []+    pats = [varP f, varP a]+    body = [| (\x -> $(record a fieldName [|x|]))+              `fmap` $(appE (varE f) (appE (varE fieldName) (varE a)))+            |]+    record rec fld val = val >>= \v -> recUpdE (varE rec) [return (fld, v)]+
+ Lens/Family2/TH.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TemplateHaskell, Rank2Types #-}++-- | Derive lenses for "Lens.Family2".+-- +-- Example usage:+-- +-- +-- > {-# LANGUAGE TemplateHaskell, Rank2Types -#}+-- > +-- > import Lens.Family2+-- > import Lens.Family2.TH+-- > +-- > data Foo a = Foo { _bar :: Int, _baz :: a }+-- >            deriving (Show, Read, Eq, ord)+-- > $(mkLenses ''Foo)+-- +module Lens.Family2.TH (mkLenses, mkLensesBy) where++import Language.Haskell.TH+import Lens.Family.THCore+++-- | Derive lenses for the record selectors in +-- a single-constructor data declaration,+-- or for the record selector in a newtype declaration.+mkLenses :: Name -> Q [Dec]+mkLenses = mkLensesBy defaultNameTransform++-- | Derive lenses with the provided name transformation function.+mkLensesBy :: (String -> String) -> Name -> Q [Dec]+mkLensesBy = deriveLenses deriveLensSig+++-- TODO+deriveLensSig :: Name -> LensTypeInfo -> ConstructorFieldInfo -> Q [Dec]+deriveLensSig _ _ _ = return []+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lens-family-th.cabal view
@@ -0,0 +1,38 @@+name:                lens-family-th+version:             0.1.0.0+synopsis:            Template Haskell to generate lenses for+                     lens-family and lens-family-core++description:+  Due to a cabal/hackage defect, curly braces cannot be+  adequately displayed here. Please see+  <http://github.com/DanBurton/lens-family-th#readme>+  for a proper description.+  .+  (See <https://github.com/haskell/cabal/issues/968>+  for the ticket I created regarding the defect.)+++homepage:            http://github.com/DanBurton/lens-family-th+license:             BSD3+license-file:        LICENSE+author:              Dan Burton+maintainer:          danburton.email@gmail.com+copyright:           (c) Dan Burton 2012++category:            Data+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:     Lens.Family.TH, Lens.Family2.TH, Lens.Family.THCore+  build-depends:       base ==4.*, template-haskell ==2.7.*++source-repository head+  type:      git+  location:  git://github.com/DanBurton/lens-family-th.git++source-repository this+  type:      git+  location:  git://github.com/DanBurton/lens-family-th.git+  tag:       lens-family-th-0.1.0.0