fields (empty) → 0.1.0
raw patch · 9 files changed
+1189/−0 lines, 9 filesdep +arraydep +basedep +containerssetup-changed
Dependencies added: array, base, containers, fclabels, monads-fd, transformers
Files
- Data/Record/Field.hs +242/−0
- Data/Record/Field/Basic.hs +72/−0
- Data/Record/Field/Combinators.hs +133/−0
- Data/Record/Field/Indexable.hs +122/−0
- Data/Record/Field/Tuple.hs +302/−0
- Example.hs +125/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- fields.cabal +161/−0
+ Data/Record/Field.hs view
@@ -0,0 +1,242 @@+{-# 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+
+ Data/Record/Field/Basic.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}++-- | The @'Field'@ class and basic operations.++module Data.Record.Field.Basic+ ( -- * Record fields.+ Field(..)+ -- * Basic field operators.+ , (.#)+ , (=:)+ , (=~)+ -- * Pattern matching.+ , match+ ) where++import Data.Record.Label hiding ((=:))++-- | Instances of this class can be combined with the functions and+-- operators in this package.+class Field a where+ -- | The source type of the field. I.e. the record type.+ type Src a :: *+ -- | The destination type of the field. I.e. the type of the field+ -- in question.+ type Dst a :: *+ -- | Return an @"fclabels"@ lens corresponding to this field.+ field :: a -> (Src a :-> Dst a)++instance Field (a :-> b) where+ type Src (a :-> b) = a+ type Dst (a :-> b) = b+ field = id++infixl 7 .#+-- | Return the value of the field in the given record.+(.#) :: (Field a) => Src a -> a -> Dst a+r .# f = getL (field f) r++-- | Infix assignment lookalike.+--+-- > r.#f =: v+--+-- returns a modified version of @r@ so that the field corresponding to+-- @f@ are set to @v@.+infixl 8 =:+(=:) :: (Field a) => a -> Dst a -> Src a :-> Src a+a =: v = lens (setL (field a) v) const++-- | Infix modification lookalike.+--+-- > r.#f =~ g+--+-- returns a modified version of @r@ so that the fields corresponding to+-- @f@ are modified with the function @g@.+infixl 8 =~+(=~) :: (Field a) => a -> (Dst a -> Dst a) -> Src a :-> Src a+a =~ f = lens (modL (field a) f) const++-- | Convenience function for use with the @ViewPatterns@ extension.+--+-- > case r of+-- > (match int -> 5) -> "It's 5!"+-- > (match (int,str#$length) -> (i,l))+-- > | i == l -> "They're equal!"+-- > | otherwise -> "Not equal."+-- > _ -> "Something else."+--+match :: (Field a) => a -> Src a -> Dst a+match f = (.# f)+
+ Data/Record/Field/Combinators.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++-- | Field combinators.+module Data.Record.Field.Combinators+ ( -- * Basic combinators.+ idL+ , ( # )+ , (#$ )+ -- * Combinators for @'Functor'@s, @'Applicative'@s and+ -- @'Monad'@s.+ , (<.#>)+ , (<#>)+ , (<##>)+ -- * Zippy assignment.+ , (*#)+ , (=*)+ -- * Assignment and modification in a State monad.+ , (<=:)+ , (<=~)+ -- * Utility combinator for comparisons etc.+ , onField+ ) where++import Data.Record.Field.Basic+import Data.Record.Label hiding ((=:))+import qualified Control.Category as C+import Control.Applicative+import Control.Monad+import "monads-fd" Control.Monad.State.Class++cantSet :: String -> a+cantSet n = error $ n ++ ": cannot set values."++-- | Identity lens.+idL :: a :-> a+idL = C.id++-- | Field composition with arguments in OO-like order.+infixl 8 #+( # ) :: (Field a, Field b, Dst a ~ Src b) =>+ a -> b -> Src a :-> Dst b+a # b = (field b) C.. (field a)++-- | Compose fields with ordinary functions. As functions are one-way,+-- the resulting field cannot be used to set values.+infixl 8 #$+(#$) :: (Field a) => a -> (Dst a -> b) -> Src a :-> b+ab #$ f = lens getter (cantSet "(#$)")+ where getter a = f . getL (field ab) $ a++-- | Infix @'fmap'@ for fields.+--+-- Examples:+--+-- +-- > persons <.#> firstName+--+-- > do (v1, v2) <- takeMVar mv <.#> (field1, field2)+-- > putStrLn . unlines $ [ "v1: " ++ show v1, "v2: " ++ show v2 ]+--+infixl 7 <.#>+(<.#>) :: (Functor f, Field a) => f (Src a) -> a -> f (Dst a)+f <.#> a = fmap (.# a) f++-- | @'Applicative'@ functor composition for fields.+--+-- > book .# characters <#> lastName+--+infixr 9 <#>+(<#>) :: (Applicative f, Field a, Field b, Dst a ~ f (Src b)) =>+ a -> b -> Src a :-> f (Dst b)+ab <#> bc = lens getter setter+ where getter = (fmap $ getL (field bc)) . getL (field ab)+ -- the flip is so effects get performed for b first.+ setter fc = modL (field ab) $+ \fb -> flip (setL (field bc)) <$> fb <*> fc++-- | Flattening monadic composition for fields.+--+-- > person .# superior <##> superior <##> superior <##> superior+--+infixr 9 <##>+(<##>) :: (Monad m, Field a, Field b,+ Dst a ~ m (Src b), Dst b ~ m c) =>+ a -> b -> Src a :-> m c+ab <##> bc = lens getter setter+ where getter = getL (field ab) >=> getL (field bc)+ setter mc = modL (field ab) $ + \mb -> do b <- mb+ return $ setL (field bc) mc b++-- | Zippy field reference to be used with @('=*')@.+--+-- > [ rec1, rec2 ] *# field =* [ value1, value2 ]+--+infixl 7 *#+(*#) :: (Field b) => [Src b] -> [b] -> [Dst b]+rs *# as = zipWith (.#) rs as ++-- | Zippy infix assignment to be used with @('*#')@.+infixl 8 =*+(=*) :: (Field a) => a -> [Dst a] -> [Src a :-> Src a]+a =* vs = [ a =: v | v <- vs ]++-- | Infix assignment for the State monad.+--+-- > (field1, field2) <=: (value1, value2)+--+infix 3 <=:+(<=:) :: (MonadState (Src a) m, Field a) =>+ a -> Dst a -> m ()+a <=: v = modify (.# a =: v)++-- | Infix modification for the State monad.+--+-- > (field1, field2) <=~ (f, g)+--+infix 3 <=~+(<=~) :: (MonadState (Src a) m, Field a) =>+ a -> (Dst a -> Dst a) -> m ()+a <=~ f = modify (.# a =~ f)++-- | Utility combinator in the manner of @'Data.Function.on'@.+--+-- > sortBy (compare `onField` (lastName,firstName)) persons+--+infixl 0 `onField`+onField :: (Field a) => (Dst a -> Dst a -> t) -> a -> Src a -> Src a -> t+onField f a r1 r2 = f (r1.#a) (r2.#a)+
+ Data/Record/Field/Indexable.hs view
@@ -0,0 +1,122 @@+-- vim: encoding=latin1+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}++-- | Composition operators for collection fields.+module Data.Record.Field.Indexable+ ( Indexable(..)+ , (#!)+ , (#!!)+ ) where++import Data.Record.Field.Basic+import Data.Record.Label+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import qualified Data.Array.IArray as IArray+import qualified Data.Set as Set+import qualified Data.IntSet as IntSet++-- | Class of collection types that can be indexed into.+--+-- TODO: This should probably be a single-parameter type class with two+-- associated types instead.+class Indexable a i where+ type Element a :: *+ indexGet :: i -> a -> Maybe (Element a)+ indexSet :: i -> Maybe (Element a) -> a -> a+ unsafeIndexGet :: i -> a -> Element a+ unsafeIndexGet i a = maybe notFound id $ indexGet i a+ where notFound = error "unsafeIndexGet: element not found"++-- | Compose a field with an @'Indexable'@ collection safely. +--+-- > r .# coll #! idx+--+-- returns @Nothing@ if @idx@ was not found from the collection, and+-- @Just v@ if @v@ was found.+--+-- > r .# coll #! idx =: Just v+--+-- sets the value at @idx@ in the collection to be @v@. If the value+-- wasn't in the collection, it's inserted. The exact semantics of+-- insertion depend on the actual collection in question.+--+-- > r .# coll #! idx =: Nothing+--+-- removes the value at @idx@ from the collection, if possible.+--+infixl 8 #!+(#!) :: (Field a, Indexable (Dst a) i) =>+ a -> i -> Src a :-> Maybe (Element (Dst a))+f #! i = lens getter setter+ where getter a = indexGet i (getL (field f) a)+ setter v = modL (field f) (indexSet i v)++-- | As @(#!)@, but reading a nonexistent value will likely result in a+-- bottom value being returned. Also, the resulting field cannot be used+-- to remove values.+infixl 8 #!!+(#!!) :: (Field a, Indexable (Dst a) i) =>+ a -> i -> Src a :-> Element (Dst a)+f #!! i = lens getter setter+ where getter a = unsafeIndexGet i (getL (field f) a)+ setter v = setL (field $ f #! i) (Just v)++instance (Integral i) => Indexable [a] i where+ type Element [a] = a+ unsafeIndexGet i as = as !! fromIntegral i+ indexGet i as = case drop (fromIntegral i) as of+ [] -> Nothing+ (a:_) -> Just a+ indexSet i Nothing as = before ++ drop 1 after+ where (before,after) = splitAt (fromIntegral i) as+ indexSet i (Just v) as = before ++ (v : drop 1 after)+ where (before,after) = splitAt (fromIntegral i) as++instance (Ord k1, k1 ~ k2) => Indexable (Map.Map k1 a) k2 where+ type Element (Map.Map k1 a) = a+ unsafeIndexGet = flip (Map.!)+ indexGet = Map.lookup+ indexSet k v = Map.alter (const v) k++instance Indexable (IntMap.IntMap a) Int where+ type Element (IntMap.IntMap a) = a+ unsafeIndexGet = flip (IntMap.!)+ indexGet = IntMap.lookup+ indexSet k v = IntMap.alter (const v) k++instance (IArray.IArray a e, IArray.Ix i1, i1 ~ i2) =>+ Indexable (a i1 e) i2 where+ type Element (a i1 e) = e+ unsafeIndexGet = flip (IArray.!)+ indexGet i a+ | i >= min && i <= max = Just $ a IArray.! i+ | otherwise = Nothing+ where (min, max) = IArray.bounds a++ indexSet i Nothing a = a -- array elements can't be removed+ indexSet i (Just v) a+ | i >= min && i <= max = a IArray.// [(i,v)]+ | otherwise = a+ where (min, max) = IArray.bounds a++instance (Ord a1, a1 ~ a2) => Indexable (Set.Set a1) a2 where+ type Element (Set.Set a1) = a1+ -- unsafeIndexGet doesn't really make sense here.+ indexGet a set | a `Set.member` set = Just a+ | otherwise = Nothing+ indexSet a Nothing set = Set.delete a set+ indexSet a (Just _) set = Set.insert a set++instance Indexable IntSet.IntSet Int where+ type Element IntSet.IntSet = Int+ -- unsafeIndexGet doesn't really make sense here.+ indexGet a set | a `IntSet.member` set = Just a+ | otherwise = Nothing+ indexSet a Nothing set = IntSet.delete a set+ indexSet a (Just _) set = IntSet.insert a set+
+ Data/Record/Field/Tuple.hs view
@@ -0,0 +1,302 @@+-- vim: encoding=latin1+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}++-- | Instances for tuples of fields up to a 10-tuple. This allows+-- accessing several fields simultaneously.+--+-- > r.#(field1, field2, field3#field4) =: (value1, value2, value3)+--+-- In addition, the pair instance is recursively defined, which allows+-- stuff like+--+-- > import Control.Arrow ((***))+-- > r.#(field1, (field2, field3)) =~ (f *** g *** h)+--+module Data.Record.Field.Tuple+ ( + ) where++import Data.Record.Field.Basic+import Data.Record.Field.Combinators+import Data.Record.Label hiding ((=:))+{- Commented out to remove the dependency to pretty.+import Text.PrettyPrint hiding (int)+import qualified Text.PrettyPrint as PP+-}+++instance (Field f, r ~ Src f) => Field (r :-> a, f) where+ type Src (r :-> a, f) = r+ type Dst (r :-> a, f) = (a, Dst f)+ field (l1, f) = lens get set+ where get r = (getL l1 r, getL l2 r)+ set (a, b) = setL l2 b . setL l1 a+ l2 = field f++{- Commented out to remove the dependency to pretty.+mkTupleFieldInstance :: Int -> String+mkTupleFieldInstance n = render inst+ where inst = header $+$ nest 4 defs+ header = text "instance Field" <+> typ <+> text "where"++ typ = tupleOf [ text "r :->" <+> v | v <- vs ]+ vals = tupleOf vs++ defs = vcat [rec, val, field, accs]++ tupleOf = parens . commaSep+ commaSep = sep . punctuate (text ",")++ rs = [ text "r" <> PP.int i | i <- [1..n] ]+ vs = take n $ [ text [v] | v <- ['a'..'z'] ] +++ [ text [v1,v2] | v1 <- ['a'..'z']+ , v2 <- ['a'..'z'] ]++ rec = text "type Src" <+> typ <+> text "= r"+ val = text "type Dst" <+> typ <+> text "=" <+> vals+ field = text "field" <+> tupleOf rs <+> text "= lens get set"+ accs = nest 4 $ text "where" <+> vcat [getter, setter]++ getter = text "get r =" <+> tupleOf [ get r | r <- rs ]+ setter = text "set" <+> vals <+> text "=" <+>+ (sep . punctuate (text " .")) [ set r v | (r,v) <- zip rs vs ]++ get r = text "getL" <+> r <+> text "r"+ set r v = text "setL" <+> r <+> v+-}++instance Field (r :-> a, r :-> b, r :-> c) where+ type Src (r :-> a, r :-> b, r :-> c) = r+ type Dst (r :-> a, r :-> b, r :-> c) = (a, b, c)+ field (r1, r2, r3) = lens get set+ where get r = (getL r1 r, getL r2 r, getL r3 r)+ set (a, b, c) = setL r1 a . setL r2 b . setL r3 c+instance Field (r :-> a, r :-> b, r :-> c, r :-> d) where+ type Src (r :-> a, r :-> b, r :-> c, r :-> d) = r+ type Dst (r :-> a, r :-> b, r :-> c, r :-> d) = (a, b, c, d)+ field (r1, r2, r3, r4) = lens get set+ where get r = (getL r1 r, getL r2 r, getL r3 r, getL r4 r)+ set (a, b, c, d) = setL r1 a . setL r2 b . setL r3 c . setL r4 d+instance Field (r :-> a, r :-> b, r :-> c, r :-> d, r :-> e) where+ type Src (r :-> a, r :-> b, r :-> c, r :-> d, r :-> e) = r+ type Dst (r :-> a, r :-> b, r :-> c, r :-> d, r :-> e) = (a,+ b,+ c,+ d,+ e)+ field (r1, r2, r3, r4, r5) = lens get set+ where get r = (getL r1 r,+ getL r2 r,+ getL r3 r,+ getL r4 r,+ getL r5 r)+ set (a, b, c, d, e) = setL r1 a .+ setL r2 b .+ setL r3 c .+ setL r4 d .+ setL r5 e+instance Field (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f) where+ type Src (r :-> a, r :-> b, r :-> c, r :-> d, r :-> e, r :-> f) = r+ type Dst (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f) = (a, b, c, d, e, f)+ field (r1, r2, r3, r4, r5, r6) = lens get set+ where get r = (getL r1 r,+ getL r2 r,+ getL r3 r,+ getL r4 r,+ getL r5 r,+ getL r6 r)+ set (a, b, c, d, e, f) = setL r1 a .+ setL r2 b .+ setL r3 c .+ setL r4 d .+ setL r5 e .+ setL r6 f+instance Field (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g) where+ type Src (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g) = r+ type Dst (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g) = (a, b, c, d, e, f, g)+ field (r1, r2, r3, r4, r5, r6, r7) = lens get set+ where get r = (getL r1 r,+ getL r2 r,+ getL r3 r,+ getL r4 r,+ getL r5 r,+ getL r6 r,+ getL r7 r)+ set (a, b, c, d, e, f, g) = setL r1 a .+ setL r2 b .+ setL r3 c .+ setL r4 d .+ setL r5 e .+ setL r6 f .+ setL r7 g+instance Field (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h) where+ type Src (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h) = r+ type Dst (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h) = (a, b, c, d, e, f, g, h)+ field (r1, r2, r3, r4, r5, r6, r7, r8) = lens get set+ where get r = (getL r1 r,+ getL r2 r,+ getL r3 r,+ getL r4 r,+ getL r5 r,+ getL r6 r,+ getL r7 r,+ getL r8 r)+ set (a, b, c, d, e, f, g, h) = setL r1 a .+ setL r2 b .+ setL r3 c .+ setL r4 d .+ setL r5 e .+ setL r6 f .+ setL r7 g .+ setL r8 h+instance Field (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h,+ r :-> i) where+ type Src (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h,+ r :-> i) = r+ type Dst (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h,+ r :-> i) = (a, b, c, d, e, f, g, h, i)+ field (r1, r2, r3, r4, r5, r6, r7, r8, r9) = lens get set+ where get r = (getL r1 r,+ getL r2 r,+ getL r3 r,+ getL r4 r,+ getL r5 r,+ getL r6 r,+ getL r7 r,+ getL r8 r,+ getL r9 r)+ set (a, b, c, d, e, f, g, h, i) = setL r1 a .+ setL r2 b .+ setL r3 c .+ setL r4 d .+ setL r5 e .+ setL r6 f .+ setL r7 g .+ setL r8 h .+ setL r9 i+instance Field (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h,+ r :-> i,+ r :-> j) where+ type Src (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h,+ r :-> i,+ r :-> j) = r+ type Dst (r :-> a,+ r :-> b,+ r :-> c,+ r :-> d,+ r :-> e,+ r :-> f,+ r :-> g,+ r :-> h,+ r :-> i,+ r :-> j) = (a, b, c, d, e, f, g, h, i, j)+ field (r1, r2, r3, r4, r5, r6, r7, r8, r9, r10) = lens get set+ where get r = (getL r1 r,+ getL r2 r,+ getL r3 r,+ getL r4 r,+ getL r5 r,+ getL r6 r,+ getL r7 r,+ getL r8 r,+ getL r9 r,+ getL r10 r)+ set (a, b, c, d, e, f, g, h, i, j) = setL r1 a .+ setL r2 b .+ setL r3 c .+ setL r4 d .+ setL r5 e .+ setL r6 f .+ setL r7 g .+ setL r8 h .+ setL r9 i .+ setL r10 j+
+ Example.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where ++import Data.List+import Control.Applicative+import Control.Arrow ((***))+import "monads-fd" Control.Monad.State++import Data.Record.Field+import Data.Record.Label hiding ((=:))++data Person = Person+ { _firstName :: String+ , _lastName :: String+ , _age :: Int+ , _superior :: Maybe Person+ }++data Book = Book+ { _title :: String+ , _author :: Person+ , _characters :: [Person]+ }++$(mkLabels [''Person, ''Book])++parens s = concat ["(", s, ")"]++-- We could just derive Show, but let's try to eat our own dog food+-- here.+instance Show Person where+ -- Arguably, RecordWildCards would be nicer here, but nothing+ -- prevents you from using it along with this package.+ show (match (firstName, lastName, age, superior) ->+ (f, l, a, s)) = parens . unwords $ [ "Person"+ , show f+ , show l+ , show a+ , show s ]++instance Show Book where+ show b = parens . unwords $ "Book" : [ b .# f+ | f <- [ title #$ show+ , author #$ show+ , characters #$ show ] ]++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]++-- All the lets and primes are ugly, but it clearly shows that nothing+-- is being mutated. With the State monad, we could use (<=:) instead.+main = do print $ necronomicon .# title+ let necronomicon' = necronomicon .# author =: abdul+ print $ necronomicon' .# author # lastName++ sep++ let [mountains', caseOfCDW', reanimator' ] =+ [mountains, caseOfCDW, reanimator ] <.#> author =: howard++ [ mountains'', caseOfCDW'', reanimator'' ] =+ [ mountains', caseOfCDW', reanimator' ] *# characters =*+ [ [ william, frank ]+ , [ charles, marinus ]+ , [ herbert ] ]+ let books = [ mountains'', caseOfCDW''+ , reanimator'', necronomicon']+ print books++ sep++ print $ howard .# (firstName, lastName, age)+ print $ howard .# (firstName, (lastName, age )) =~+ (reverse *** reverse *** negate)++ sep++ print $ books <.#> characters <#> (lastName, firstName )+ print $ sortBy (compare `onField` author # lastName) books+ print $ sortBy (compare `onField` (characters <#> age) #$ sum) books++ sep++ print $ 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)++ sep++ print $ howard .# lastName #! 0+ print $ howard .# lastName #! 0 =: Nothing+ print $ howard .# lastName #! 0 =: Just 'X'++ sep++ let frank' = frank .# superior =: Just william+ -- :: Maybe Person+ print $ frank' .# superior+ -- :: Maybe (Maybe Person)+ print $ frank' .# superior <#> superior+ -- :: Maybe (Maybe (Maybe Person))+ print $ frank' .# superior <#> superior <#> superior+ -- :: Maybe Person+ print $ frank' .# superior <##> superior <##> superior <##> superior+ where sep = putStrLn ""+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Jussi Knuuttila++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jussi Knuuttila nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fields.cabal view
@@ -0,0 +1,161 @@+-- fields.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name: fields++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.1.0++-- A short (one-line) description of the package.+Synopsis: First-class record field combinators with infix+ record field syntax.++-- A longer description of the package.+Description: Using records, especially nested records, in+ Haskell can sometimes be a bit of a chore.+ Fortunately, there are several libraries in hackage+ that 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.+ .+ In addition, the following features are supported:+ .+ * Accessing several fields simultaneously using+ tuples.+ Example: @record .# (field1, field2, field3)@+ .+ * Accessing records inside a @'Functor'@.+ Example: @recordInFunctor \<.#\> field@+ .+ * Composing fields with @'Applicative'@ functors+ and @'Monad'@s.+ Example: @record .\# applicativeField \<\#\> subfield@+ .+ * Pattern matching using @ViewPatterns@.+ Example: @case record of (match field -> 1) -> ...@+ .+ * Easy comparisons etc. using @'onField'@.+ Example: @sortBy (compare \`onField\`+ field#subfield) records@+ .+ For a detailed description of usage, see+ "Data.Record.Field".+ .+ This library is a work-in-progress. Some+ limitations, deficiencies, points of interest and+ possible future improvements include:+ .+ * Currently, a @'Field'@ instance is only provided+ for @"fclabels"@ lenses, since that is what I+ have personally used. However, there should be+ nothing in principle that would prevent adding+ instances for @"data-accessor"@ and @"lenses"@.+ However, doing this would make this package+ depend on several record libraries at once,+ which might not be the best approach. Perhaps+ this package should be split into several+ packages?+ .+ * Similarly, the @'field'@ method currently+ returns an @"fclabels"@ lens. To fully decouple+ this package from @"fclabels"@, the @'field'@+ method probably has to be split into @getField@,+ @setField@ and @modField@ or something similar.+ .+ * For monad transformers, @"transformers"@ and+ @"monads-fd"@ are used, since those are what+ @"fclabels"@ uses. This might be a problem for a+ program that uses @"mtl"@ instead.+ .+ * To avoid lots of parentheses, @"fields"@ uses+ high-precedence operators at three operator+ precedence levels. The goal was to make field+ accesses directly usable in arithmetic+ expressions (e.g. @r1\.\#int + r2\.\#int@).+ Unfortunately, since Haskell has a finite number+ of precedence levels, this goal was not properly+ met, since @('*')@ and all higher-precedence+ arithmetic operators have conflicting precedence+ levels.+ .+ * Performance has not been analyzed at all. To my+ knowledge, GHC doesn't do type class+ specialization or method inlining by default, so+ needlessly generic code might be generated, even+ if all types are statically known. I'm hoping+ that this can be addressed using @SPECIALIZE@+ and @INLINE@ pragmas if it turns out to be an+ issue.++-- The license under which the package is released.+License: BSD3++-- The file containing the license text.+License-file: LICENSE++-- The package author(s).+Author: Jussi Knuuttila++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: jussi.knuuttila@tkk.fi++Homepage: http://github.com/AstraFIN/fields++-- A copyright notice.+-- Copyright: ++Category: Data++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files: Example.hs ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.8.0.2+++Library+ -- Modules exported by the library.+ Exposed-modules: Data.Record.Field+ , Data.Record.Field.Basic+ , Data.Record.Field.Combinators+ , Data.Record.Field.Tuple+ , Data.Record.Field.Indexable+ + -- Packages needed in order to build this package.+ Build-depends: base >= 4 && < 5+ , fclabels >= 0.9.1+ , containers >= 0.3.0.0+ , array >= 0.3.0.0+ , transformers >= 0.2.0.0+ , monads-fd >= 0.1.0.1+ + -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +