named-records (empty) → 0.1

raw patch · 5 files changed

+190/−0 lines, 5 filesdep +basedep +namesdep +template-haskellsetup-changed

Dependencies added: base, names, template-haskell

Files

• LICENSE +18/−0
• Setup.lhs +4/−0
• named-records.cabal +24/−0
• src/Data/NamedRecord.hs +55/−0
• src/Data/NamedRecord/TH.hs +89/−0

@@ -0,0 +1,18 @@+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER+DEALINGS IN THE SOFTWARE.+

@@ -0,0 +1,4 @@+import Distribution.Simple++main = defaultMain+

@@ -0,0 +1,24 @@+Name:           named-records+Version:        0.1+Synopsis:       Named records.+Description:    Named records.+License:        MIT+License-File:   LICENSE+Author:         Julian Fleischer <julian.fleischer@fu-berlin.de>+Maintainer:     Julian Fleischer <julian.fleischer@fu-berlin.de>+Build-Type:     Simple+Cabal-Version:  >= 1.6+Category:       Data, Records+Stability:      experimental++Library+    Exposed-Modules:    Data.NamedRecord,+                        Data.NamedRecord.TH++    Build-Depends:      base >= 4 && < 5,+                        names == 0.2,+                        template-haskell >= 2.7++    Hs-Source-Dirs:     src++

@@ -0,0 +1,55 @@+{-# LANGUAGE Haskell2010+    , MultiParamTypeClasses+    , FunctionalDependencies+    , TypeOperators+    , FlexibleInstances+    , UndecidableInstances+    , OverlappingInstances+ #-}++module Data.NamedRecord where+++data a := b = a := b deriving Show++infixl 3 :=+++class Property o n v | o n -> v where+    +    get :: o -> n -> v+    set :: o -> n := v -> o++infixl 1 `set`+infixl 1 `get`+++add :: b -> a -> a :+ b+add = flip (:+)++infixl 1 `add`+++instance Property (n := v) n v where++    get (_ := v) _ = v+    set _ v = v+++instance Property ((n := v) :+ b) n v where++    get (a :+ b) n = get a n+    set (a :+ b) p = (set a p) :+ b+++instance Property b n v => Property (a :+ b) n v where++    get (a :+ b) n = get b n+    set (a :+ b) p = a :+ (set b p)+++data a :+ b = a :+ b deriving Show++infixr 2 :+++

@@ -0,0 +1,89 @@+{-# 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] where++    a ~> b = [a, b]+++instance RecordTemplate+    (String := Name) [String := Name] [String := Name] where++    (~>) = (:)+++instance RecordTemplate Record (String := Name) (Q [Dec]) where++    record ~> field = record ~> [field]+++instance RecordTemplate Record [String := Name] (Q [Dec]) where++    Record name ~> fs = do+        let typeD typ = TySynD (mkName name) [] typ++            func (name := valueType) = do+                nameType <- nameT name+                return $ AppT (AppT (ConT ''(:=)) nameType)+                              (ConT valueType)++        fields <- mapM func+            $ sortBy (\(x := _) (y := _) -> compare x y) fs++        let def = foldr (\x xs -> AppT (AppT (ConT ''(:+)) x) xs)+                        (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)+              where+                join x xs = InfixE (Just field) (ConE '(:+)) (Just xs)++            field = InfixE (Just (VarE '_type))+                           (ConE '(:=))+                           (Just (VarE '_value))++        return [typeD def, 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`++