diff --git a/records.cabal b/records.cabal --- a/records.cabal +++ b/records.cabal @@ -1,5 +1,5 @@ Name: records -Version: 0.0.0.1 +Version: 0.1.0.0 Cabal-Version: >= 1.2.3 Build-Type: Simple License: BSD3 @@ -26,9 +26,9 @@ Tested-With: GHC == 6.10.4 Library - Build-Depends: base >= 3.0 && < 4.1, - kinds >= 0.0 && < 0.1, - type-functions >= 0.0 && < 0.1 + Build-Depends: base >= 3.0 && < 4.1, + kinds >= 0.0.1 && < 0.1, + type-functions >= 0.1 && < 0.2 Extensions: EmptyDataDecls FlexibleContexts FlexibleInstances diff --git a/src/Data/Record.hs b/src/Data/Record.hs --- a/src/Data/Record.hs +++ b/src/Data/Record.hs @@ -48,15 +48,15 @@ record has the following type: @ - (X :& Surname ::: String :& Age ::: Int :& Room ::: String) 'Id' + (X :& Surname ::: String :& Age ::: Int :& Room ::: String) ('Id' 'KindStar') @ - If we replace the type @Id@ by @Id -> Id@, we get a type that covers all records with a - @Surname@, an @Age@, and a @Room@ field that contain values of type @String -> String@, @Int - -> Int@, and @String -> String@, respectively. (Note that the type @Id -> Id@ represents the - type-level function @\\t -> (t -> t)@ according to the @(->)@ instance of 'TypeFun'.) - So by varying the style, we can generate a family of related record types from a single - record scheme. + If we replace the type @Id KindStar@ by @Id KindStar -> Id KindStar@, we get a type that covers + all records with a @Surname@, an @Age@, and a @Room@ field that contain values of type + @String -> String@, @Int -> Int@, and @String -> String@, respectively. (Note that the type @Id + KindStar -> Id KindStar@ represents the type-level function @\\t -> (t -> t)@ according to the + @(->)@ instance of 'TypeFun'.) So by varying the style, we can generate a family of related + record types from a single record scheme. -} -- |The empty record scheme. @@ -221,7 +221,8 @@ * Removing that name-sort pair from @/r/@ yields @/r'/@. -} - class (Name sepName) => Separation rec remain sepName sepSort | rec sepName -> remain where + class (Name sepName) => + Separation rec remain sepName sepSort | rec sepName -> remain sepSort where {-| Extracts the last field of the respective name and returns the remaining record and the diff --git a/src/Data/Record/Combinators.hs b/src/Data/Record/Combinators.hs --- a/src/Data/Record/Combinators.hs +++ b/src/Data/Record/Combinators.hs @@ -1,6 +1,13 @@ -- |Record combinators built on top of the record core that "Data.Record" provides. module Data.Record.Combinators ( + -- * Record styles + withStyle, + + -- * Field operations + (!!!), + (\\\), + -- * Catenation Cat, cat, @@ -32,6 +39,62 @@ -- Control import Control.Applicative as Applicative hiding (Const) -- only for documentation + -- * Record styles + infixl 2 `withStyle` + + --FIXME: There is punctuation missing at the end of certain code blocks. + {-| + Fixes the style of a record. When a record is constructed using @X@, @(:&)@, and @(:=)@, + the style of this record is not fixed. For example, the most general type of the record + + @ + X :& Surname := \"Jeltsch\" :& Age := 33 :& Room := \"HG/2.39\" + @ + + is + + @ + ('App' style sortSurname ~ String, Num ('App' style sortAge), 'App' style sortRoom ~ String) => + (X :& Surname ::: /sortSurname/ :& Age ::: /sortAge/ :& Room ::: /sortRoom/) style + @ + + We can fix the style of that record using the expression + + @ + X :& Surname := \"Jeltsch\" :& Age := 33 :& Room := \"HG/2.39\" \`withStyle\` Id KindStar + @ + + which has the most general type + + @ + (Num age) => + (X :& Surname ::: String :& Age ::: age :& Room ::: String) (Id KindStar) + @ + + The @withStyle@ combinator is similar to 'asTypeOf'. + -} + withStyle :: (Record (Domain style) rec) => rec style -> style -> rec style + withStyle = const + + -- * Field operations + infixl 2 !!!, \\\ + + -- |Looks up the value of a record field. + (!!!) :: (Separation rec remain sepName sepSort) => rec style -> sepName -> App style sepSort + rec !!! name = let + + _ := sepVal = snd (separate rec) `asTypeOf` (name := undefined) + + in sepVal + + -- |Removes a record field. + (\\\) :: (Separation rec remain sepName sepSort) => rec style -> sepName -> remain style + rec \\\ name = let + + (remain,_) = separate rec `asTypeOf` (undefined,name := undefined) + + in remain + -- * Catenation -- |Catenation of two record schemes. type family Cat (rec1 :: * -> *) (rec2 :: * -> *) :: * -> * @@ -39,8 +102,13 @@ type instance Cat rec1 (rec2 :& name2 ::: sort2) = Cat rec1 rec2 :& name2 ::: sort2 -- |Catenation of two records. - cat :: (TypeFun style, Record (Domain style) rec1, Record (Domain style) rec2) => - rec1 style -> rec2 style -> Cat rec1 rec2 style + cat :: (TypeFun style, Record (Domain style) rec1, Record (Domain style) rec2) + => rec1 style + -- ^ + -> rec2 style + -- ^ + -> Cat rec1 rec2 style + -- ^ cat = let CatThing cat = fold catNilAlt catExpander @@ -71,10 +139,13 @@ Generates a record whose fields all contain the same value. In contrast to the 'Prelude.repeat' function from the Prelude, this function generates a finite data structure. Thereby, the size of the generated record is determined by its type. @repeat@ is almost a - proper implementation of 'pure' from the 'Applicative' class. The only problem is that the - argument of @repeat@ uses the 'Universal' type. + proper implementation of 'pure' from the 'Applicative' class. -} - repeat :: (TypeFun style, Record (Domain style) rec) => Universal style -> rec style + repeat :: (TypeFun style, Record (Domain style) rec) + => Universal style + -- ^ + -> rec style + -- ^ repeat = let RepeatThing repeat = fold repeatNilAlt repeatExpander @@ -104,16 +175,16 @@ repeatExpander = closed (Expander repeatSnocAlt) zipWithApp :: (TypeFun style, TypeFun style', Domain style ~ Domain style', - Record (Domain (style -> style')) rec) => - rec (style -> style') -> rec style -> rec style' + Record (Domain (style :-> style')) rec) => + rec (style :-> style') -> rec style -> rec style' zipWithApp = let ZipWithAppThing zipWithApp = fold zipWithAppNilAlt zipWithAppExpander in zipWithApp - newtype ZipWithAppThing style style' rec = ZipWithAppThing (rec (style -> style') -> - rec style -> + newtype ZipWithAppThing style style' rec = ZipWithAppThing (rec (style :-> style') -> + rec style -> rec style') zipWithAppNilAlt :: (TypeFun style, TypeFun style', Domain style ~ Domain style') => @@ -123,7 +194,7 @@ nilZipWithApp X X = X zipWithAppSnocAlt :: (TypeFun style, TypeFun style', Domain style ~ Domain style', - Record (Domain (style -> style')) rec, + Record (Domain (style :-> style')) rec, Name name, Inhabitant (Domain style) sort) => ZipWithAppThing style style' rec -> @@ -134,33 +205,50 @@ (argRec :& _ := arg) = zipWithApp funRec argRec :& name := fun arg zipWithAppExpander :: (TypeFun style, TypeFun style', Domain style ~ Domain style', - Record (Domain (style -> style')) rec, Name name) => + Record (Domain (style :-> style')) rec, Name name) => All (Domain style) (Expander (ZipWithAppThing style style') rec name) zipWithAppExpander = closed (Expander zipWithAppSnocAlt) infixl 4 <<*>> {-| Merges a record of functions and a record of arguments by applying the functions to the - corresponding arguments. The @(\<\<*\>\>)@ function would be a proper implementation + corresponding arguments. The @(\<\<*\>\>)@ function is almost a proper implementation of @(\<*\>)@ from the 'Applicative' class. -} (<<*>>) :: (TypeFun style, TypeFun style', Domain style ~ Domain style', - Record (Domain (style -> style')) rec) => - rec (style -> style') -> rec style -> rec style' + Record (Domain (style :-> style')) rec) + => rec (style :-> style') + -- ^ + -> rec style + -- ^ + -> rec style' + -- ^ (<<*>>) = zipWithApp -- ** Derived combinators -- |Transforms a record by applying a function to all its field values. map :: (TypeFun style, TypeFun style', Domain style ~ Domain style', - Record (Domain (style -> style')) rec) => - Universal (style -> style') -> rec style -> rec style' + Record (Domain (style :-> style')) rec) + => Universal (style :-> style') + -- ^ + -> rec style + -- ^ + -> rec style' + -- ^ map fun argRec = repeat fun <<*>> argRec -- |Merges two records by applying a function to each pair of corresponding field values. zipWith :: (TypeFun style1, TypeFun style2, TypeFun style', Domain style1 ~ Domain style2, Domain style2 ~ Domain style', - Record (Domain (style1 -> style2 -> style')) rec) => - Universal (style1 -> style2 -> style') -> rec style1 -> rec style2 -> rec style' + Record (Domain (style1 :-> style2 :-> style')) rec) + => Universal (style1 :-> style2 :-> style') + -- ^ + -> rec style1 + -- ^ + -> rec style2 + -- ^ + -> rec style' + -- ^ zipWith fun argRec1 argRec2 = repeat fun <<*>> argRec1 <<*>> argRec2 -- * Modification @@ -175,11 +263,16 @@ modify :: (TypeFun style, Record (Domain style) rec, Record (Domain style) modRec, - Convertible rec modRec) => - modRec (style -> style) -> rec style -> rec style + Convertible rec modRec) + => modRec (style :-> style) + -- ^ + -> rec style + -- ^ + -> rec style + -- ^ modify modRec = foldr (.) id $ toList (convert updateFuns <<*>> modRec) - type UpdateFunStyle rec style = (style -> style) -> + type UpdateFunStyle rec style = (style :-> style) :-> Const (Domain style) (rec style -> rec style) updateFuns :: (TypeFun style, Record (Domain style) rec) => rec (UpdateFunStyle rec style)