record-wrangler-0.1.1.0: Alter your records with ease

Safe HaskellNone
LanguageHaskell2010

RecordWrangler

Contents

Description

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

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

data NewField Source #

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, Proxy :: Proxy a is a safer alternative to the '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

Constructors

Proxy 
Instances
Generic1 (Proxy :: k -> Type) 
Instance details

Defined in GHC.Generics

Associated Types

type Rep1 Proxy :: k -> Type #

Methods

from1 :: Proxy a -> Rep1 Proxy a #

to1 :: Rep1 Proxy a -> Proxy a #

Monad (Proxy :: Type -> Type)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

(>>=) :: Proxy a -> (a -> Proxy b) -> Proxy b #

(>>) :: Proxy a -> Proxy b -> Proxy b #

return :: a -> Proxy a #

fail :: String -> Proxy a #

Functor (Proxy :: Type -> Type)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

fmap :: (a -> b) -> Proxy a -> Proxy b #

(<$) :: a -> Proxy b -> Proxy a #

Applicative (Proxy :: Type -> Type)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

pure :: a -> Proxy a #

(<*>) :: Proxy (a -> b) -> Proxy a -> Proxy b #

liftA2 :: (a -> b -> c) -> Proxy a -> Proxy b -> Proxy c #

(*>) :: Proxy a -> Proxy b -> Proxy b #

(<*) :: Proxy a -> Proxy b -> Proxy a #

Foldable (Proxy :: Type -> Type)

Since: base-4.7.0.0

Instance details

Defined in Data.Foldable

Methods

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 #

toList :: Proxy a -> [a] #

null :: Proxy a -> Bool #

length :: Proxy a -> Int #

elem :: Eq a => a -> Proxy a -> Bool #

maximum :: Ord a => Proxy a -> a #

minimum :: Ord a => Proxy a -> a #

sum :: Num a => Proxy a -> a #

product :: Num a => Proxy a -> a #

Traversable (Proxy :: Type -> Type)

Since: base-4.7.0.0

Instance details

Defined in Data.Traversable

Methods

traverse :: Applicative f => (a -> f b) -> Proxy a -> f (Proxy b) #

sequenceA :: Applicative f => Proxy (f a) -> f (Proxy a) #

mapM :: Monad m => (a -> m b) -> Proxy a -> m (Proxy b) #

sequence :: Monad m => Proxy (m a) -> m (Proxy a) #

Alternative (Proxy :: Type -> Type)

Since: base-4.9.0.0

Instance details

Defined in Data.Proxy

Methods

empty :: Proxy a #

(<|>) :: Proxy a -> Proxy a -> Proxy a #

some :: Proxy a -> Proxy [a] #

many :: Proxy a -> Proxy [a] #

MonadPlus (Proxy :: Type -> Type)

Since: base-4.9.0.0

Instance details

Defined in Data.Proxy

Methods

mzero :: Proxy a #

mplus :: Proxy a -> Proxy a -> Proxy a #

Bounded (Proxy t)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

minBound :: Proxy t #

maxBound :: Proxy t #

Enum (Proxy s)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

succ :: Proxy s -> Proxy s #

pred :: Proxy s -> Proxy s #

toEnum :: Int -> Proxy s #

fromEnum :: Proxy s -> Int #

enumFrom :: Proxy s -> [Proxy s] #

enumFromThen :: Proxy s -> Proxy s -> [Proxy s] #

enumFromTo :: Proxy s -> Proxy s -> [Proxy s] #

enumFromThenTo :: Proxy s -> Proxy s -> Proxy s -> [Proxy s] #

Eq (Proxy s)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

(==) :: Proxy s -> Proxy s -> Bool #

(/=) :: Proxy s -> Proxy s -> Bool #

Ord (Proxy s)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

compare :: Proxy s -> Proxy s -> Ordering #

(<) :: Proxy s -> Proxy s -> Bool #

(<=) :: Proxy s -> Proxy s -> Bool #

(>) :: Proxy s -> Proxy s -> Bool #

(>=) :: Proxy s -> Proxy s -> Bool #

max :: Proxy s -> Proxy s -> Proxy s #

min :: Proxy s -> Proxy s -> Proxy s #

Read (Proxy t)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Show (Proxy s)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

showsPrec :: Int -> Proxy s -> ShowS #

show :: Proxy s -> String #

showList :: [Proxy s] -> ShowS #

Ix (Proxy s)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

range :: (Proxy s, Proxy s) -> [Proxy s] #

index :: (Proxy s, Proxy s) -> Proxy s -> Int #

unsafeIndex :: (Proxy s, Proxy s) -> Proxy s -> Int

inRange :: (Proxy s, Proxy s) -> Proxy s -> Bool #

rangeSize :: (Proxy s, Proxy s) -> Int #

unsafeRangeSize :: (Proxy s, Proxy s) -> Int

Generic (Proxy t) 
Instance details

Defined in GHC.Generics

Associated Types

type Rep (Proxy t) :: Type -> Type #

Methods

from :: Proxy t -> Rep (Proxy t) x #

to :: Rep (Proxy t) x -> Proxy t #

Semigroup (Proxy s)

Since: base-4.9.0.0

Instance details

Defined in Data.Proxy

Methods

(<>) :: Proxy s -> Proxy s -> Proxy s #

sconcat :: NonEmpty (Proxy s) -> Proxy s #

stimes :: Integral b => b -> Proxy s -> Proxy s #

Monoid (Proxy s)

Since: base-4.7.0.0

Instance details

Defined in Data.Proxy

Methods

mempty :: Proxy s #

mappend :: Proxy s -> Proxy s -> Proxy s #

mconcat :: [Proxy s] -> Proxy s #

type Rep1 (Proxy :: k -> Type)

Since: base-4.6.0.0

Instance details

Defined in GHC.Generics

type Rep1 (Proxy :: k -> Type) = D1 (MetaData "Proxy" "Data.Proxy" "base" False) (C1 (MetaCons "Proxy" PrefixI False) (U1 :: k -> Type))
type Rep (Proxy t)

Since: base-4.6.0.0

Instance details

Defined in GHC.Generics

type Rep (Proxy t) = D1 (MetaData "Proxy" "Data.Proxy" "base" False) (C1 (MetaCons "Proxy" PrefixI False) (U1 :: Type -> Type))