{-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Precis.ModuleProperties -- Copyright : (c) Stephen Tetley 2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley -- Stability : highly unstable -- Portability : to be determined. -- -- -- -------------------------------------------------------------------------------- module Precis.ModuleProperties ( PackageModulesProp , packageModulesProp , PackageModulesList(..) , diffPackageModulesProps , ExposedModulesProp , exposedModulesProp , ExposedModulesList , diffExposedModulesProps -- , ExportsProp , exportsProp , diffExportsProps -- , InstancesProp , instancesProp , diffInstancesProps -- , DataDeclsProp , dataDeclsProp , diffDataDeclsProps , TypeSigsProp , typeSigsProp , diffTypeSigsProps ) where import Precis.Datatypes import Precis.HsSrcUtils import Precis.Properties import Language.Haskell.Exts hiding ( name, op ) -- package: haskell-src-exts import Data.Maybe ( catMaybes ) -------------------------------------------------------------------------------- -- all modules (exposed and internal) in a cabal file type PackageModulesProp = Property PackageModulesList data PackageModulesList = PackageModulesList { public_modules :: [StrName] , private_modules :: [StrName] } deriving (Eq,Show) makePackageModulesProp :: PackageModulesList -> PackageModulesProp makePackageModulesProp = Property name descr where name = "Modules list" descr = "Lists of exposed and internal modules in a package." packageModulesProp :: CabalPrecis -> PackageModulesProp packageModulesProp = makePackageModulesProp . packageModulesList packageModulesList :: CabalPrecis -> PackageModulesList packageModulesList cp = PackageModulesList expos privs where expos = map sourceFileName $ exposed_modules cp privs = map sourceFileName $ internal_modules cp diffPackageModulesProps :: PackageModulesProp -> PackageModulesProp -> ([Edit StrName],[Edit StrName]) diffPackageModulesProps = diffProperty cmp where cmp :: PackageModulesList -> PackageModulesList -> ([Edit StrName],[Edit StrName]) cmp (PackageModulesList expos privs) (PackageModulesList expos' privs') = (xs,ys) where xs = difference (==) (/=) expos expos' ys = difference (==) (/=) privs privs' -------------------------------------------------------------------------------- -- exposed modules in cabal file type ExposedModulesProp = Property ExposedModulesList type ExposedModulesList = [SourceFile] makeExposedModulesProp :: ExposedModulesList -> ExposedModulesProp makeExposedModulesProp = Property name descr where name = "Exposed modules" descr = "Exposed modules (with paths) in a package." exposedModulesProp :: CabalPrecis -> ExposedModulesProp exposedModulesProp = makeExposedModulesProp . exposed_modules diffExposedModulesProps :: ExposedModulesProp -> ExposedModulesProp -> [Edit SourceFile] diffExposedModulesProps = diffProperty cmp where cmp :: ExposedModulesList -> ExposedModulesList -> [Edit SourceFile] cmp es1 es2 = difference (lift2a (==)) (/=) es1 es2 lift2a :: (StrName -> StrName -> b) -> SourceFile -> SourceFile -> b lift2a op s1 s2 = sourceFileName s1 `op` sourceFileName s2 -------------------------------------------------------------------------------- -- export lists type ExportsProp = Property ExportsList makeExportsProp :: ExportsList -> ExportsProp makeExportsProp = Property name descr where name = "Module exports" descr = "Explicit exports from a module (class instances not counted)." type ExportsList = [ExportItem] exportsProp :: Module -> ExportsProp exportsProp modu = makeExportsProp (exportsList modu) exportsList :: Module -> ExportsList exportsList (Module _ _ _ _ mb_expos _ _) = maybe [] (map makeExportItem) mb_expos makeExportItem :: ExportSpec -> ExportItem makeExportItem (EModuleContents name) = ModuleExport $ extractModuleName name makeExportItem (EVar name) = Variable $ extractQName name makeExportItem s@(EAbs name) = DataOrClass (extractQName name) (prettyPrint s) makeExportItem s@(EThingAll name) = DataOrClass (extractQName name) (prettyPrint s) makeExportItem s@(EThingWith name _) = DataOrClass (extractQName name) (prettyPrint s) diffExportsProps :: ExportsProp -> ExportsProp -> [Edit ExportItem] diffExportsProps = diffProperty cmp where cmp :: ExportsList -> ExportsList -> [Edit ExportItem] cmp es1 es2 = difference (lift2a (==)) (/=) es1 es2 lift2a :: (StrName -> StrName -> b) -> ExportItem -> ExportItem -> b lift2a op s1 s2 = exportItemName s1 `op` exportItemName s2 -------------------------------------------------------------------------------- -- class instances type InstancesProp = Property InstancesList makeInstancesProp :: InstancesList -> InstancesProp makeInstancesProp = Property name descr where name = "Instance declarations" descr = "Instance declarations defined in the module." type InstancesList = [InstanceDecl] instancesProp :: Module -> InstancesProp instancesProp modu = makeInstancesProp (instancesList modu) instancesList :: Module -> InstancesList instancesList (Module _ _ _ _ _ _ ds) = catMaybes $ map makeInstanceDecl ds makeInstanceDecl :: Decl -> Maybe InstanceDecl makeInstanceDecl d@(InstDecl _ _ name typs _) = Just $ InstanceDecl (extractQName name) (hsppList typs) (prettyPrint d) makeInstanceDecl _ = Nothing -- compare instances on class name and text rep of type -- type InstanceKey = (StrName,TextRep) instanceKey :: InstanceDecl -> InstanceKey instanceKey (InstanceDecl s k _) = (s,k) diffInstancesProps :: InstancesProp -> InstancesProp -> [Edit InstanceDecl] diffInstancesProps = diffProperty cmp where cmp :: InstancesList -> InstancesList -> [Edit InstanceDecl] cmp xs1 xs2 = difference (lift2a (==)) (/=) xs1 xs2 lift2a :: (InstanceKey -> InstanceKey -> b) -> InstanceDecl -> InstanceDecl -> b lift2a op s1 s2 = instanceKey s1 `op` instanceKey s2 -------------------------------------------------------------------------------- -- exported data types (regular and GADTS) type DataDeclsProp = Property DataDeclsList makeDataDeclsProp :: DataDeclsList -> DataDeclsProp makeDataDeclsProp = Property name descr where name = "Exported data declarations" descr = "Data declarations exported from exposed modules." type DataDeclsList = [DatatypeDecl] dataDeclsProp :: Module -> DataDeclsProp dataDeclsProp modu = makeDataDeclsProp (dataDeclsList modu) dataDeclsList :: Module -> DataDeclsList dataDeclsList (Module _ _ _ _ mb_expo _ ds) = filterDatatypes mb_expo all_datas where all_datas = catMaybes $ map makeDatatypeDecl ds makeDatatypeDecl :: Decl -> Maybe DatatypeDecl makeDatatypeDecl d@(DataDecl _ _ _ name _ _ _) = Just $ DatatypeDecl (extractName name) (prettyPrint d) makeDatatypeDecl d@(GDataDecl _ _ _ name _ _ _ _) = Just $ DatatypeDecl (extractName name) (prettyPrint d) makeDatatypeDecl _ = Nothing filterDatatypes :: Maybe [ExportSpec] -> [DatatypeDecl] -> [DatatypeDecl] filterDatatypes Nothing xs = xs filterDatatypes (Just expos) xs = filter fn xs where fn (DatatypeDecl n _) = n `elem` expo_vars expo_vars = catMaybes $ map mkExpoT expos mkExpoT (EAbs n) = Just $ extractQName n mkExpoT (EThingAll n) = Just $ extractQName n mkExpoT (EThingWith n _) = Just $ extractQName n mkExpoT _ = Nothing diffDataDeclsProps :: DataDeclsProp -> DataDeclsProp -> [Edit DatatypeDecl] diffDataDeclsProps = diffProperty cmp where cmp :: DataDeclsList -> DataDeclsList -> [Edit DatatypeDecl] cmp xs1 xs2 = difference (lift2a (==)) (/=) xs1 xs2 lift2a :: (StrName -> StrName -> b) -> DatatypeDecl -> DatatypeDecl -> b lift2a op s1 s2 = datatypeDeclName s1 `op` datatypeDeclName s2 -------------------------------------------------------------------------------- -- exported type sigs type TypeSigsProp = Property TypeSigsList makeTypeSigsProp :: TypeSigsList -> TypeSigsProp makeTypeSigsProp = Property name descr where name = "Exported type signatures" descr = unwords [ "Type signatures of functions, constants... exported" , "from exposed modules."] type TypeSigsList = [TypeSigDecl] typeSigsProp :: Module -> TypeSigsProp typeSigsProp modu = makeTypeSigsProp (typeSigsList modu) typeSigsList :: Module -> TypeSigsList typeSigsList (Module _ _ _ _ mb_expo _ ds) = filterTypeSigs mb_expo all_typesigs where all_typesigs = concat $ map makeTypeSigDecl ds makeTypeSigDecl :: Decl -> [TypeSigDecl] makeTypeSigDecl (TypeSig _ ns t) = map fn ns where fn n = TypeSigDecl (extractName n) (prettyPrint t) makeTypeSigDecl _ = [] filterTypeSigs :: Maybe [ExportSpec] -> [TypeSigDecl] -> [TypeSigDecl] filterTypeSigs Nothing xs = xs filterTypeSigs (Just expos) xs = filter fn xs where fn (TypeSigDecl n _) = n `elem` expo_vars expo_vars = catMaybes $ map mkExpoT expos mkExpoT (EVar n) = Just $ extractQName n mkExpoT _ = Nothing diffTypeSigsProps :: TypeSigsProp -> TypeSigsProp -> [Edit TypeSigDecl] diffTypeSigsProps = diffProperty cmp where cmp :: TypeSigsList -> TypeSigsList -> [Edit TypeSigDecl] cmp xs1 xs2 = difference (lift2a (==)) (/=) xs1 xs2 lift2a :: (StrName -> StrName -> b) -> TypeSigDecl -> TypeSigDecl -> b lift2a op s1 s2 = typeSigDeclName s1 `op` typeSigDeclName s2