haskell-reflect (empty) → 0.1
raw patch · 7 files changed
+295/−0 lines, 7 filesdep +MonadCatchIO-mtldep +basedep +containerssetup-changed
Dependencies added: MonadCatchIO-mtl, base, containers, haskell-reflect, hint, mtl, parsec, template-haskell, transformers
Files
- LICENSE +18/−0
- Setup.hs +4/−0
- haskell-reflect.cabal +54/−0
- src/Language/Haskell/Reflect.hs +114/−0
- src/Language/Haskell/Reflect/Types.hs +60/−0
- src/Language/Haskell/Reflect/Utils.hs +24/−0
- src/main.hs +21/−0
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,4 @@+import Distribution.Simple++main = defaultMain+
+ haskell-reflect.cabal view
@@ -0,0 +1,54 @@+name: haskell-reflect+version: 0.1++license: MIT+license-file: LICENSE++author: Julian Fleischer <julian.fleischer@fu-berlin.de>+maintainer: Julian Fleischer <julian.fleischer@fu-berlin.de>++stability: experimental+category: Haskell++cabal-version: >= 1.8++synopsis: Reflect Haskell types.+description: Reflect Haskell types.+build-type: Simple++Source-Repository head+ type: darcs+ location: http://hub.darcs.net/scravy/haskell-reflect++Library+ build-depends: base >= 4.5 && < 5+ , containers >= 0.4.2.1+ , mtl >= 2.1.1+ , transformers >= 0.3+ , hint >= 0.3.3.4+ , parsec >= 3.1.2+ , template-haskell >= 2.7+ , MonadCatchIO-mtl++ hs-source-dirs: src++ exposed-modules: Language.Haskell.Reflect,+ Language.Haskell.Reflect.Types,+ Language.Haskell.Reflect.Utils++Executable hsreflect+ build-depends: base >= 4.5 && < 5+ , haskell-reflect+ , containers >= 0.4.2.1+ , mtl >= 2.1.1+ , transformers >= 0.3+ , hint >= 0.3.3.4+ , parsec >= 3.1.2+ , template-haskell >= 2.7+ , MonadCatchIO-mtl+++ hs-source-dirs: src+ main-is: main.hs++
+ src/Language/Haskell/Reflect.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE Haskell2010+ , TupleSections+ #-}+{-# OPTIONS+ -Wall+ -fno-warn-name-shadowing+ #-}++module Language.Haskell.Reflect where++import Prelude++import Data.Either+import Data.Map (Map)+import qualified Data.Map as Map++import Control.Monad+import qualified Control.Monad.CatchIO as C+import qualified Control.Monad.Error as E++import Language.Haskell.Interpreter+import Language.Haskell.Reflect.Types+++reflectModules :: (Functor m, C.MonadCatchIO m)+ => [String] -> m (Map String InterpreterError, Map String HModule)+reflectModules names = do+ result <- runInterpreter $ do+ set [ installedModulesInScope := True+ , languageExtensions := [TemplateHaskell, MagicHash] ]++ let browseModule name = E.catchError+ (getModuleExports name >>= return . Right . (name,))+ (return . Left . (name,))++ emptyModule name = HModule {+ moduleName = name,+ moduleFunctions = Map.empty,+ moduleTypeclasses = Map.empty,+ moduleDatatypes = Map.empty+ }++ reflectModule (modName, elems) = do+ reflectedElems <- foldM reflectElems (emptyModule modName) elems+ return (modName, reflectedElems)+ where+ reflectElems mod elem = case elem of+ Fun name -> do+ func <- reflectFun name+ return $ mod {+ moduleFunctions = (Map.insert name func (moduleFunctions mod))+ }+ Class name members -> do+ clazz <- reflectClass name members+ return $ mod {+ moduleTypeclasses = (Map.insert name clazz (moduleTypeclasses mod))+ }+ Data name constructors -> do+ data_ <- reflectData name constructors+ return $ mod {+ moduleDatatypes = (Map.insert name data_ (moduleDatatypes mod))+ }++ reflectFun name = do+ signature <- typeOf $ modName ++ "." ++ name+ return $ HFunction {+ functionName = name,+ functionSignature = signature,+ functionType = [],+ functionContext = []+ }++ reflectClass name _members = do+ return $ HTypeclass {+ typeclassName = name,+ typeclassMembers = [],+ typeclassInstances = []+ }++ reflectData name _constructors = do+ kind <- kindOf $ modName ++ "." ++ name+ return $ HDatatype {+ datatypeName = name,+ datatypeKind = kind,+ datatypeConstructors = Map.empty+ }+ + + modules <- mapM browseModule names+ reflectedModules <- mapM reflectModule $ rights modules+ return (Map.fromList $ lefts modules, Map.fromList $ reflectedModules)+ + either C.throw return result+++reflectTypeclasses :: (Functor m, C.MonadCatchIO m)+ => [String] -> m [(String, Maybe HTypeclass)]+reflectTypeclasses names = do+ result <- runInterpreter $ do+ set [ installedModulesInScope := True+ , languageExtensions := [TemplateHaskell, MagicHash] ]+ setImports ["Prelude",+ "Language.Haskell.Reflect.Types",+ "Language.Haskell.Reflect.Utils",+ "Language.Haskell.TH",+ "Language.Haskell.TH.Quote"]+ let query = \name -> "$(reify ''" ++ name+ ++ " >>= typeclassInfo >>= dataToExpQ (const Nothing))"+ doIt q = E.catchError (interpret q (as :: HTypeclass) >>= return . Just)+ (return . const Nothing)+ mapM (doIt . query) names >>= return . zip names+ either C.throw return result++
+ src/Language/Haskell/Reflect/Types.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE Haskell2010+ , DeriveDataTypeable+ , GeneralizedNewtypeDeriving+ #-}+{-# OPTIONS -Wall #-}++module Language.Haskell.Reflect.Types where++import Data.Char+import Data.Data+import Data.Map+import Data.String++data HName = TyVar String | QName String+ deriving (Data, Typeable, Show, Read, Eq, Ord)++instance IsString HName where+ fromString n@(x:_)+ | isUpper x = TyVar n+ | isLower x = QName n+ fromString "" = error "empty name"+ fromString _ = error "not a name"+++data HModule = HModule {+ moduleName :: String,+ moduleFunctions :: Map String HFunction,+ moduleTypeclasses :: Map String HTypeclass,+ moduleDatatypes :: Map String HDatatype+ } deriving (Data, Typeable, Show, Read, Eq)++data HType = HType {+ typeName :: HName,+ typeArgs :: [HType]+ } deriving (Data, Typeable, Show, Read, Eq)++data HFunction = HFunction {+ functionName :: String,+ functionType :: [HType],+ functionSignature :: String,+ functionContext :: [HType]+ } deriving (Data, Typeable, Show, Read, Eq)++data HTypeclass = HTypeclass {+ typeclassName :: String,+ typeclassMembers :: [HFunction],+ typeclassInstances :: [HInstance]+ } deriving (Data, Typeable, Show, Read, Eq)++data HInstance = HInstance {+ } deriving (Data, Typeable, Show, Read, Eq)++data HDatatype = HDatatype {+ datatypeName :: String,+ datatypeKind :: String,+ datatypeConstructors :: Map String HFunction+ } deriving (Data, Typeable, Show, Read, Eq)+++
+ src/Language/Haskell/Reflect/Utils.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE Haskell2010 #-}+{-# OPTIONS -Wall #-}++module Language.Haskell.Reflect.Utils where++import Data.Map++import Language.Haskell.TH+import Language.Haskell.Reflect.Types++typeclassInfo :: Info -> Q HTypeclass+typeclassInfo _ = do+ return $ HTypeclass {+ typeclassName = "",+ typeclassInstances = []+ }++instanceInfo :: Info -> Q HInstance+instanceInfo _ = do+ return $ HInstance++++
+ src/main.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE Haskell2010+ #-}+{-# OPTIONS+ -Wall+ #-}++module Main where++import Prelude+import Language.Haskell.Reflect++import System.Environment+++main :: IO ()+main = getArgs >>= reflectModules >>= print+++++