Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module contains a Template Haskell helper to produce a new datatype with modified field names. The initial use case is to allow for easier record construction with Lumi's databases models, which have record fields prefixed with an `_`, and the Stats records, which do not have this underscore. The use of a naming scheme convention allows one to write the conversion function as:
convertData (Entity id Old.Record{..}) RecordStats{..} = Entity (coerce id) New.Record { .. -- Some fields need massaging , _recordClientId = coerce _recordClientId -- Some fields don't need massaging, but need to be explicitly labeled. , _recordStatsFoo = recordStatsFoo }
where each field in RecordStats
must be repeated. This can be accomplished
fairly easily with a vim macro, but it's more fun and less error prone to
write Haskell.
With this module, we can instead write:
wrangle ''RecordStats with { fieldLabelModifier = ('_' :) }
which generates a new type RecordStats'
with the same fields, but modified
to have different field labels. It also creates a conversion function. Now,
we can write (with ViewPatterns
):
convertData (Entity id Old.Record{..}) (wrangleRecordStatsToRecordStats' -> RecordStats'{..}) = Entity (coerce id) New.Record { .. , _recordClientId = coerce _recordClientId }
Now, the only terms that need to be mentioned are the ones that cause a compile-time error due to the types not matching up.
Synopsis
- wrangle :: Name -> WrangleOpts -> DecsQ
- data WrangleOpts
- defWrangleOpts :: WrangleOpts
- fieldLabelModifier :: WrangleOpts -> String -> String
- constructorModifier :: WrangleOpts -> String -> String
- typeNameModifier :: WrangleOpts -> String -> String
- addFields :: WrangleOpts -> [NewField]
- field :: IsType typ => String -> typ -> NewField
- data NewField
- data Proxy (t :: k) :: forall k. k -> Type = Proxy
The Wranglin One
wrangle :: Name -> WrangleOpts -> DecsQ Source #
Create a new datatype with altered field labels, type name, and constructor names along with a conversion function.
The conversion function will have a name matching the pattern:
wrangle + OldTypeName + To + NewTypeName
As an example, consider the following datatype and wrangling:
data Person = Person { name :: String, age :: Int } 'wrangle' ''Person 'with' { 'fieldLabelModifier' = ('_' :) , 'typeNameModifier' = ("Powerful" ++) }
This has the effect of creating this new datatype and function:
data PowerfulPerson = Person' { _name :: String, _age :: Int } wranglePersonToPowerfulPerson :: Person -> PowerfulPerson wranglePersonToPowerfulPerson (Person x0 x1) = Person' x0 x1
Since: 0.1.0.0
The Options For Wranglin
data WrangleOpts Source #
The options for wrangling records. The constructor is hidden so that we can add new features and powers without breaking your code!
defWrangleOpts :: WrangleOpts Source #
This is the default set of WrangleOpts
. It affixes a '
character to
the end of the fields, type, and constructor. If you want different behavior,
then you will want to alter the fields:
wrangle ''Record defWrangleOpts { fieldLabelModifier = ('_' :) }
Since: 0.1.0.0
fieldLabelModifier :: WrangleOpts -> String -> String Source #
This function will be applied to every field label in the provided record.
Since: 0.1.0.0
constructorModifier :: WrangleOpts -> String -> String Source #
This function will be applied to the constructor name.
Since: 0.1.0.0
typeNameModifier :: WrangleOpts -> String -> String Source #
This function will be applied to the type name.
Since: 0.1.0.0
addFields :: WrangleOpts -> [NewField] Source #
Add the following fields to the datatype. These will be inserted
afterwards, and will have *exactly* the name you provide - the
fieldLabelModifier
function *will not* be applied to this value.
field :: IsType typ => String -> typ -> NewField Source #
Add a new field to the given record. For simple types, you can simply pass in the name:
field "userName" ''String
If the type is more complicated than a single name, then you can use the type quasiquoter, like so:
field "userName" [t|Char -> Maybe String|]
since 0.1.1.0
A new field to add to the datatype. Use the function field
to create
values of this type.
Since: 0.1.1.0
data Proxy (t :: k) :: forall k. k -> Type #
Proxy
is a type that holds no data, but has a phantom parameter of
arbitrary type (or even kind). Its use is to provide type information, even
though there is no value available of that type (or it may be too costly to
create one).
Historically,
is a safer alternative to the
Proxy
:: Proxy
a'undefined :: a'
idiom.
>>>
Proxy :: Proxy (Void, Int -> Int)
Proxy
Proxy can even hold types of higher kinds,
>>>
Proxy :: Proxy Either
Proxy
>>>
Proxy :: Proxy Functor
Proxy
>>>
Proxy :: Proxy complicatedStructure
Proxy
Instances
Generic1 (Proxy :: k -> Type) | |
Monad (Proxy :: Type -> Type) | Since: base-4.7.0.0 |
Functor (Proxy :: Type -> Type) | Since: base-4.7.0.0 |
Applicative (Proxy :: Type -> Type) | Since: base-4.7.0.0 |
Foldable (Proxy :: Type -> Type) | Since: base-4.7.0.0 |
Defined in Data.Foldable fold :: Monoid m => Proxy m -> m # foldMap :: Monoid m => (a -> m) -> Proxy a -> m # foldr :: (a -> b -> b) -> b -> Proxy a -> b # foldr' :: (a -> b -> b) -> b -> Proxy a -> b # foldl :: (b -> a -> b) -> b -> Proxy a -> b # foldl' :: (b -> a -> b) -> b -> Proxy a -> b # foldr1 :: (a -> a -> a) -> Proxy a -> a # foldl1 :: (a -> a -> a) -> Proxy a -> a # elem :: Eq a => a -> Proxy a -> Bool # maximum :: Ord a => Proxy a -> a # minimum :: Ord a => Proxy a -> a # | |
Traversable (Proxy :: Type -> Type) | Since: base-4.7.0.0 |
Alternative (Proxy :: Type -> Type) | Since: base-4.9.0.0 |
MonadPlus (Proxy :: Type -> Type) | Since: base-4.9.0.0 |
Bounded (Proxy t) | Since: base-4.7.0.0 |
Enum (Proxy s) | Since: base-4.7.0.0 |
Eq (Proxy s) | Since: base-4.7.0.0 |
Ord (Proxy s) | Since: base-4.7.0.0 |
Read (Proxy t) | Since: base-4.7.0.0 |
Show (Proxy s) | Since: base-4.7.0.0 |
Ix (Proxy s) | Since: base-4.7.0.0 |
Generic (Proxy t) | |
Semigroup (Proxy s) | Since: base-4.9.0.0 |
Monoid (Proxy s) | Since: base-4.7.0.0 |
type Rep1 (Proxy :: k -> Type) | Since: base-4.6.0.0 |
type Rep (Proxy t) | Since: base-4.6.0.0 |