named-records 0.2.1 → 0.2.2

raw patch · 3 files changed

+224/−149 lines, 3 filesdep ~namesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: names

API changes (from Hackage documentation)

Files

• named-records.cabal +80/−4
• src/Data/NamedRecord.hs +144/−3
• src/Data/NamedRecord/TH.hs +0/−142

@@ -1,11 +1,88 @@ Name:           named-records-Version:        0.2.1+Version:        0.2.2 Synopsis:       Flexible records with named fields. Description:    Flexible records with named fields.                 .                 [@v0.2@] Default values with @record@.                 .                 [@v0.2.1@] Requires @names-0.2.1@.+                .+                [@v0.2.2@] TH @record@ definitions allow for+                    more types to be used in the definition.+                .+                Named records allow you to define und use records+                with labeled fields. These records are first class+                objects. Record fields are labeled by names, which+                can basically be any type. However, the names package+                provides global name types and some syntactic sugar+                to use them.+                .+                Here is a complete walk-through, with Template Haskell+                syntactic sugar.+                .+                This is how a typical example preamble looks like:+                .+                > {-# LANGUAGE Haskell2010, TemplateHaskell #-}+                > +                > import qualified Data.Name+                > import Data.NamedRecord+                .+                In order to use names you need to declare them first+                (see the @names@ package for further details):+                .+                > name "firstName"+                > name "lastName"+                .+                These are two records @Person@ and @User@:+                .+                > record "Person"+                >     `has` "firstName" := ''String+                >     `has` "lastName"  := ''String+                >+                > record "User"+                >     `has` "firstName" := ''String+                >     `has` "lastName"  := ''String+                >     `has` "loginName" := ''String+                .+                Note that these declarations create constructor+                functions @newPerson@ and @newUser@, as well as+                type synonyms @Person@ and @User@ (use @-ddump-slices@+                to see what has been generated).+                .+                Here are two instances of these recors:+                . +                > julian = newPerson+                >    `set` firstName := "Julian"+                >    `set` lastName  := "Fleischer"+                >+                > alexander = newUser+                >    `set` firstName := "Alexander"+                >    `set` lastName  := "Carnicero"+                >    `set` loginName := "alexander.carnicero"+                .+                We can now create a @displayName@ function like+                the following:+                .+                > displayName obj =+                >     (obj `get` firstName) ++ " " +++                >     (obj `get` lastName)+                .+                Note that this function will accept any record+                that has a @firstName@ and a @lastName@ field of+                type @String@.+                .+                >>> displayName julian+                Julian Fleischer+                .+                >>> displayName alexander+                Alexander Carnicero+                .+                As mentioned above, records are first class citizens.+                That means you can create them anywhere:+                .+                >>> displayName (firstName := "John" :+ lastName := "Doe")+                John Doe               +                 License:        MIT License-File:   LICENSE Author:         Julian Fleischer <julian.fleischer@fu-berlin.de>@@ -16,11 +93,10 @@ Stability:      experimental  Library-    Exposed-Modules:    Data.NamedRecord,-                        Data.NamedRecord.TH+    Exposed-Modules:    Data.NamedRecord      Build-Depends:      base >= 4 && < 5,-                        names == 0.2.1,+                        names == 0.2.2,                         template-haskell >= 2.7      Hs-Source-Dirs:     src

@@ -1,4 +1,5 @@ {-# LANGUAGE Haskell2010+    , TemplateHaskell     , MultiParamTypeClasses     , FunctionalDependencies     , TypeOperators@@ -7,14 +8,39 @@     , OverlappingInstances  #-} -module Data.NamedRecord where+module Data.NamedRecord (+    Property (get, set),+    add, +    (:=) (..),+    (:+) (..), +    record,+    has,++    RecordTemplate (..),++    module Data.Name+) where++import Data.List+import qualified Data.Name+import Data.Name (name, nameT, nameV)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax (Lift (..))+++ data a := b = a := b deriving Show  infixl 3 :=  +data a :+ b = a :+ b deriving Show++infixr 2 :+++ class Property o n v | o n -> v where          get :: o -> n -> v@@ -48,8 +74,123 @@     set (a :+ b) p = a :+ (set b p)  -data a :+ b = a :+ b deriving Show -infixr 2 :++data Record = Record String++record :: String -> Record+record = Record+++class ToType a where toType :: a -> Q Type++instance ToType (Q Type) where toType = id+instance ToType Name where toType = return . ConT+++class ToExp a where toExp :: a -> Q Exp++instance ToExp (Q Exp) where toExp = id+instance Lift a => ToExp a where toExp = lift+++class RecordTemplate a b c | a b -> c where+    (~>) :: a -> b -> c+++instance (ToType v, ToType w) => RecordTemplate+        (String := v)+        (String := w)+        [(String, Q Type, Maybe (Q Exp))] where+    (n := v) ~> (m := w) = [(n, toType v, Nothing),+                            (m, toType w, Nothing)]++instance (ToType v, ToType w, ToExp e) => RecordTemplate+        (String := v)+        (String := w := e)+        [(String, Q Type, Maybe (Q Exp))] where+    (n := v) ~> (m := w := e) = [(n, toType v, Nothing),+                                 (n, toType w, Just $ toExp e)]++instance (ToType v, ToType w, ToExp d) => RecordTemplate+        (String := v := d)+        (String := w)+        [(String, Q Type, Maybe (Q Exp))] where+    (n := v := d) ~> (m := w) = [(n, toType v, Just $ toExp d),+                                 (n, toType w, Nothing)]++instance (ToType v, ToType w, ToExp d, ToExp e) => RecordTemplate+        (String := v := d)+        (String := w := e)+        [(String, Q Type, Maybe (Q Exp))] where+    (n := v := d) ~> (m := w := e) = [(n, toType v, Just $ toExp d),+                                      (n, toType w, Just $ toExp e)]++instance ToType v => RecordTemplate+        (String := v)+        [(String, Q Type, Maybe (Q Exp))]+        [(String, Q Type, Maybe (Q Exp))] where+    (n := v) ~> xs = (n, toType v, Nothing) : xs++instance (ToType v, ToExp d) => RecordTemplate+        (String := v := d)+        [(String, Q Type, Maybe (Q Exp))]+        [(String, Q Type, Maybe (Q Exp))] where+    (n := v := d) ~> xs = (n, toType v, Just $ toExp d) : xs+++instance ToType v => RecordTemplate Record (String := v) (Q [Dec]) where+    r ~> (n := v) = r ~> [(n, toType v, Nothing :: Maybe (Q Exp))]++instance (ToType v, ToExp d) =>+        RecordTemplate Record (String := v := d) (Q [Dec]) where+    r ~> (n := v := d) = r ~> [(n, toType v, Just $ toExp d)]+++instance RecordTemplate+        Record [(String, Q Type, Maybe (Q Exp))] (Q [Dec]) where++    Record name ~> fs = do+        let typeD typ = TySynD (mkName name) [] typ++            func (name, valType, defaultVal) = do+                nameType <- nameT name+                valueType <- valType+                defaultValue <- maybe (return $ VarE 'value) id defaultVal+                return $ ( AppT (AppT (ConT ''(:=)) nameType) valueType+                         , defaultValue )++        fields <- mapM func+            $ sortBy (\(x, _, _) (y, _, _) -> compare x y) fs++        let syn = foldr (\(x, _) xs -> AppT (AppT (ConT ''(:+)) x) xs)+                        (fst $ last fields) (init fields)++            cName = mkName ("new" ++ name)++            sigD = SigD cName (ConT (mkName name))++            funcD = ValD (VarP cName) (NormalB funcB) []+            funcB = foldr join (field $ last fields) (init fields)+              where+                join x xs = InfixE (Just $ field x) (ConE '(:+)) (Just xs)++            field (_, x) = InfixE (Just (VarE '_type))+                             (ConE '(:=))+                             (Just x)++        return [typeD syn, sigD, funcD]+++_type = error $ "NamedRecord field type unwrapped!"+    ++ " You should never see this."+    ++ " Srsly, what did you do?"++value = error "Data.NameRecord.undefined: No value set."++has :: RecordTemplate a b c => a -> b -> c+has = (~>)++infixr 1 ~>+infixr 1 `has`  

@@ -1,142 +0,0 @@-{-# LANGUAGE Haskell2010-    , MultiParamTypeClasses-    , FunctionalDependencies-    , TypeOperators-    , FlexibleInstances-    , TemplateHaskell- #-}--module Data.NamedRecord.TH where---import Data.List-import Data.NamedRecord-import Data.Name.TH-import Language.Haskell.TH---data Record = Record String--record :: String -> Record-record = Record---class RecordTemplate a b c | a b -> c where-    -    (~>) :: a -> b -> c---instance RecordTemplate-    (String := Name)-    (String := Name)-    [(String := Name, Maybe (Q Exp))] where--    a ~> b = [(a, Nothing), (b, Nothing)]---instance RecordTemplate-    (String := Name := Q Exp)-    (String := Name)-    [(String := Name, Maybe (Q Exp))] where--    (p := d) ~> b = [(p, Just d), (b, Nothing)]---instance RecordTemplate-    (String := Name)-    (String := Name := Q Exp)-    [(String := Name, Maybe (Q Exp))] where--    a ~> (p := d) = [(a, Nothing), (p, Just d)]---instance RecordTemplate-    (String := Name := Q Exp)-    (String := Name := Q Exp)-    [(String := Name, Maybe (Q Exp))] where--    (a := m) ~> (b := n) = [(a, Just m), (b, Just n)]---instance RecordTemplate-    (String := Name)-    [(String := Name, Maybe (Q Exp))]-    [(String := Name, Maybe (Q Exp))] where--    p ~> xs = (p, Nothing) : xs---instance RecordTemplate-    (String := Name := Q Exp)-    [(String := Name, Maybe (Q Exp))]-    [(String := Name, Maybe (Q Exp))] where--    (p := d) ~> xs = (p, Just d) : xs---instance RecordTemplate-    Record-    (String := Name)-    (Q [Dec]) where--    r ~> p = r ~> [(p, Nothing :: Maybe (Q Exp))]---instance RecordTemplate-    Record-    (String := Name := Q Exp)-    (Q [Dec]) where--    r ~> (p := d) = r ~> [(p, Just d)]---instance RecordTemplate-    Record-    [(String := Name, Maybe (Q Exp))]-    (Q [Dec]) where--    Record name ~> fs = do-        let typeD typ = TySynD (mkName name) [] typ--            func (name := valueType, defaultVal) = do-                nameType <- nameT name-                defaultValue <- maybe (return $ VarE 'value) id defaultVal-                return $ ( AppT (AppT (ConT ''(:=)) nameType)-                                (ConT valueType)-                         , defaultValue )--        fields <- mapM func-            $ sortBy (\(x := _, _) (y := _, _) -> compare x y) fs--        let syn = foldr (\(x, _) xs -> AppT (AppT (ConT ''(:+)) x) xs)-                        (fst $ last fields) (init fields)--            cName = mkName ("new" ++ name)--            sigD = SigD cName (ConT (mkName name))--            funcD = ValD (VarP cName) (NormalB funcB) []-            funcB = foldr join (field $ last fields) (init fields)-              where-                join x xs = InfixE (Just $ field x) (ConE '(:+)) (Just xs)--            field (_, x) = InfixE (Just (VarE '_type))-                             (ConE '(:=))-                             (Just x)--        return [typeD syn, sigD, funcD]---_type = error $ "NamedRecord field type unwrapped!"-    ++ " You should never see this."-    ++ " Srsly, what did you do?"--value = error "Data.NameRecord.undefined: No value set."--has :: RecordTemplate a b c => a -> b -> c-has = (~>)--infixr 1 ~>-infixr 1 `has`--