template-haskell-util 0.1.0.1 → 0.1.0.2

raw patch · 17 files changed

+108/−40 lines, 17 filesbinary-addedPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• .git/COMMIT_EDITMSG +4/−5
• .git/COMMIT_EDITMSG~ +2/−7
• .git/index binary
• .git/logs/HEAD +1/−0
• .git/logs/refs/heads/master +1/−0
• .git/logs/refs/remotes/origin/master +1/−0
• .git/objects/0e/b705ecf8acd3e0faadbf5b8f9223c3f2af7d2f binary
• .git/objects/25/e665418344ac3e22647b09133c46f11764adc7 binary
• .git/objects/35/d3e81042a51a696393d60d9e6091189c807d4f binary
• .git/objects/62/4eb04567b70087227deed14cc2935aa0ff6446 binary
• .git/objects/68/c829d10241779b0f24a4fb2da9c5eb4d41942c binary
• .git/objects/9b/2c7a465fcbdaddb77e0203ea65b458b7c6df31 binary
• .git/objects/9f/2a3202024981da42b4521ac1ade80ad3d7b546 +2/−0
• .git/refs/heads/master +1/−1
• .git/refs/remotes/origin/master +1/−1
• src/Language/Haskell/TH/Utils.hs +94/−25
• template-haskell-util.cabal +1/−1

@@ -1,10 +1,9 @@-+add some functions # 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 ahead of 'origin/master' by 2 commits.-#   (use "git push" to publish your local commits)+# Your branch is up-to-date with 'origin/master'. #-# Untracked files:-#	#README.md#+# Changes to be committed:+#	modified:   Utils.hs #

@@ -2,13 +2,8 @@ # 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 ahead of 'origin/master' by 1 commit.-#   (use "git push" to publish your local commits)+# Your branch is up-to-date with 'origin/master'. # # Changes to be committed:-#	modified:   src/Language/Haskell/TH/Utils.hs-#	modified:   template-haskell-util.cabal-#-# Untracked files:-#	#README.md#+#	modified:   Utils.hs #

binary file changed (440 → 440 bytes)

@@ -5,3 +5,4 @@ be3fb7a2051f825f8d2a8b3d299a604abf2b5244 084a706a37d6164dfb1fab5dcd4e098bcdfe0ffa HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424587127 +0800	commit: update me 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

@@ -5,3 +5,4 @@ be3fb7a2051f825f8d2a8b3d299a604abf2b5244 084a706a37d6164dfb1fab5dcd4e098bcdfe0ffa HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424587127 +0800	commit: update me 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

@@ -3,3 +3,4 @@ d1247d5c2308a73ca68c144ce67b060d3023b385 be3fb7a2051f825f8d2a8b3d299a604abf2b5244 HaskellZhangSong <Haskell.Zhang.Song@hotmail.com> 1424587031 +0800	update by push 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

binary file changed (absent → 52 bytes)

binary file changed (absent → 1937 bytes)

binary file changed (absent → 199 bytes)

binary file changed (absent → 50 bytes)

binary file changed (absent → 45 bytes)

binary file changed (absent → 49 bytes)

@@ -0,0 +1,2 @@+x­Î=NÄ0@ajŸbz¤h<þ—Vˆ’žŽnÖo"b%Þû³ Ž@ûO/Ö¶	äÝÓ<DÀ¸b$j´ÄN³OÞ$S<–$“Ö1刡ت¾ø>Á\³›]`[ț 1è*×J9êêm4‚³Šïs¼ñù)ûþ±r¿½~ƒËŸ,¿´üØë:fãm_òh/ -ÙdȓƒgŒˆê¡å)ÿS\+œ£	Ô{ÏsýTߣôTè

@@ -1,1 +1,1 @@-3bc5e4c57a4d26371071febf2c9201f648327754+9f2a3202024981da42b4521ac1ade80ad3d7b546

@@ -1,1 +1,1 @@-3bc5e4c57a4d26371071febf2c9201f648327754+9f2a3202024981da42b4521ac1ade80ad3d7b546

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskell  #-}
+
 module Language.Haskell.TH.Utils(
        appExp, appExp',
        appConT, appConT',
@@ -8,34 +10,94 @@        curryKind,
        getTypeNames,
        getTVBName ,
-       getCompositeType
+       getCompositeType,getConName,
+       seqTuple2, seqTuple3,seqTuple4, 
+       rename, rename', rename'',
+       nameToExp, printQ
 )
 where
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Lib
 import Data.List (foldl1,foldr1)
+import Control.Monad
+import Language.Haskell.TH.Syntax
 
--- | Apply a list of expression, [(+), 1, 2] to (+) 1 2
+-- | Pretty print spliced code
+pprintQ :: Ppr a => Q a -> IO ()
+pprintQ q = runQ q >>= putStrLn.pprint
+
+-- | Print AST
+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
+
+seqTuple3 :: (Q a, Q b, Q c) -> Q (a, b, c)
+seqTuple3 (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
+
+-- | Rename a 'Name'
+rename' :: Name -> (String -> String) -> Name
+rename' n f = mkName $ f $ nameBase n
+
+rename'' :: Name -> (String -> String) -> Q Name
+rename'' n f = do
+          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 
+nameToExp f = litE . stringL . f . nameBase 
+
+-- | Makes a string literal expression from a constructor's name. 
+conNameExp :: Con -> Q Exp 
+conNameExp = litE . stringL . nameBase . getConName
+
+-- | Apply a list of expression
+-- | > [(+), 1, 2] to (+) 1 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
+-- | > convert [a, b, c] to a b c like 'appExp'
+
+{-|
+> > pprint $ appConT' (map ConT [''(,), ''Int , ''Bool])
+> "GHC.Tuple.(,) GHC.Types.Int GHC.Types.Bool" --i.e. (Int,Bool)
+-}
+
 appConT :: [TypeQ] -> TypeQ
 appConT = foldl1 appT
 
 appConT' :: [Type] -> Type
 appConT' = foldl1 AppT
 
+-- | > convert [a, b, c] to a -> b -> c
 {-|
-> > pprint $ appConT' (map ConT [''(,), ''Int , ''Bool])
-> "GHC.Tuple.(,) GHC.Types.Int GHC.Types.Bool"
-|-}
-
--- | convert [a, b, c] to a -> b -> c
+> > pprint $ curryType' (map ConT [''Int , ''Int , ''Bool])
+> "GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Bool"
+-}
 curryType :: [TypeQ] -> TypeQ
 curryType  = foldr1 (\t1 -> appT (appT arrowT t1))
 
@@ -43,9 +105,9 @@ curryType' = foldr1 (\t1 -> AppT (AppT ArrowT t1))
 
 {-|
-> > pprint $ curryType' (map ConT [''Int , ''Int , ''Bool])
-> "GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Bool"
-|-}
+> > genBT' "a" 3
+> ([PlainTV a1,PlainTV a2,PlainTV a3],[VarT a1,VarT a2,VarT a3])
+-}
 
 -- | Generate a list of type Bind and Type
 genBT :: String -> Int -> Q ([TyVarBndr], [TypeQ])
@@ -60,11 +122,11 @@                     in (map (plainTV.mkName) ns, map (VarT . mkName) ns)
 
 {-|
-> > genBT' "a" 3
-> ([PlainTV a1,PlainTV a2,PlainTV a3],[VarT a1,VarT a2,VarT a3])
-|-}
-       
--- | Pattern and expression
+> > genPE' "a" 3
+> ([VarP a1,VarP a2,VarP a3],[VarE a1,VarE a2,VarE a3])
+-}
+
+-- | Related patterns and expressions
 genPE :: String -> Int -> Q ([PatQ],[ExpQ])
 genPE name n = do 
            let ns = [name++ (show i) | i <- [1..n]]
@@ -75,37 +137,44 @@ 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)
-{-|
-> > genPE' "a" 3
-> ([VarP a1,VarP a2,VarP a3],[VarE a1,VarE a2,VarE a3])
-|-}
--- | Apply a list of kinds
+
+-- | Apply a list of kinds, like 'appConT'
 appKinds :: [Kind] -> Kind
 appKinds = foldr1 AppT
 
--- | convert [k1,k2,k3] to k1 -> k2 -> k3,like 'curryType'
+-- | > convert [k1,k2,k3] to k1 -> k2 -> k3,like 'curryType'
 curryKind :: [Kind] -> Kind
 curryKind =  curryType'
 
--- | get type Names recursively
+-- | Get name from constructors
+getConName :: Con -> Name 
+getConName (NormalC name _)  = name 
+getConName (RecC name _)     = name 
+getConName (InfixC _ name _) = name 
+getConName (ForallC _ _ con) = getConName con 
+
+-- | Get type Names recursively
 getTypeNames :: Type -> [Name]
 getTypeNames (ForallT tvbs cxt t) = getTypeNames t
 getTypeNames (ConT n) = [n]
 getTypeNames (AppT t1 t2) = getTypeNames t1 ++ getTypeNames t2
 getTypeNames _ = []
 
--- | get type var bind name
+-- | Get type var bind name
 getTVBName :: TyVarBndr -> Name
 getTVBName (PlainTV  name  ) = name
 getTVBName (KindedTV name _) = name
 
 third (a,b,c) = c
 
--- | get all names recursively from a constructor
+-- | Get all names recursively from a constructor
 getCompositeType :: Con -> [Name]
 getCompositeType (NormalC n sts)        = concatMap getTypeNames (map snd sts)
 getCompositeType (RecC    n vars)       = concatMap getTypeNames (map third vars)
 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
+
+
+
 

@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/
 
 name:                template-haskell-util
-version:             0.1.0.1
+version:             0.1.0.2
 synopsis:            Some utilities for template Haskell.
 description:         Some functions that might be useful when you use template haskell.
 homepage:            https://github.com/HaskellZhangSong/TemplateHaskellUtils