named-records 0.1 → 0.2

raw patch · 2 files changed

+78/−23 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• named-records.cabal +5/−3
• src/Data/NamedRecord/TH.hs +73/−20

@@ -1,7 +1,9 @@ Name:           named-records-Version:        0.1-Synopsis:       Named records.-Description:    Named records.+Version:        0.2+Synopsis:       Flexible records with named fields.+Description:    Flexible records with named fields.+                .+                [@v0.2@] Default values with @record@. License:        MIT License-File:   LICENSE Author:         Julian Fleischer <julian.fleischer@fu-berlin.de>

@@ -27,58 +27,111 @@   instance RecordTemplate-    (String := Name) (String := Name) [String := Name] where+    (String := Name)+    (String := Name)+    [(String := Name, Maybe (Q Exp))] where -    a ~> b = [a, b]+    a ~> b = [(a, Nothing), (b, Nothing)]   instance RecordTemplate-    (String := Name) [String := Name] [String := Name] where+    (String := Name := Q Exp)+    (String := Name)+    [(String := Name, Maybe (Q Exp))] where -    (~>) = (:)+    (p := d) ~> b = [(p, Just d), (b, Nothing)]  -instance RecordTemplate Record (String := Name) (Q [Dec]) where+instance RecordTemplate+    (String := Name)+    (String := Name := Q Exp)+    [(String := Name, Maybe (Q Exp))] where -    record ~> field = record ~> [field]+    a ~> (p := d) = [(a, Nothing), (p, Just d)]  -instance RecordTemplate Record [String := Name] (Q [Dec]) where+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) = do+            func (name := valueType, defaultVal) = do                 nameType <- nameT name-                return $ AppT (AppT (ConT ''(:=)) nameType)-                              (ConT valueType)+                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+            $ sortBy (\(x := _, _) (y := _, _) -> compare x y) fs -        let def = foldr (\x xs -> AppT (AppT (ConT ''(:+)) x) xs)-                        (last fields) (init fields)+        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 (init fields)+            funcB = foldr join (field $ last fields) (init fields)               where-                join x xs = InfixE (Just field) (ConE '(:+)) (Just xs)+                join x xs = InfixE (Just $ field x) (ConE '(:+)) (Just xs) -            field = InfixE (Just (VarE '_type))-                           (ConE '(:=))-                           (Just (VarE '_value))+            field (_, x) = InfixE (Just (VarE '_type))+                             (ConE '(:=))+                             (Just x) -        return [typeD def, sigD, funcD]+        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."++value = error "Data.NameRecord.undefined: No value set."  has :: RecordTemplate a b c => a -> b -> c has = (~>)