air-th (empty) → 2014.5.19

raw patch · 11 files changed

+203/−0 lines, 11 filesdep +airdep +basedep +template-haskellsetup-changed

Dependencies added: air, base, template-haskell

Files

• LICENSE +31/−0
• Setup.hs +3/−0
• air-th.cabal +30/−0
• changelog.md +4/−0
• known-issues.md +0/−0
• readme.md +2/−0
• src/Air/Data/Record/SimpleLabel/TH.hs +33/−0
• src/Air/TH.hs +11/−0
• src/Air/TH/Air.hs +18/−0
• src/Air/TH/Default.hs +53/−0
• src/Air/TH/Here.hs +18/−0

@@ -0,0 +1,31 @@+Copyright (c) 2011, Jinjing Wang++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 Jinjing Wang 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.

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

@@ -0,0 +1,30 @@+Name:                 air-th+Version:              2014.5.19+Build-type:           Simple+Synopsis:             air+Description:          Template Haskell helpers for air+License:              BSD3+Author:               Jinjing Wang+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Development+license-file:         LICENSE+homepage:             https://github.com/nfjinjing/air-th+data-files:           readme.md, changelog.md, known-issues.md++library++  build-depends:+                    base >= 4 && < 5+                  , air >= 2014.5.19+                  , template-haskell++  hs-source-dirs: src/++  exposed-modules:+                    Air.TH.Here+                  , Air.TH.Default+                  , Air.TH.Air+                  , Air.TH+                  , Air.Data.Record.SimpleLabel.TH

@@ -0,0 +1,4 @@+2011.7.25+---------++* add bytestring conversion

@@ -0,0 +1,2 @@+An alternative Haskell Prelude library.+

@@ -0,0 +1,33 @@+module Air.Data.Record.SimpleLabel.TH (mkLabels, mkLabel) where++import Control.Monad+import Data.Char+import Language.Haskell.TH.Syntax++-- | Derive labels for all the record selector in a datatype.+mkLabels :: [Name] -> Q [Dec]+mkLabels = liftM concat . mapM mkLabel++mkLabel :: Name -> Q [Dec]+mkLabel n = do+    i <- reify n+    let -- only process data and newtype declarations+        cs' = case i of+                TyConI (DataD _ _ _ cs _)   -> cs+                TyConI (NewtypeD _ _ _ c _) -> [c]+                _ -> []+        -- we're only interested in labels of record constructors+        ls' = [ l | RecC _ ls <- cs', l <- ls ]+    return (map mkLabel1 ls')++mkLabel1 :: VarStrictType -> Dec+mkLabel1 (name, _, _) =+    -- Generate a name for the label:+    -- in this fork: label names are "__" + accesser name, e.g. if data Square = Square {length :: Double}, then label is __length+    let n = mkName $ "__" ++ nameBase name+    in FunD n [Clause [] (NormalB (+           AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter+                (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter+                      (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))]))+                                   )) []]+

@@ -0,0 +1,11 @@+module Air.TH (+    module Air.Data.Record.SimpleLabel.TH+  , module Air.TH.Here+  , module Air.TH.Default+  , module Air.TH.Air+) where++import Air.Data.Record.SimpleLabel.TH+import Air.TH.Here+import Air.TH.Default+import Air.TH.Air

@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++module Air.TH.Air where++import Language.Haskell.TH+import Control.Monad (replicateM)+++{-+> $(tuple 3) [1,2,3,4,5]+ (1,2,3)+ > $(tuple 2) [1,2]+ (1,2)+-}+tuple :: Int -> ExpQ+tuple n = do+    ns <- replicateM n (newName "x")+    lamE [foldr (\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns)

@@ -0,0 +1,53 @@+{-# LANGUAGE TemplateHaskell #-}++module Air.TH.Default where++import Language.Haskell.TH+import Air.Data.Default+++-- $(reify ''Dummy >>= show > stringE)+-- "TyConI (DataD [] Main.Dummy [] [RecC Main.Dummy [(Main.test_field_1,NotStrict,ConT GHC.Base.String),(Main.test_field_2,NotStrict,ConT GHC.Integer.Type.Integer)]] [])"++-- runQ [d| instance Default Dummy where def = Dummy def def |]+-- [InstanceD [] (AppT (ConT Data.Default.Default) (ConT Main.Dummy)) [ValD (VarP def) (NormalB (AppE (AppE (ConE Main.Dummy) (VarE def)) (VarE def))) []]]++-- runQ [d| instance Default Dummy where def = Dummy {test_field_1 = def, test_field_2 = def} |]+-- [InstanceD [] (AppT (ConT Data.Default.Default) (ConT Main.Dummy)) [ValD (VarP def) (NormalB (RecConE Main.Dummy [(Main.test_field_1,VarE def),(Main.test_field_2,VarE def)])) []]]++-- Example:++-- data Dummy = Dummy+--   {+--     test_field_1 :: String+--   , test_field_2 :: Integer+--   }+--   deriving (Show)+-- +-- mkDefault ''Dummy+-- +-- gives:++-- instance Default Dummy where+--     { def = Dummy {test_field_1 = def, test_field_2 = def} }+++mkDefault :: Name -> Q [Dec]+mkDefault name = do+  info <- reify name+  case info of+    TyConI x -> do+      case x of+        (DataD _ data_name _ recs _)  -> do+          case recs of+            [] -> error $ "no phantom type"+            (RecC record_name fields):_ -> do+              let def_name = mkName "def"+              let def_fields = map (\(field_name, _, _) -> (field_name, VarE def_name)) fields+              return $ return $ +                InstanceD [] +                  (AppT (ConT ''Default) (ConT data_name)) +                  [ValD (VarP def_name) (NormalB (RecConE record_name def_fields)) []]+        NewtypeD _ _ _ _ _ -> error "Newtypes are not supported"+        _ -> error $ "Unknown declaration type"+    _        -> error "Only datatypes can be processed"

@@ -0,0 +1,18 @@+-- {-# LANGUAGE CPP #-}++module Air.TH.Here where++import Language.Haskell.TH.Quote +import Language.Haskell.TH.Syntax +import Language.Haskell.TH.Lib +++here :: QuasiQuoter +here = +  QuasiQuoter +    {+      quoteExp = litE . stringL+    , quotePat = litP . stringL+    }++