overloaded-records 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+357/−72 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• README.md +46/−9
• overloaded-records.cabal +10/−5
• src/Data/OverloadedRecords/TH.hs +286/−58

@@ -1,6 +1,21 @@ # ChangeLog / ReleaseNotes  +## Version 0.2.0.0++* Function `overloadedRecords` renamed to `overloadedRecord`. There is also new+  `overloadedRecords` function, that behaves as `overloadedRecord`, but for+  multiple types at once. (**breaking change**)+* It is now possible to customize overloadedRecord\* family of functions with+  custom getter and setter implementation. (**new**)+* Types and functions follow, hopefully, better naming conventions. (**change**)+* More low-level template haskell functions for those cases when it is+  necessary to build your own higher-level ones, or when you need much more+  control over the result. (**new**)+* Uploaded to [Hackage][]:+  <http://hackage.haskell.org/package/overloaded-records-0.2.0.0>++ ## Version 0.1.0.0  * First public release.

@@ -10,8 +10,45 @@  ## Description -Implementation of /Overloaded Records/ based on current GHC proposal.+Implementation of *Overloaded Record Fields* based on current GHC proposal. It+is built on top of functionality that is included in GHC 8.0.1, but it works on+older GHC versions as well. Most importantly, this library provides Template+Haskell functions for automatic deriving of instancess for `HasField` and+`SetField` type classes. With these instances overloaded fields can be used+directly as getters and lenses. +```Haskell+import Data.OverloadedRecords.TH (overloadedRecord)++newtype Bar a = Bar {_bar :: a}++overloadedRecord def ''Bar+```++On GHC 8.0.1 it is possible to just write:++```Haskell+{-# LANGUAGE OverloadedLabels #-}++import Control.Lens ((+~))++add :: Int -> Bar Int -> Bar Int+add n = #bar +~ n+```++For older GHC versions there is a family of Template Haskell functions that+will derive overloaded labels in form of standard haskell definitions:++```Haskell+import Control.Lens ((+~))+import Data.OverloadedLabels.TH (label)++label "bar"++add :: Int -> Bar Int -> Bar Int+add n = bar +~ n+```+ This implementation is highly experimental and may change rapidly.  More about the current status of OverloadedRecordFields language extension can@@ -21,18 +58,18 @@ ## Usage Example  ```Haskell-{-# LANGUAGE DataKinds #-}              -- overloadedRecords, labels+{-# LANGUAGE DataKinds #-}              -- overloadedRecord, labels {-# LANGUAGE FlexibleContexts #-}       -- labels-{-# LANGUAGE FlexibleInstances #-}      -- overloadedRecords-{-# LANGUAGE MultiParamTypeClasses #-}  -- overloadedRecords-{-# LANGUAGE TemplateHaskell #-}        -- overloadedRecords, labels-{-# LANGUAGE TypeFamilies #-}           -- overloadedRecords+{-# LANGUAGE FlexibleInstances #-}      -- overloadedRecord+{-# LANGUAGE MultiParamTypeClasses #-}  -- overloadedRecord+{-# LANGUAGE TemplateHaskell #-}        -- overloadedRecord, labels+{-# LANGUAGE TypeFamilies #-}           -- overloadedRecord module FooBar   where  import Data.Default.Class (Default(def)) -import Data.OverloadedRecords.TH (overloadedRecords)+import Data.OverloadedRecords.TH (overloadedRecord) import Data.OverloadedLabels.TH (label, labels)  @@ -41,12 +78,12 @@     , _y :: a     } -overloadedRecords def ''Foo+overloadedRecord def ''Foo labels ["x", "y"]  newtype Bar a = Bar {_bar :: a} -overloadedRecords def ''Bar+overloadedRecord def ''Bar label "bar" ``` 

@@ -1,16 +1,21 @@ name:                   overloaded-records-version:                0.1.0.0+version:                0.2.0.0 synopsis:               Overloaded Records based on current GHC proposal. description:-  Implementation of /Overloaded Records/ based on current GHC proposal.+  Implementation of /Overloaded Record Fields/ based on current GHC proposal.+  It is built on top of functionality that is included in GHC 8.0.1, but it+  works on older GHC versions as well. Most importantly, this library provides+  Template Haskell functions for automatic deriving of instancess for+  @HasField@ and @SetField@ type classes. With these instances overloaded+  fields can be used directly as getters and lenses.   .+  See README for usage examples.+  .   This implementation is highly experimental and may change rapidly.   .   More about the current status of OverloadedRecordFields language extension   can be found on:   <https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields GHC Wiki: OverloadedRecordFields>.-  .-  See README for usage example.  homepage:               https://github.com/trskop/overloaded-records bug-reports:            https://github.com/trskop/overloaded-records/issues@@ -84,4 +89,4 @@ source-repository this   type:                 git   location:             git://github.com/trskop/overloaded-records.git-  tag:                  0.1.0.0+  tag:                  0.2.0.0

@@ -1,12 +1,22 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-} +#ifndef HAVE_OVERLOADED_LABELS+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MagicHash #-}+#endif+ #if 0 #if HAVE_MONAD_FAIL && MIN_VERSION_template_haskell(2,11,0) #define _FAIL_IN_MONAD@@ -26,19 +36,37 @@ -- -- Maintainer:   peter.trsko@gmail.com -- Stability:    experimental--- Portability:  CPP, DeriveDataTypeable, DeriveGeneric, LambdaCase,---               NoImplicitPrelude, RecordWildCards, TemplateHaskell,---               TupleSections+-- Portability:  CPP, DataKinds, DeriveDataTypeable, DeriveGeneric,+--               FlexibleContexts (GHC <8), FlexibleInstances, LambdaCase,+--               MagicHash (GHC <8), MultiParamTypeClasses, NoImplicitPrelude,+--               RecordWildCards, TemplateHaskell, TupleSections, TypeFamilies,+--               TypeSynonymInstances -- -- Derive magic instances for OverloadedRecordFields. module Data.OverloadedRecords.TH     (     -- * Derive OverloadedRecordFields instances-      overloadedRecords+      overloadedRecord+    , overloadedRecords+    , overloadedRecordFor+    , overloadedRecordsFor++    -- ** Customize Derivation Process     , DeriveOverloadedRecordsParams-    , MakeAccessorName-    , makeAccessorName-    , defaultMakeAccessorName+#ifndef HAVE_OVERLOADED_LABELS+    , fieldDerivation+#endif+    , FieldDerivation+    , OverloadedField(..)+    , defaultFieldDerivation+    , defaultMakeFieldName++    -- * Low-level Deriving Mechanism+    , field+    , simpleField+    , fieldGetter+    , fieldSetter+    , simpleFieldSetter     )   where @@ -64,13 +92,16 @@     , replicate     , zip     )-import Data.Maybe (Maybe(Just, Nothing))+import Data.Maybe (Maybe(Just, Nothing), fromMaybe) import Data.Monoid ((<>)) import Data.String (String)-import Data.Traversable (forM)+import Data.Traversable (forM, mapM) import Data.Typeable (Typeable) import Data.Word (Word) import GHC.Generics (Generic)+#ifndef HAVE_OVERLOADED_LABELS+import GHC.Exts (Proxy#, proxy#)+#endif import Text.Show (Show(show))  import Language.Haskell.TH@@ -107,6 +138,9 @@  import Data.Default.Class (Default(def)) +#ifndef HAVE_OVERLOADED_LABELS+import Data.OverloadedLabels (IsLabel(fromLabel))+#endif import Data.OverloadedRecords     ( FieldType     , HasField(getField)@@ -115,54 +149,86 @@     )  --- Parameters for customization of deriving process. Use 'def' to get+#ifndef HAVE_OVERLOADED_LABELS+-- | Overloaded label that can be used for accessing function of type+-- 'FieldDerivation' from 'DeriveOverloadedRecordsParams'.+fieldDerivation :: IsLabel "fieldDerivation" a => a+fieldDerivation = fromLabel (proxy# :: Proxy# "fieldDerivation")+#endif++-- | Parameters for customization of deriving process. Use 'def' to get -- default behaviour. data DeriveOverloadedRecordsParams = DeriveOverloadedRecordsParams-    { _strictAccessors :: Bool+    { _strictFields :: Bool     -- ^ Make setter and getter strict. **Currently unused.**-    , _makeAccessorName :: MakeAccessorName-    -- ^ See 'MakeAccessorName' for description.+    , _fieldDerivation :: FieldDerivation+    -- ^ See 'FieldDerivation' for description.     }   deriving (Generic, Typeable) --- | Pseudo type definition:------ @--- :: TypeName--- -> ConstructorName--- -> FieldIndex--- -> Maybe AccessorName--- -> Maybe OverloadedLabelName--- @+type instance FieldType "fieldDerivation" DeriveOverloadedRecordsParams =+    FieldDerivation++instance+    HasField "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation+  where+    getField _proxy = _fieldDerivation++type instance+    UpdateType "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation =+        DeriveOverloadedRecordsParams++instance+    SetField "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation+  where+    setField _proxy s b = s{_fieldDerivation = b}++-- | Describes what should be the name of overloaded record field, and can also+-- provide custom implementation of getter and setter.+data OverloadedField+    = GetterOnlyField String (Maybe ExpQ)+    -- ^ Derive only getter instances. If second argument is 'Just', then it+    -- contains custom definition of getter function.+    | GetterAndSetterField String (Maybe (ExpQ, ExpQ))+    -- ^ Derive only getter instances. If second argument is 'Just', then it+    -- contains custom definitions of getter and setter functions,+    -- respectively.+  deriving (Generic, Typeable)++-- | Type signature of a function that can customize the derivation of each+-- individual overloaded record field. ----- If field has an accessor then the function will get its name or 'Nothing'+-- If field has an selector then the function will get its name or 'Nothing' -- otherwise.  Function has to return 'Nothing' in case when generating -- overloaded record field instances is not desired.------ @FieldIndex@ is starting from zero.-type MakeAccessorName =-    String -> String -> Word -> Maybe String -> Maybe String---- | Lens for accessing function that specifies what magic instances will be--- defined and what will be the names of overloaded record fields.-makeAccessorName-    :: Functor f-    => (MakeAccessorName -> f MakeAccessorName)-    -> DeriveOverloadedRecordsParams -> f DeriveOverloadedRecordsParams-makeAccessorName f s@DeriveOverloadedRecordsParams{_makeAccessorName = a} =-    (\b -> s{_makeAccessorName = b}) <$> f a+type FieldDerivation+    =  String+    -- ^ Name of the type, of which this field is part of.+    -> String+    -- ^ Name of the constructor, of which this field is part of.+    -> Word+    -- ^ Field position as an argument of the constructor it is part of.+    -- Indexing starts from zero.+    -> Maybe String+    -- ^ Name of the field (record) accessor; 'Nothing' means that there is no+    -- record accessor defined for it.+    -> Maybe OverloadedField+    -- ^ Describes how overloaded record field should be generated for this+    -- specific constructor field. 'Nothing' means that no overloaded record+    -- field should be derived. See also 'OverloadedField' for details.  -- | Suppose we have a weird type definition as this: -- -- @--- data SomeType = SomeConstructor+-- data SomeType a b c = SomeConstructor --     { _fieldX :: a --     , someTypeFieldY :: b --     , someConstructorFieldZ :: c+--     , anythingElse :: (a, b, c) --     } -- @ ----- Then for each of those fields, 'defaultMakeAccessorName' will produce+-- Then for each of those fields, 'defaultMakeFieldName' will produce -- expected OverloadedLabel name: -- -- * @_fieldX --> fieldX@@@ -171,27 +237,29 @@ -- -- * @someConstructorFieldZ --> fieldZ@ ----- Any other field name is kept unchanged.-defaultMakeAccessorName+-- * @anythingElse@ is ignored+defaultMakeFieldName     :: String     -- ^ Name of the type, of which this field is part of.     -> String     -- ^ Name of the constructor, of which this field is part of.     -> Word     -- ^ Field position as an argument of the constructor it is part of.+    -- Indexing starts from zero.     -> Maybe String     -- ^ Name of the field (record) accessor; 'Nothing' means that there is no     -- record accessor defined for it.     -> Maybe String-    -- ^ Overloaded label name for the field; 'Nothing' means that there-    -- shouldn't be a label associated with it.-defaultMakeAccessorName typeName constructorName _fieldPosition = \case+    -- ^ Overloaded record field name to be used for this specific constructor+    -- field; 'Nothing' means that there shouldn't be a label associated with+    -- it.+defaultMakeFieldName typeName constructorName _fieldPosition = \case     Nothing -> Nothing     Just fieldName       | startsWith "_"               -> Just $ dropPrefix "_"        fieldName       | startsWith typePrefix        -> Just $ dropPrefix typePrefix fieldName       | startsWith constructorPrefix -> Just $ dropPrefix typePrefix fieldName-      | otherwise                    -> Just fieldName+      | otherwise                    -> Nothing       where         startsWith :: String -> Bool         startsWith = (`List.isPrefixOf` fieldName)@@ -205,28 +273,33 @@         typePrefix = headToLower typeName         constructorPrefix = headToLower constructorName +-- | Function used by default value of 'DeriveOverloadedRecordsParams'.+defaultFieldDerivation :: FieldDerivation+defaultFieldDerivation =+    (((fmap (`GetterAndSetterField` Nothing) .) .) .) . defaultMakeFieldName+ -- | -- @ -- 'def' = 'DeriveOverloadedRecordsParams'---     { strictAccessors = 'False'---     , 'makeAccessorName' = 'defaultMakeAccessorName'+--     { strictFields = 'False'+--     , 'fieldDerivation' = 'defaultFieldDerivation' --     } -- @ instance Default DeriveOverloadedRecordsParams where     def = DeriveOverloadedRecordsParams-        { _strictAccessors = False-        , _makeAccessorName = defaultMakeAccessorName+        { _strictFields = False+        , _fieldDerivation = defaultFieldDerivation         } --- | Derive magic OverloadedRecordFields instances for specified type name.-overloadedRecords+-- | Derive magic OverloadedRecordFields instances for specified type.+overloadedRecord     :: DeriveOverloadedRecordsParams     -- ^ Parameters for customization of deriving process. Use 'def' to get     -- default behaviour.     -> Name     -- ^ Name of the type for which magic instances should be derived.     -> DecsQ-overloadedRecords params = withReified $ \name -> \case+overloadedRecord params = withReified $ \name -> \case     TyConI dec -> case dec of         -- Not supporting DatatypeContexts, hence the [] required as the first         -- argument to NewtypeD and DataD.@@ -257,6 +330,55 @@     errMessage n x =         "`" <> show n <> "' is neither newtype nor data type: " <> show x +-- | Derive magic OverloadedRecordFields instances for specified types.+overloadedRecords+    :: DeriveOverloadedRecordsParams+    -- ^ Parameters for customization of deriving process. Use 'def' to get+    -- default behaviour.+    -> [Name]+    -- ^ Names of the types for which magic instances should be derived.+    -> DecsQ+overloadedRecords params = fmap concat . mapM (overloadedRecord params)++-- | Derive magic OverloadedRecordFields instances for specified type.+--+-- Similar to 'overloadedRecords', but instead of+-- 'DeriveOverloadedRecordsParams' value it takes function which can modify its+-- default value.+--+-- @+-- data Coordinates2D a+--     { coordinateX :: a+--     , coordinateY :: a+--     }+--+-- 'overloadedRecordsFor' ''Coordinates2D+--     $ \#fieldDerivation .~ \\_ _ _ -> \\case+--         Nothing -> Nothing+--         Just field -> lookup field+--            [ (\"coordinateX\", 'GetterOnlyField' \"x\" Nothing)+--            , (\"coordinateY\", 'GetterOnlyField' \"y\" Nothing)+--            ]+-- @+overloadedRecordFor+    :: Name+    -- ^ Name of the type for which magic instances should be derived.+    -> (DeriveOverloadedRecordsParams -> DeriveOverloadedRecordsParams)+    -- ^ Function that modifies parameters for customization of deriving+    -- process.+    -> DecsQ+overloadedRecordFor typeName f = overloadedRecord (f def) typeName++-- | Derive magic OverloadedRecordFields instances for specified types.+overloadedRecordsFor+    :: [Name]+    -- ^ Names of the types for which magic instances should be derived.+    -> (DeriveOverloadedRecordsParams -> DeriveOverloadedRecordsParams)+    -- ^ Function that modifies parameters for customization of deriving+    -- process.+    -> DecsQ+overloadedRecordsFor typeNames f = overloadedRecords (f def) typeNames+ -- | Derive magic instances for all fields of a specific data constructor of a -- specific type. deriveForConstructor@@ -280,6 +402,13 @@         deriveFor constructorName [arg0, arg1] $ \(strict, argType) f ->             f Nothing strict argType +#if 0+#if MIN_VERSION_template_haskell(2,11,0)+    GadtC _ _ _ ->+    RecGadtC _ _ _ ->+#endif+#endif+     -- Existentials aren't supported.     ForallC _typeVariables _context _constructor -> return []   where@@ -343,16 +472,29 @@ deriveForField params DeriveFieldParams{..} =     case possiblyLabel of         Nothing -> return []-        Just label -> (<>)-            <$> deriveGetter labelType recordType (return fieldType) getterExpr-            <*> deriveSetter labelType recordType (return fieldType) newRecordType-                    newFieldType setterExpr+        Just (GetterOnlyField label customGetterExpr) ->+            deriveGetter' (strTyLitT label)+                $ fromMaybe derivedGetterExpr customGetterExpr+        Just (GetterAndSetterField label customGetterAndSetterExpr) -> (<>)+            <$> deriveGetter' labelType getterExpr+            <*> deriveSetter' labelType setterExpr           where             labelType = strTyLitT label++            (getterExpr, setterExpr) =+                fromMaybe (derivedGetterExpr, derivedSetterExpr)+                    customGetterAndSetterExpr   where-    possiblyLabel = _makeAccessorName params (nameBase typeName)+    possiblyLabel = _fieldDerivation params (nameBase typeName)         (nameBase constructorName) currentIndex (fmap nameBase accessorName) +    deriveGetter' labelType =+        deriveGetter labelType recordType (return fieldType)++    deriveSetter' labelType =+        deriveSetter labelType recordType (return fieldType) newRecordType+            newFieldType+     recordType = foldl appT (conT typeName) $ List.map varT typeVariables      -- TODO: When field type is polymorphic, then we should allow to change it.@@ -366,7 +508,7 @@     inbetween :: (a -> [b]) -> a -> a -> b -> [b]     inbetween f a1 a2 b = f a1 <> (b : f a2) -    getterExpr = case accessorName of+    derivedGetterExpr = case accessorName of         Just name -> varE name         Nothing -> do             a <- newName "a"@@ -376,7 +518,7 @@         nthArg :: Pat -> [Pat]         nthArg = inbetween wildPs currentIndex numVarsOnRight -    setterExpr = case accessorName of+    derivedSetterExpr = case accessorName of         Just name -> do             s <- newName "s"             b <- newName "b"@@ -397,6 +539,59 @@             constrExpression before b after = foldl appE (conE constructorName)                 $ varEs before <> (b : varEs after) +-- | Derive instances for overloaded record field, both getter and setter.+field+    :: String+    -- ^ Overloaded label name.+    -> TypeQ+    -- ^ Record type.+    -> TypeQ+    -- ^ Field type.+    -> TypeQ+    -- ^ Record type after update.+    -> TypeQ+    -- ^ Setter will set field to a value of this type.+    -> ExpQ+    -- ^ Getter function.+    -> ExpQ+    -- ^ Setter function.+    -> DecsQ+field label recType fldType newRecType newFldType getterExpr setterExpr = (<>)+    <$> deriveGetter labelType recType fldType getterExpr+    <*> deriveSetter labelType recType fldType newRecType newFldType setterExpr+  where+    labelType = strTyLitT label++-- | Derive instances for overloaded record field, both getter and setter. Same+-- as 'field', but record type is the same before and after update and so is+-- the field type.+simpleField+    :: String+    -- ^ Overloaded label name.+    -> TypeQ+    -- ^ Record type.+    -> TypeQ+    -- ^ Field type.+    -> ExpQ+    -- ^ Getter function.+    -> ExpQ+    -- ^ Setter function.+    -> DecsQ+simpleField label recType fldType = field label recType fldType recType fldType++-- | Derive instances for overloaded record field getter.+fieldGetter+    :: String+    -- ^ Overloaded label name.+    -> TypeQ+    -- ^ Record type.+    -> TypeQ+    -- ^ Field type+    -> ExpQ+    -- ^ Getter function.+    -> DecsQ+fieldGetter = deriveGetter . strTyLitT+ -- | Derive only getter related instances. deriveGetter :: TypeQ -> TypeQ -> TypeQ -> ExpQ -> DecsQ deriveGetter labelType recordType fieldType getter =@@ -405,6 +600,39 @@         instance HasField $(labelType) $(recordType) $(fieldType) where             getField _proxy = $(getter)     |]++-- | Derive instances for overloaded record field setter. Same as+-- 'fieldSetter', but record type is the same before and after update and so is+-- the field type.+simpleFieldSetter+    :: String+    -- ^ Overloaded label name.+    -> TypeQ+    -- ^ Record type.+    -> TypeQ+    -- ^ Field type.+    -> ExpQ+    -- ^ Setter function.+    -> DecsQ+simpleFieldSetter label recordType fieldType =+    fieldSetter label recordType fieldType recordType fieldType++-- | Derive instances for overloaded record field setter.+fieldSetter+    :: String+    -- ^ Overloaded label name.+    -> TypeQ+    -- ^ Record type.+    -> TypeQ+    -- ^ Field type.+    -> TypeQ+    -- ^ Record type after update.+    -> TypeQ+    -- ^ Setter will set field to a value of this type.+    -> ExpQ+    -- ^ Setter function.+    -> DecsQ+fieldSetter = deriveSetter . strTyLitT  -- | Derive only setter related instances. deriveSetter :: TypeQ -> TypeQ -> TypeQ -> TypeQ -> TypeQ -> ExpQ -> DecsQ