record 0.1.5 → 0.2.0
raw patch · 6 files changed
+128/−89 lines, 6 filesdep ~basenew-component:exe:demo
Dependency ranges changed: base
Files
- CHANGELOG.md +7/−0
- demo/Main.hs +4/−4
- library/Record.hs +1/−1
- library/Record/Lens.hs +8/−6
- library/Record/Types.hs +80/−62
- record.cabal +28/−16
CHANGELOG.md view
@@ -1,3 +1,10 @@+# 0.2.0+* Type-changing updates+* Reimplemented the `Record.Types` API++# 0.1.5+* Fix the range of supported "attoparsec" versions (#6)+ # 0.1.4 * Fix tuples parsing
demo/Main.hs view
@@ -28,19 +28,19 @@ setPersonBirthdayYear = set [lens|birthday.year|] -personBirthdayYearLens :: Lens Person Int+personBirthdayYearLens :: Lens Person Person Int Int personBirthdayYearLens = [lens|birthday.year|] -personBirthdayYearLens' :: Lens Person Int+personBirthdayYearLens' :: Lens Person Person Int Int personBirthdayYearLens' = [lens|birthday|] . [lens|year|] -tupleLens :: Lens (Int, Char, String) String+tupleLens :: Lens (Int, Char, String) (Int, Char, a) String a tupleLens = [lens|3|] -mapThirdElement :: (Char -> Char) -> (Int, String, Char) -> (Int, String, Char)+mapThirdElement :: (Char -> b) -> (Int, String, Char) -> (Int, String, b) mapThirdElement = over [lens|3|]
library/Record.hs view
@@ -106,7 +106,7 @@ renderSingleLens :: T.Text -> Exp renderSingleLens =- AppE (VarE 'Types.lens) .+ AppE (VarE 'Types.fieldLens) . SigE (ConE 'Types.Field) . AppT (ConT ''Types.Field) . LitT . StrTyLit . T.unpack
library/Record/Lens.hs view
@@ -11,28 +11,30 @@ -- |--- A reference from a datastructure @s@ to some part @a@,+-- A reference from a datastructure @s@ to its some part @a@, -- which can be used to manipulate that particular part.-type Lens s a = - forall f. Functor f => (a -> f a) -> (s -> f s)+-- It is possible to change the part to another type @a'@ during updates.+-- In such case the whole datastructure will change the type to @s'@ as well.+type Lens s s' a a' = + forall f. Functor f => (a -> f a') -> (s -> f s') -- | -- Given a lens to a subpart and a datastructure, -- produce the value of the referred subpart.-view :: Lens s a -> s -> a+view :: Lens s s' a a' -> s -> a view l = getConst . l Const -- | -- Given a lens to a subpart, a new value for it and a datastructure, -- produce an updated datastructure.-set :: Lens s a -> a -> s -> s+set :: Lens s s' a a' -> a' -> s -> s' set l a = runIdentity . l (Identity . const a) -- | -- Given a lens to a subpart, and an update function for it, -- produce a function, which updates the datastructure.-over :: Lens s a -> (a -> a) -> s -> s+over :: Lens s s' a a' -> (a -> a') -> s -> s' over l f = runIdentity . l (Identity . f)
library/Record/Types.hs view
@@ -17,30 +17,29 @@ import Language.Haskell.TH +-- *+-------------------------++ -- |--- Defines a way to access some value of a type as a field,+-- Defines a lens to manipulate some value of a type by a type-level name, -- using the string type literal functionality. -- -- Instances are provided for all records and for tuples of arity of up to 24. -- -- Here's how you can use it with tuples: -- --- >trd :: FieldOwner "3" v a => a -> v--- >trd = getField (Field :: Field "3")--- +-- >trd :: FieldLens "3" v v' a' a => a -> v+-- >trd = view . fieldLens (Field :: Field "3") -- The function above will get you the third item of any tuple, which has it.-class FieldOwner (n :: Symbol) v a | n a -> v where- setField :: Field n -> v -> a -> a- getField :: Field n -> a -> v+class FieldLens (n :: Symbol) a a' v v' | n a -> v, n a' -> v', n a v' -> a', n a' v -> a where+ -- |+ -- A polymorphic lens. E.g.:+ -- + -- >ageLens :: FieldLens "age" v v' a' a => Lens a a' v v'+ -- >ageLens = fieldLens (Field :: Field "age") + fieldLens :: Field n -> Lens a a' v v' --- |--- Generate a lens using the 'FieldOwner' instance.--- --- >ageLens :: FieldOwner "age" v a => Lens a v--- >ageLens = lens (Field :: Field "age") -lens :: FieldOwner n v a => Field n -> Lens a v-lens n =- \f a -> fmap (\v -> setField n v a) (f (getField n a)) -- | -- A specialised version of "Data.Proxy.Proxy".@@ -48,6 +47,7 @@ -- since @Proxy@ was only defined in \"base-4.7\". data Field (t :: Symbol) = Field + -- * Record Types ------------------------- @@ -77,7 +77,9 @@ DataD [] typeName varBndrs [NormalC typeName conTypes] derivingNames --- Generate Record FieldOwner instances+-- *+-------------------------+ return $ do arity <- [1 .. 24] nIndex <- [1 .. arity]@@ -89,50 +91,58 @@ mkName $ "n" <> show nIndex selectedVVarName = mkName $ "v" <> show nIndex+ selectedV'VarName =+ mkName $ "v" <> show nIndex <> "'" recordType = foldl (\a i -> AppT (AppT a (VarT (mkName ("n" <> show i)))) (VarT (mkName ("v" <> show i)))) (ConT typeName) [1 .. arity]- setFieldLambda =- LamE [VarP vVarName, ConP typeName (fmap VarP indexedVVarNames)] exp+ record'Type =+ foldl (\a i -> AppT (AppT a (VarT (mkName ("n" <> show i))))+ (VarT (if i == nIndex then selectedV'VarName + else mkName ("v" <> show i))))+ (ConT typeName)+ [1 .. arity]+ fieldLensLambda =+ LamE [VarP fVarName, ConP typeName (fmap VarP indexedVVarNames)] exp where- vVarName =- mkName "v"+ fVarName =+ mkName "f" indexedVVarNames = fmap (\i -> mkName ("v" <> show i)) [1..arity] exp =- foldl (\a i -> AppE a (VarE (mkName (if i == nIndex then "v" else "v" <> show i))))- (ConE typeName)- [1 .. arity]- getFieldLambda =- LamE [ConP typeName vPatterns] (VarE (vVarName))- where- vVarName =- mkName "v"- vPatterns =- flip map [1 .. arity] $ \i ->- if i == nIndex- then VarP vVarName- else WildP+ AppE (AppE (VarE 'fmap) (consLambda))+ (AppE (VarE fVarName) (VarE selectedVVarName))+ where+ consLambda =+ LamE [VarP selectedV'VarName] exp+ where+ exp =+ foldl AppE (ConE typeName) $+ map VarE $+ map (\(i, n) -> if i == nIndex then selectedV'VarName + else mkName ("v" <> show i)) $+ zip [1 .. arity] indexedVVarNames in head $ unsafePerformIO $ runQ $ [d|- instance FieldOwner $(varT selectedNVarName)- $(varT selectedVVarName)+ instance FieldLens $(varT selectedNVarName) $(pure recordType)+ $(pure record'Type)+ $(varT selectedVVarName)+ $(varT selectedV'VarName) where- setField = const $ $(pure setFieldLambda)- getField = const $ $(pure getFieldLambda)+ {-# INLINE fieldLens #-}+ fieldLens = const $(pure fieldLensLambda) |] -instance FieldOwner "1" v1 (Identity v1) where- setField _ v _ = Identity v- getField _ = runIdentity+instance FieldLens "1" (Identity v1) (Identity v1') v1 v1' where+ fieldLens = const $ \f -> fmap Identity . f . runIdentity --- Generate FieldOwner instances for tuples+-- Generate FieldLens instances for tuples return $ do arity <- [2 .. 24] nIndex <- [1 .. arity]@@ -144,38 +154,46 @@ tupleDataName arity selectedVVarName = mkName $ "v" <> show nIndex+ selectedV'VarName =+ mkName $ "v" <> show nIndex <> "'" tupleType = foldl (\a i -> AppT a (VarT (mkName ("v" <> show i)))) (ConT typeName) [1 .. arity]- setFieldLambda =- LamE [VarP vVarName, ConP conName (fmap VarP indexedVVarNames)] exp+ tuple'Type =+ foldl (\a i -> AppT a (VarT (if i == nIndex then selectedV'VarName + else mkName ("v" <> show i))))+ (ConT typeName)+ [1 .. arity]+ fieldLensLambda =+ LamE [VarP fVarName, ConP conName (fmap VarP indexedVVarNames)] exp where- vVarName =- mkName "v"+ fVarName =+ mkName "f" indexedVVarNames = fmap (\i -> mkName ("v" <> show i)) [1..arity] exp =- foldl (\a i -> AppE a (VarE (mkName (if i == nIndex then "v" else "v" <> show i))))- (ConE conName)- [1 .. arity]- getFieldLambda =- LamE [ConP conName vPatterns] (VarE (vVarName))- where- vVarName =- mkName "v"- vPatterns =- flip map [1 .. arity] $ \i ->- if i == nIndex- then VarP vVarName- else WildP+ AppE (AppE (VarE 'fmap) (consLambda))+ (AppE (VarE fVarName) (VarE selectedVVarName))+ where+ consLambda =+ LamE [VarP selectedV'VarName] exp+ where+ exp =+ foldl AppE (ConE conName) $+ map VarE $+ map (\(i, n) -> if i == nIndex then selectedV'VarName + else mkName ("v" <> show i)) $+ zip [1 .. arity] indexedVVarNames in head $ unsafePerformIO $ runQ $ [d|- instance FieldOwner $(pure (LitT (StrTyLit (show nIndex))))- $(varT selectedVVarName)+ instance FieldLens $(pure (LitT (StrTyLit (show nIndex)))) $(pure tupleType)+ $(pure tuple'Type)+ $(varT selectedVVarName)+ $(varT selectedV'VarName) where- setField = const $ $(pure setFieldLambda)- getField = const $ $(pure getFieldLambda)+ {-# INLINE fieldLens #-}+ fieldLens = const $(pure fieldLensLambda) |]
record.cabal view
@@ -1,7 +1,7 @@ name: record version:- 0.1.5+ 0.2.0 synopsis: First class records implemented with quasi-quotation description:@@ -45,6 +45,16 @@ git://github.com/nikita-volkov/record.git +flag doctest+ description: Build Doctests+ default: True+ manual: True++flag demo+ description: Build Demo+ default: False++ library hs-source-dirs: library@@ -84,24 +94,22 @@ -threaded "-with-rtsopts=-N" -funbox-strict-fields- build-depends:- doctest == 0.9.*,- directory == 1.2.*,- filepath == 1.3.*,- base-prelude,- base default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators default-language: Haskell2010+ if !flag(doctest)+ buildable: False+ else+ build-depends:+ doctest == 0.9.*,+ directory == 1.2.*,+ filepath == 1.3.*,+ base-prelude,+ base --- Well, it's not a benchmark actually, --- but in Cabal there's no better way to specify an executable, --- which is not intended for distribution.-benchmark demo- type: - exitcode-stdio-1.0+executable demo hs-source-dirs: demo main-is:@@ -114,6 +122,10 @@ -ddump-splices default-language: Haskell2010- build-depends:- record,- base-prelude+ if !flag(demo)+ buildable: False+ else+ build-depends:+ record,+ base-prelude,+ base