{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} -- | Using records, especially nested records, in Haskell can sometimes be -- a bit of a chore. Fortunately, there are several libraries in hackage -- to make working with records easier. This library is my attempt to -- build on top of these libraries to make working with records even -- more pleasant! -- -- In most imperative languages, records are accessed using the infix -- dot operator. Record fields can be read simply by suffixing a record -- value with '.field' and they can be modified by simply assigning to -- that location. Although this is not the only way to access records -- (indeed, Haskell does not use it), many people (including myself) -- like it. This library attempts to support this style for Haskell -- records in the following manner: -- -- > record.field.subfield becomes record .# field # subfield -- > record.field = value becomes record .# field =: value -- -- Of course, the infix assignment in Haskell is pure and doesn't -- actually mutate anything. Rather, a modified version of the record is -- returned. -- -- Below, a detailed and commented usage example is presented. -- -- > import Data.Record.Field -- > import Data.Record.Label hiding ((=:)) -- -- Currently, @"fields"@ is built on top of @"fclabels"@, so we import -- that package as well. We hide the @(=:)@ operator because that -- operator is also used by @"fields"@ itself. -- -- First, let's define some example data types and derive lenses for -- them using @"fclabels"@. -- -- > data Person = Person -- > { _firstName :: String -- > , _lastName :: String -- > , _age :: Int -- > , _superior :: Maybe Person -- > } deriving Show -- > -- > data Book = Book -- > { _title :: String -- > , _author :: Person -- > , _characters :: [Person] -- > } deriving Show -- > -- > $(mkLabels [''Person, ''Book]) -- -- Now, let's define some example data. -- -- > howard = Person "Howard" "Lovecraft" 46 Nothing -- > charles = Person "Charles" "Ward" 26 Nothing -- > marinus = Person "Marinus" "Willett" 56 Nothing -- > william = Person "William" "Dyer" 53 Nothing -- > frank = Person "Frank" "Pabodie" 49 Nothing -- > herbert = Person "Herbert" "West" 32 Nothing -- > abdul = Person "Abdul" "Alhazred" 71 Nothing -- > -- > mountains = Book "At the Mountains of Madness" undefined [] -- > caseOfCDW = Book "The Case of Charles Dexter Ward" undefined [] -- > reanimator = Book "Herbert West -- The Re-animator" undefined [] -- > necronomicon = Book "Necronomicon" undefined [] -- > -- > persons = [howard, charles, marinus, herbert, william, frank, abdul] -- > books = [mountains, caseOfCDW, reanimator, necronomicon] -- -- Now, to look up a book's title, we can use the @('.#')@ operator, -- which is the basis of all @"fields"@ functionality. @('.#')@ takes a -- value of type @a@ and a @'Field'@ from @a@ to some other type (in -- this case, 'String') and returns the value of that field. Since an -- @"fclabels"@ lens is an instance of @'Field'@, we can just use the -- lens directly. -- -- > necronomicon .# title -- > -- :: String -- -- The @author@ field, however, was left undefined in the above -- definition. We can set it using the @(=:)@ operator -- -- > necronomicon .# author =: abdul -- > -- :: Book -- -- A notable detail is that the above expression parenthesizes as -- @necronomicon .# (author =: abdul)@. The @(=:)@ operator takes a -- @'Field'@ and a value for that @'Field'@ and returns a new @'Field'@ -- that, when read, returns a modified version of the record. -- -- For the sake of the example, I will assume here that the subsequent -- references to @necronomicon@ refer to this modified version (and -- similarly for all other assignment examples below), even though -- nothing is mutated in reality. -- -- The @('=~')@ operator is similar, except that instead of a value, it -- takes a function that modifies the previous value. For example -- -- > howard .# age =~ succ -- > -- :: Person -- -- To access fields in nested records, @'Field'@s can be composed using -- the @(#)@ combinator. -- -- > necronomicon .# author # lastName -- > -- :: String -- -- If we wish to access a field of several records at once, we can use -- the @('<.#>')@ operator, which can be used to access fields of -- a record inside a @'Functor'@. For example -- -- > persons <.#> age -- > -- :: [Int] -- -- This also works for assignment. For example, let's fix the @author@ -- fields of the rest of our books. -- -- > [mountains, caseOfCDW, reanimator ] <.#> author =: howard -- > -- :: [Book] -- -- Because @('<.#>')@ works for any @'Functor'@, we could access values -- of type @Maybe Book@, @a -> Book@ or @IO Book@ similarly. -- -- We frequently wish to access several fields of a record -- simultaneously. @"fields"@ supports this using tuples. A tuple of -- primitive @'Field'@s (currently, \"primitive @'Field'@\" means an -- @"fclabels"@ lens) is itself a @'Field'@, provided that all the -- @'Field'@s in the tuple have the same source type (ie. you can -- combine @Book :-> String@ and @Book :-> Int@ but not @Book :-> -- String@ and @Person :-> String@). For example, we could do -- -- > howard .# (firstName, lastName, age) -- > -- :: (String, String, Int) -- -- @"fields"@ defines instances for tuples of up to 10 elements. In -- addition, the 2-tuple instance is recursively defined so that a tuple -- @(a, b)@ is a @'Field'@ if @a@ is a primitive @'Field'@ and @b@ is -- /any/ valid field. This makes it possible to do -- -- > howard .# (firstName, (lastName, age)) =~ (reverse *** reverse *** negate) -- > -- :: Person -- -- We can also compose a @'Field'@ with a pure function (for example, a -- regular record field accessor function) using the @('#$')@ -- combinator. However, since a function is one-way, the resulting -- @'Field'@ cannot be used to set values, and trying to do so will -- result in an @'error'@. -- -- > howard .# lastName #$ length -- > -- :: Int -- -- If we wish to set fields of several records at once, but so that -- we can also specify the value individually for each record, we can -- use the @('*#')@ and @('=*')@ operators, which can be thought of as -- \"zippy\" assignment. They can be used like this -- -- > [ mountains, caseOfCDW, reanimator ] *# characters =* -- > [ [ william, frank ] -- > , [ charles, marinus ] -- > , [ herbert ] ] -- > -- :: [Book] -- -- For more complex queries, @"fields"@ also provides the @('<#>')@ and -- @('<##>')@ combinators. @('<#>')@ combines a @'Field'@ of type @a :-> -- f b@ with a field of type @b :-> c@, producing a @'Field'@ of type @a -- :-> f c@, where @f@ is any @'Applicative'@ functor. -- -- > mountains .# characters <#> (lastName, age) -- > -- :: [(String, Int)] -- -- @('<##>')@ is similar, except that flattens two monadic @'Field'@s -- together. I.e. the type signature is @a :-> m b -> b :-> m c -> a :-> -- m c@. For example -- -- > frank .# superior <##> superior <##> superior -- > -- :: Maybe Person -- -- Both @('<#>')@ and @('<##>')@ also support assignment normally, -- although the exact semantics vary depending on the @'Applicative'@ or -- @'Monad'@ in question. -- -- We might also like to sort or otherwise manipulate collections of -- records easily. For this, @"fields"@ provides the @'onField'@ -- combinator in the manner of @'Data.Function.on'@. For example, to sort -- a list of books by their authors' last names, we can use -- -- > sortBy (compare `onField` author # lastName) books -- > -- :: [Book] -- -- Using tuples, we can also easily define sub-orderings. For example, -- if we wish to break ties based on the authors' first names and then -- by ages, we can use -- -- > sortBy (compare `onField` author # (lastName, firstName, age)) books -- > -- :: [Book] -- -- Since @'onField'@ accepts any @'Field'@, we can easily specify more -- complex criteria. To sort a list of books by the sum of their -- characters' ages (which is a bit silly), we could use -- -- > sortBy (compare `onField` (characters <#> age) #$ sum) books -- > -- :: [Book] -- -- @"fields"@ also attempts to support convenient pattern matching by -- means of the @'match'@ function and GHC's @ViewPatterns@ extension. -- To pattern match on records, you could do something like this -- -- > case charles of -- > (match lastName -> "Dexter") -> Left False -- > (match lastName -> "Ward") -> Left True -- > (match (age, superior) -> (a, Just s)) -- > | a > 18 -> Right a -- > | otherwise -> Right (s .# age) -- > -- :: Either Bool Int -- -- Finally, a pair of combinators is provided to access record fields of -- collection types. The @(#!)@ combinator has the type @a :-> c b -> -- i -> a :-> Maybe b@, where @c@ is an instance of @'Indexable'@ and -- @i@ is an index type suitable for @c@. For example, you can use an -- @'Integral'@ value to index a @'String'@ and a value of type @k@ to -- index a @Map k v@. The @(#!!)@ combinator is also provided. It -- doesn't have @Maybe@ in the return type, so using a bad index will -- usually result in an @'error'@. -- -- Currently, instances are provided for @[a]@, @'Data.Map'@, -- @'Data.IntMap'@, @'Data.Array.IArray'@, @'Data.Set'@ and -- @'Data.IntSet'@. module Data.Record.Field ( module Data.Record.Field.Basic , module Data.Record.Field.Tuple , module Data.Record.Field.Indexable , module Data.Record.Field.Combinators ) where import Data.Record.Field.Basic import Data.Record.Field.Tuple import Data.Record.Field.Indexable import Data.Record.Field.Combinators