packages feed

template-haskell-util 0.1.0.2 → 0.1.0.3

raw patch · 20 files changed

+216/−35 lines, 20 filesdep +GenericPrettybinary-added

Dependencies added: GenericPretty

Files

.git/COMMIT_EDITMSG view
@@ -1,9 +1,10 @@-add some functions+cabal file update # Please enter the commit message for your changes. Lines starting # with '#' will be ignored, and an empty message aborts the commit. # On branch master-# Your branch is up-to-date with 'origin/master'.+# Your branch is ahead of 'origin/master' by 1 commit.+#   (use "git push" to publish your local commits) # # Changes to be committed:-#	modified:   Utils.hs+#	modified:   template-haskell-util.cabal #
.git/COMMIT_EDITMSG~ view
@@ -2,8 +2,9 @@ # Please enter the commit message for your changes. Lines starting # with '#' will be ignored, and an empty message aborts the commit. # On branch master-# Your branch is up-to-date with 'origin/master'.+# Your branch is ahead of 'origin/master' by 1 commit.+#   (use "git push" to publish your local commits) # # Changes to be committed:-#	modified:   Utils.hs+#	modified:   template-haskell-util.cabal #
.git/index view

binary file changed (440 → 440 bytes)

.git/logs/HEAD view
@@ -6,3 +6,5 @@ 084a706a37d6164dfb1fab5dcd4e098bcdfe0ffa 9d75ddda94952b2353bcb98b30ffa96708137edb HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424591499 +0800	commit: delete somefiles 9d75ddda94952b2353bcb98b30ffa96708137edb 3bc5e4c57a4d26371071febf2c9201f648327754 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424591528 +0800	commit: update on some functions 3bc5e4c57a4d26371071febf2c9201f648327754 9f2a3202024981da42b4521ac1ade80ad3d7b546 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424932625 +0800	commit: add some functions+9f2a3202024981da42b4521ac1ade80ad3d7b546 5f1699dd4e3d55b4caa1e57011c3532da41e3399 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424945343 +0800	commit: added print functions+5f1699dd4e3d55b4caa1e57011c3532da41e3399 01a44973c56cb3b89b9b94d32e0674fb4139b519 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424945392 +0800	commit: cabal file update
.git/logs/refs/heads/master view
@@ -6,3 +6,5 @@ 084a706a37d6164dfb1fab5dcd4e098bcdfe0ffa 9d75ddda94952b2353bcb98b30ffa96708137edb HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424591499 +0800	commit: delete somefiles 9d75ddda94952b2353bcb98b30ffa96708137edb 3bc5e4c57a4d26371071febf2c9201f648327754 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424591528 +0800	commit: update on some functions 3bc5e4c57a4d26371071febf2c9201f648327754 9f2a3202024981da42b4521ac1ade80ad3d7b546 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424932625 +0800	commit: add some functions+9f2a3202024981da42b4521ac1ade80ad3d7b546 5f1699dd4e3d55b4caa1e57011c3532da41e3399 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424945343 +0800	commit: added print functions+5f1699dd4e3d55b4caa1e57011c3532da41e3399 01a44973c56cb3b89b9b94d32e0674fb4139b519 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424945392 +0800	commit: cabal file update
.git/logs/refs/remotes/origin/master view
@@ -4,3 +4,4 @@ be3fb7a2051f825f8d2a8b3d299a604abf2b5244 084a706a37d6164dfb1fab5dcd4e098bcdfe0ffa HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424587175 +0800	update by push 084a706a37d6164dfb1fab5dcd4e098bcdfe0ffa 3bc5e4c57a4d26371071febf2c9201f648327754 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424591608 +0800	update by push 3bc5e4c57a4d26371071febf2c9201f648327754 9f2a3202024981da42b4521ac1ade80ad3d7b546 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424932730 +0800	update by push+9f2a3202024981da42b4521ac1ade80ad3d7b546 01a44973c56cb3b89b9b94d32e0674fb4139b519 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424945432 +0800	update by push
+ .git/objects/01/a44973c56cb3b89b9b94d32e0674fb4139b519 view
@@ -0,0 +1,3 @@+x­Î=Â0@aæœÂ;R7qÁBŒìllnâЊ´©J¸??â¬ßðôB™¦±BÛùM]U	GV+Øc׳Mœ¼SÞÒNuESrÈf‘Uç+”°cŽÑ«‹D½"¨´³ˆÁ‘k£xT瘍<ëPV8Ëã®9_™o—2ßàð“æKÍÇNC©“Œ¹	e:úÖ³'Ç-líÞZóÖ÷rÕ¿ÄL^2¤1+<—(UÍIVB
+ .git/objects/06/14f36be9b51319da5697bdeb915abdeef87598 view

binary file changed (absent → 52 bytes)

+ .git/objects/08/2597fc126f447143f810f32ce83938409c4055 view

binary file changed (absent → 49 bytes)

+ .git/objects/14/cc1d44e537fa8f1f5f188c77de2de18c399dd8 view

binary file changed (absent → 50 bytes)

+ .git/objects/1d/c0ca8607b48e6eb1ef35d1a875020bad45711b view

binary file changed (absent → 198 bytes)

+ .git/objects/1e/427715ecf5a13ab5e0dd5148343b3c5c85ede3 view

binary file changed (absent → 45 bytes)

+ .git/objects/4e/5006d92e85b87d8f4d74bcc32eb6533505ce5e view

binary file changed (absent → 3596 bytes)

+ .git/objects/5f/1699dd4e3d55b4caa1e57011c3532da41e3399 view

binary file changed (absent → 179 bytes)

+ .git/objects/95/1c9d9e5c1b16b90f9f43e97c5e6ee8daeff319 view

binary file changed (absent → 199 bytes)

+ .git/objects/d1/f000c134b3b213d6a4be1bd79e2ae3bd7fe8de view

binary file changed (absent → 555 bytes)

.git/refs/heads/master view
@@ -1,1 +1,1 @@-9f2a3202024981da42b4521ac1ade80ad3d7b546+01a44973c56cb3b89b9b94d32e0674fb4139b519
.git/refs/remotes/origin/master view
@@ -1,1 +1,1 @@-9f2a3202024981da42b4521ac1ade80ad3d7b546+01a44973c56cb3b89b9b94d32e0674fb4139b519
src/Language/Haskell/TH/Utils.hs view
@@ -1,4 +1,17 @@-{-# LANGUAGE TemplateHaskell  #-}
+{-# LANGUAGE TemplateHaskell , DeriveGeneric,StandaloneDeriving, TypeFamilies,UndecidableInstances, MagicHash #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Language.Haskell.TH.Utils
+-- Copyright   :  None
+-- License     :  MIT (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  Haskell.Zhang.Song@hotmail.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- Some auxiliary functions that might be needed when using template Haskell
+--
+-----------------------------------------------------------------------------
 
 module Language.Haskell.TH.Utils(
        appExp, appExp',
@@ -11,37 +24,199 @@        getTypeNames,
        getTVBName ,
        getCompositeType,getConName,
-       seqTuple2, seqTuple3,seqTuple4, 
+       seqTup2, seqTup3,seqTup4, 
        rename, rename', rename'',
-       nameToExp, printQ
+       nameToExp, 
+       printQ, pprintQ, printiQ, printi,
+       -- | exported GenericPretty package
+       module Text.PrettyPrint.GenericPretty
 )
 where
 
 import Language.Haskell.TH
-import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Lib hiding (Role)
 import Data.List (foldl1,foldr1)
 import Control.Monad
 import Language.Haskell.TH.Syntax
+import Text.PrettyPrint.GenericPretty
+import GHC.Generics hiding (Fixity)
+import GHC.Word
+import GHC.Types
 
+-- sorry for the following messy, I will write a library to generate empty instances automatically
+instance Out Name
+instance Out Type
+instance Out TyVarBndr
+instance Out TyLit
+instance Out Exp
+instance Out Lit
+instance Out Pat
+instance Out Dec
+instance Out Clause
+instance Out FunDep
+instance Out Foreign
+instance Out Fixity
+instance Out Pragma
+instance Out FamFlavour
+instance Out TySynEqn
+instance Out Role
+instance Out Loc
+instance Out Info
+instance Out Module
+instance Out ModuleInfo
+instance Out Strict
+instance Out Callconv
+instance Out Safety
+instance Out Stmt
+instance Out Range
+instance (Generic a,Out a) => Out (TExp a)
+instance Out FixityDirection
+instance Out Match
+instance Out Guard
+instance Out Body
+instance Out ModName
+instance Out NameFlavour
+instance Out Con
+instance Out Inline
+instance Out RuleBndr
+instance Out RuleMatch
+instance Out Pred
+instance Out Phases
+instance Out PkgName
+instance Out OccName
+instance Out AnnTarget
+instance Out Word8
+
+-- sorry for the messy, I will also write a library to do this automatically
+deriving instance Generic FixityDirection
+deriving instance Generic Inline
+deriving instance Generic RuleBndr
+deriving instance Generic Match
+deriving instance Generic Name
+deriving instance Generic RuleMatch
+deriving instance Generic Pred
+deriving instance Generic Phases
+deriving instance Generic Con
+deriving instance Generic Module
+deriving instance Generic AnnTarget
+deriving instance Generic Type
+deriving instance Generic TyVarBndr
+deriving instance Generic TyLit
+deriving instance Generic Exp
+deriving instance Generic Lit
+deriving instance Generic Pat
+deriving instance Generic Dec
+deriving instance Generic Clause
+deriving instance Generic FunDep
+deriving instance Generic Foreign
+deriving instance Generic Fixity
+deriving instance Generic Pragma
+deriving instance Generic FamFlavour
+deriving instance Generic TySynEqn
+deriving instance Generic Role
+deriving instance Generic Loc
+deriving instance Generic Info
+deriving instance Generic ModuleInfo
+deriving instance Generic Strict
+deriving instance Generic Callconv 
+deriving instance Generic Safety
+deriving instance Generic Stmt
+deriving instance Generic Range 
+deriving instance Generic a => Generic (TExp a)
+deriving instance Generic Guard 
+deriving instance Generic Body
+deriving instance Generic ModName
+deriving instance Generic PkgName
+deriving instance Generic OccName
+
+data C_Word8
+data D_Word8
+
+instance Datatype D_Word8 where
+  datatypeName _ = "Word"
+  moduleName   _ = "GHC.Word"
+instance Constructor C_Word8 where
+  conName _ = ""
+
+deriving instance Generic NameSpace
+instance Out NameSpace 
+
+instance Generic Word8 where
+  type Rep Word8 = D1 D_Word8 (C1 C_Word8 (S1 NoSelector (Rec0 Word8)))
+  from x = M1 (M1 (M1 (K1 x)))
+  to (M1 (M1 (M1 (K1 x)))) = x
+
+-- This is bacause GHC 7.8 does not support unboxed value to be made into Generic
+instance Generic NameFlavour where
+  type Rep NameFlavour = (Rep NameFlavour')
+  from (NameS) = from NameS'
+  from (NameQ m) = from (NameQ' m)
+  from (NameU i) = from (NameU' (I# i))
+  from (NameL i) = from (NameL' (I# i))
+  from (NameG ns p m) = from (NameG' ns p m)
+  to M1 {unM1 = L1 (L1 (M1 {unM1 = U1}))} = NameS
+  to M1 {unM1 = L1 (R1 (M1 {unM1 = M1 {unM1 = K1 {unK1 = ModName mn }}}))} =  NameQ (ModName mn)
+  to M1 {unM1 = R1 (L1 (M1 {unM1 = M1 {unM1 = K1 {unK1 = (I# n)}}}))} = NameU n
+  to M1 {unM1 = R1 (R1 (L1 (M1 {unM1 = M1 {unM1 = K1 {unK1 = (I# n)}}})))} = NameL n
+  to M1 {unM1 = R1 (R1 (R1 (M1 {unM1 = M1 {unM1 = K1 {unK1 = ns}} :*: (M1 {unM1 = K1 {unK1 = PkgName p}} :*: M1 {unM1 = K1 {unK1 = ModName m}})})))} = NameG ns (PkgName p) (ModName m)
+
+data NameFlavour' = NameS' 
+                  | NameQ' ModName 
+                  | NameU' Int 
+                  | NameL' Int 
+                  | NameG' NameSpace PkgName ModName
+                    deriving (Generic,Show)
+
+deriving instance Show NameSpace
+
 -- | Pretty print spliced code
 pprintQ :: Ppr a => Q a -> IO ()
 pprintQ q = runQ q >>= putStrLn.pprint
 
--- | Print AST
+-- | Print AST with indentions. There are also other exported functions from genericpretty library. See 'Out'.
+{-|
+> runQ [| (1+1) * 5|] >>= pp -- or use
+> printiQ  [| (1+1) * 5|]
+InfixE (Just InfixE (Just LitE (IntegerL 1))
+                    (VarE (Name (OccName "+")
+                                (NameG' VarName
+                                        (PkgName "base")
+                                        (ModName "GHC.Num"))))
+                    (Just LitE (IntegerL 1)))
+       (VarE (Name (OccName "*")
+                   (NameG' VarName
+                           (PkgName "base")
+                           (ModName "GHC.Num"))))
+       (Just LitE (IntegerL 5))
+-}
+printiQ :: Out a => Q a -> IO ()
+printiQ q = runQ q >>= pp
+
+-- | Print AST with identions
+printi :: Out a => a -> IO ()
+printi a = pp a
+
+-- | Print AST of the code.
 printQ :: Show a => Q a -> IO ()
 printQ q = runQ q >>= putStrLn.show
 
 -- | sequence-like functons on tuples
-seqTuple2 :: (Q a, Q b) -> Q (a, b) 
-seqTuple2 (a,b) = liftM2 (,) a b
+seqTup2 :: (Q a, Q b) -> Q (a, b) 
+seqTup2 (a,b) = liftM2 (,) a b
 
-seqTuple3 :: (Q a, Q b, Q c) -> Q (a, b, c)
-seqTuple3 (a,b,c) = liftM3 (,,) a b c
+seqTup3 :: (Q a, Q b, Q c) -> Q (a, b, c)
+seqTup3 (a,b,c) = liftM3 (,,) a b c
 
-seqTuple4 :: (Q a, Q b, Q c, Q d) -> Q (a, b, c, d)
-seqTuple4 (a,b,c,d) = liftM4 (,,,) a b c d
+seqTup4 :: (Q a, Q b, Q c, Q d) -> Q (a, b, c, d)
+seqTup4 (a,b,c,d) = liftM4 (,,,) a b c d
 
 -- | Rename a 'Name'
+rename :: Q Name -> (String -> String) -> Q Name
+rename n f = do
+         bn <- n
+         let nameStr = f $ nameBase bn
+         return $ mkName nameStr
+
 rename' :: Name -> (String -> String) -> Name
 rename' n f = mkName $ f $ nameBase n
 
@@ -50,18 +225,11 @@           let nameStr = f $ nameBase n
           return $ mkName nameStr
 
-rename :: Q Name -> (String -> String) -> Q Name
-rename n f = do
-         bn <- n
-         let nameStr = f $ nameBase bn
-         return $ mkName nameStr
-
 {-|
 > data Foo = Foo { foo :: Int }
 > > $(nameToExp (++"1") 'foo)
 > "foo1"       
 -}
-
 nameToExp :: (String -> String) -- ^ Function to change name. 
              -> Name 
              -> Q Exp 
@@ -72,15 +240,19 @@ conNameExp = litE . stringL . nameBase . getConName
 
 -- | Apply a list of expression
--- | > [(+), 1, 2] to (+) 1 2
+{-|
+> [(+), 1, 2] to (+) 1 2
+> appExp' [VarE '(+) , (LitE (IntegerL 1)), (LitE (IntegerL 2))]
+> >AppE (AppE (VarE GHC.Num.+) (LitE (IntegerL 1))) (LitE (IntegerL 2))
+-}
+
 appExp :: [ExpQ] -> ExpQ
 appExp = appsE
 
 appExp' :: [Exp] -> Exp
 appExp' = foldl1 AppE
 
--- | Apply a type constructor
--- | > convert [a, b, c] to a b c like 'appExp'
+-- | Apply a type constructor like 'appExp'
 
 {-|
 > > pprint $ appConT' (map ConT [''(,), ''Int , ''Bool])
@@ -117,6 +289,7 @@            typ <- sequence $ map (return.varT.mkName) ns
            return (tvb,typ)
 
+-- | Generate a list of type Bind and Type without Q
 genBT' :: String -> Int -> ([TyVarBndr], [Type])
 genBT' name n = let ns = [name++ (show i) | i <- [1..n]] 
                     in (map (plainTV.mkName) ns, map (VarT . mkName) ns)
@@ -126,7 +299,7 @@ > ([VarP a1,VarP a2,VarP a3],[VarE a1,VarE a2,VarE a3])
 -}
 
--- | Related patterns and expressions
+-- | Generate related patterns and expressions
 genPE :: String -> Int -> Q ([PatQ],[ExpQ])
 genPE name n = do 
            let ns = [name++ (show i) | i <- [1..n]]
@@ -134,6 +307,7 @@            exp <- sequence $ map (return.varE.mkName) ns
            return (pat,exp)
 
+-- | Generate related patterns and expressions without Q
 genPE' :: String -> Int -> ([Pat], [Exp])
 genPE' name n = let ns = [name++ (show i) | i <- [1..n]] 
                  in (map (VarP . mkName) ns,map (VarE . mkName) ns)
@@ -142,7 +316,7 @@ appKinds :: [Kind] -> Kind
 appKinds = foldr1 AppT
 
--- | > convert [k1,k2,k3] to k1 -> k2 -> k3,like 'curryType'
+-- | Like 'curryType' but on kind level
 curryKind :: [Kind] -> Kind
 curryKind =  curryType'
 
@@ -174,7 +348,4 @@ getCompositeType (InfixC st1 n st2)     = concatMap getTypeNames [snd st1 , snd st2]
 -- This could be a problem since it will lose info for context and type variables 
 getCompositeType (ForallC tvbs cxt con) = getCompositeType con
-
-
-
template-haskell-util.cabal view
@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/
 
 name:                template-haskell-util
-version:             0.1.0.2
+version:             0.1.0.3
 synopsis:            Some utilities for template Haskell.
 description:         Some functions that might be useful when you use template haskell.
 homepage:            https://github.com/HaskellZhangSong/TemplateHaskellUtils
@@ -22,6 +22,6 @@        Language.Haskell.TH.Utils  		       
   -- other-modules:       
   -- other-extensions:    
-  build-depends:       base ==4.*  , template-haskell >= 2.9
+  build-depends:       base ==4.*  , template-haskell >= 2.9 , GenericPretty >= 1.2.1
   hs-source-dirs:      src
   default-language:    Haskell2010