precis 0.4.0 → 0.5.0
raw patch · 25 files changed
+1527/−951 lines, 25 files
Files
- precis.cabal +35/−15
- src/CPP.hs +1/−1
- src/Main.hs +10/−13
- src/Precis/Cabal.hs +51/−0
- src/Precis/Cabal/CabalPackage.hs +180/−0
- src/Precis/Cabal/Datatypes.hs +81/−0
- src/Precis/Cabal/InterimDatatypes.hs +183/−0
- src/Precis/Cabal/ResolveM.hs +243/−0
- src/Precis/CabalPackage.hs +0/−181
- src/Precis/Datatypes.hs +0/−163
- src/Precis/Diff.hs +1/−2
- src/Precis/HsSrc/Datatypes.hs +108/−0
- src/Precis/HsSrc/Utils.hs +101/−0
- src/Precis/HsSrcUtils.hs +0/−101
- src/Precis/HtmlReport.hs +33/−29
- src/Precis/ModuleProperties.hs +13/−15
- src/Precis/PPShowS.hs +0/−246
- src/Precis/PathUtils.hs +0/−92
- src/Precis/ReportMonad.hs +16/−8
- src/Precis/TextOutput.hs +20/−6
- src/Precis/Utils.hs +0/−78
- src/Precis/Utils/Common.hs +145/−0
- src/Precis/Utils/ControlOperators.hs +59/−0
- src/Precis/Utils/PPShowS.hs +246/−0
- src/Precis/VersionNumber.hs +1/−1
precis.cabal view
@@ -1,5 +1,5 @@ name: precis-version: 0.4.0+version: 0.5.0 license: OtherLicense license-file: LICENCE copyright: Stephen Tetley <stephen.tetley@gmail.com>@@ -10,11 +10,22 @@ description: Summarize API differences between revisions of Cabal packages. .- Note Precis library is BSD3, Precis executable is LGPL apropos + Precis library is BSD3, Precis executable is LGPL apropos the dependency on CppHs. .+ NOTE for version 0.5.0 - the next version is likely to have + substantial changes. Version 0.5.0 does have a better strategy + to resolve conditional modules, but otherwise it is not a + compelling upgrade. If you have 0.4.0 installed, I recommend + you skip this revision and wait for the next version.+ . CHANGES+ 0.4.0 to 0.5.0 .+ * Major re-organization. Module-to-file resolution substantially+ changed. Should be better for Cabal fines that use condition+ variables.+ . 0.3.1 to 0.4.0 . * Substantial changes to reporting - now a summary is printed@@ -44,22 +55,26 @@ hs-source-dirs: src - exposed-modules: - Precis.CabalPackage,- Precis.Datatypes,+ exposed-modules:+ Precis.Cabal, + Precis.Cabal.CabalPackage,+ Precis.Cabal.Datatypes,+ Precis.Cabal.InterimDatatypes,+ Precis.Cabal.ResolveM, Precis.Diff,- Precis.HsSrcUtils,+ Precis.HsSrc.Datatypes,+ Precis.HsSrc.Utils, Precis.HtmlReport, Precis.ModuleProperties,- Precis.PathUtils,- Precis.PPShowS, Precis.ReportMonad, Precis.StyleSheet, Precis.TextOutput,+ Precis.Utils.Common, + Precis.Utils.ControlOperators,+ Precis.Utils.PPShowS, Precis.VersionNumber other-modules:- Precis.Utils executable precis main-is: Main.hs@@ -68,18 +83,23 @@ other-modules: CPP,- Precis.CabalPackage,- Precis.Datatypes,+ Precis.Cabal,+ Precis.Cabal.CabalPackage,+ Precis.Cabal.Datatypes,+ Precis.Cabal.InterimDatatypes,+ Precis.Cabal.ResolveM, Precis.Diff,- Precis.HsSrcUtils,+ Precis.HsSrc.Datatypes,+ Precis.HsSrc.Utils, Precis.HtmlReport, Precis.ModuleProperties,- Precis.PathUtils,- Precis.PPShowS, Precis.ReportMonad, Precis.StyleSheet, Precis.TextOutput,- Precis.Utils,+ Precis.Utils.Common, + Precis.Utils.ControlOperators,+ Precis.Utils.PPShowS, Precis.VersionNumber+
src/CPP.hs view
@@ -21,7 +21,7 @@ , precisCpphsOptions ) where -import Precis.Datatypes+import Precis.HsSrc.Datatypes import Language.Preprocessor.Cpphs
src/Main.hs view
@@ -16,9 +16,9 @@ module Main where import CPP-import Precis.CabalPackage-import Precis.Datatypes-import Precis.HsSrcUtils+import Precis.Cabal+import Precis.HsSrc.Datatypes+import Precis.HsSrc.Utils import Precis.HtmlReport import Precis.VersionNumber @@ -83,11 +83,10 @@ runCompare :: (Maybe FilePath) -> FilePath -> FilePath -> IO () runCompare mb_out new_cabal_file old_cabal_file = do - ans1 <- extractPrecis new_cabal_file known_extensions- ans2 <- extractPrecis old_cabal_file known_extensions-+ ans1 <- extractPackageInfo new_cabal_file+ ans2 <- extractPackageInfo old_cabal_file case (ans1,ans2) of- (Right new_cp, Right old_cp) -> sk new_cp old_cp+ (Right new_pkg, Right old_pkg) -> sk new_pkg old_pkg (Left err, _) -> precisExitFail 2 $ cabalFileErrorMsg err (_, Left err) -> precisExitFail 2 $ cabalFileErrorMsg err where@@ -96,7 +95,7 @@ Just path -> fullReportHtml path new_cp old_cp -fullReportHtml :: FilePath -> CabalPrecis -> CabalPrecis -> IO ()+fullReportHtml :: FilePath -> Package -> Package -> IO () fullReportHtml out_path new_cp old_cp = do { (my_doc,msg) <- makeFullReport fullParseModule new_cp old_cp ; putStrLn $ msg@@ -104,7 +103,7 @@ } -shortReport :: CabalPrecis -> CabalPrecis -> IO ()+shortReport :: Package -> Package -> IO () shortReport new_cp old_cp = do { msg <- makeShortReport fullParseModule new_cp old_cp ; putStrLn $ msg@@ -112,10 +111,8 @@ -- | macro-expand and parse ---fullParseModule :: SourceFile -> IO (Either ModuleParseError Module)-fullParseModule (UnresolvedFile name) = - return $ Left $ ERR_MODULE_FILE_MISSING name-fullParseModule (SourceFile _ file_name) = do+fullParseModule :: HsSourceFile -> IO (Either ModuleParseError Module)+fullParseModule (HsSourceFile _ file_name) = do mx_src <- preprocessFile precisCpphsOptions file_name return $ readModule mx_src
+ src/Precis/Cabal.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Cabal+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Import module for Cabal libs+--+--------------------------------------------------------------------------------+++module Precis.Cabal+ (+ module Precis.Cabal.Datatypes+ , ModName+ , getModName++ , extractPackageInfo++ ) where++import Precis.Cabal.CabalPackage +import Precis.Cabal.Datatypes+import Precis.Cabal.InterimDatatypes+import Precis.Cabal.ResolveM++import Control.Monad+ +extractPackageInfo :: FilePath -> IO (Either CabalFileError Package)+extractPackageInfo path = + extractPrecis path >>= \ans -> + case ans of + Left err -> return $ Left err+ Right precis -> liftM Right $ buildPackage precis++buildPackage :: CabalPrecis -> IO Package+buildPackage precis = resolvePrecis precis known_extensions >>= \(e,i,u) -> + return $ Package { package_name = pkg_name $ precis+ , package_version = pkg_version $ precis+ , exposed_modules = e+ , internal_modules = i+ , unresolved_modules = u+ }+ +
+ src/Precis/Cabal/CabalPackage.hs view
@@ -0,0 +1,180 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Cabal.CabalPackage+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+--+--------------------------------------------------------------------------------+++module Precis.Cabal.CabalPackage + ( + + known_extensions+ , extractPrecis++ ) where++import Precis.Cabal.Datatypes+import Precis.Cabal.InterimDatatypes+import Precis.Utils.Common++import qualified Distribution.Package as D+import qualified Distribution.PackageDescription as D+import qualified Distribution.PackageDescription.Parse as D+import qualified Distribution.Verbosity as D+import qualified Distribution.Version as D++import Control.Monad+import Data.List ( intersperse )+import System.Directory+++-- | File extensions that Precis can handle:+--+-- > ["hs", "lhs"]+--++known_extensions :: [FileExtension]+known_extensions = ["hs", "lhs"]+++extractPrecis :: FilePath -> IO (Either CabalFileError CabalPrecis)+extractPrecis cabal_file =+ doesFileExist cabal_file >>= \exists -> + if exists then extractP cabal_file else cabalFileMissing cabal_file+ +++cabalFileMissing :: FilePath -> IO (Either CabalFileError a)+cabalFileMissing file = return $ Left $ ERR_CABAL_FILE_MISSING file++++extractP :: FilePath -> IO (Either CabalFileError CabalPrecis)+extractP cabal_file =+ liftM sk (safeReadGPD D.normal cabal_file)+ where+ sk = mapRight (buildPrecis cabal_file)++safeReadGPD :: D.Verbosity -> FilePath + -> IO (Either CabalFileError D.GenericPackageDescription)+safeReadGPD verbo path = + catch (liftM Right $ D.readPackageDescription verbo path)+ (\e -> return $ Left $ ERR_CABAL_FILE_PARSE $ show e)+++buildPrecis :: FilePath -> D.GenericPackageDescription -> CabalPrecis+buildPrecis path gpd = + CabalPrecis { pkg_name = getName gpd+ , pkg_version = getVersion gpd+ , path_to_cabal_file = cabalFilePath path+ , cond_libraries = getLibraries gpd+ , cond_exes = getExes gpd+ }++++--------------------------------------------------------------------------------+-- Extract from Package description++getName :: D.GenericPackageDescription -> String+getName = extractNameText . D.package . D.packageDescription ++getVersion :: D.GenericPackageDescription -> String+getVersion = extractVersionText . D.package . D.packageDescription +++-- Getting \"Libraries\" is complicated due to Conditions...+--+-- Here all libraries are extracted, it seems typical that the +-- Library within the PackageDescription is empty.+--+getLibraries :: D.GenericPackageDescription -> [CabalLibrary]+getLibraries gpd = filter (not . emptyLibrary) $ mbCons x xs+ where + x = fmap extractLibrary $ D.library $ D.packageDescription $ gpd+ xs = fmap extractLibrary $ allLibraries $ gpd+++emptyLibrary :: CabalLibrary -> Bool+emptyLibrary (CabalLibrary [] [] []) = True+emptyLibrary _ = False++mbCons :: Maybe a -> [a] -> [a]+mbCons opt xs = maybe xs (:xs) $ opt +++-- Again, getting \"Executables\" is complicated by Conditions...+--+getExes :: D.GenericPackageDescription -> [CabalExe]+getExes gpd = xs ++ ys+ where + xs = map extractExe $ allExecutables gpd+ ys = map extractExe $ D.executables $ D.packageDescription gpd+ ++extractNameText :: D.PackageIdentifier -> String+extractNameText = fn . D.pkgName+ where fn (D.PackageName str) = str ++extractVersionText :: D.PackageIdentifier -> String+extractVersionText = fn . D.versionBranch . D.pkgVersion+ where fn = concat . intersperse "." . map show+++extractLibrary :: D.Library -> CabalLibrary+extractLibrary lib = + CabalLibrary { library_src_dirs = getSourceDirs $ D.libBuildInfo lib+ , public_modules = mkExpos lib+ , private_modules = getPrivateModules $ D.libBuildInfo lib+ }+ where+ mkExpos = map moduleDesc . D.exposedModules++++extractExe :: D.Executable -> CabalExe+extractExe exe = + CabalExe { exe_main_module = ExeMainPath $ D.modulePath exe+ , exe_src_dirs = getSourceDirs $ D.buildInfo exe+ , exe_other_modules = getPrivateModules $ D.buildInfo exe+ }++getSourceDirs :: D.BuildInfo -> [CabalSourceDir]+getSourceDirs = map cabalSourceDir . D.hsSourceDirs ++getPrivateModules :: D.BuildInfo -> [ModuleDesc]+getPrivateModules = map moduleDesc . D.otherModules +++allLibraries :: D.GenericPackageDescription -> [D.Library]+allLibraries = maybe [] fn . D.condLibrary + where+ fn :: D.CondTree D.ConfVar [D.Dependency] D.Library -> [D.Library]+ fn = ctfold (:) []++ +allExecutables :: D.GenericPackageDescription -> [D.Executable]+allExecutables = concat . map (ctfold (:) [] . snd) . D.condExecutables++++--------------------------------------------------------------------------------+-- General helper++ctfold :: (a -> b -> b) -> b -> (D.CondTree v c a) -> b+ctfold op initial node = foldr compfold x (D.condTreeComponents node)+ where+ x = D.condTreeData node `op` initial+ compfold (_,t1, Nothing) b = ctfold op b t1+ compfold (_,t1, Just t2) b = ctfold op (ctfold op b t1) t2+ +
+ src/Precis/Cabal/Datatypes.hs view
@@ -0,0 +1,81 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Cabal.Datatypes+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Datatype for working with /Packages/ ...+--+--------------------------------------------------------------------------------+++module Precis.Cabal.Datatypes+ (++ Package(..)++ , CabalFileError(..)+ , cabalFileErrorMsg++ , HsSourceFile(..)+ , hsSourceFile + , UnresolvedModule(..)+++ ) where++import Precis.Cabal.InterimDatatypes++import qualified System.FilePath as FP++-- Because of CondTree/Conditional a Cabal file can appear as+-- though it contains more than one Library, some normalization+-- has to be performed on this structure...+--+data Package = Package+ { package_name :: String+ , package_version :: String+ , exposed_modules :: [HsSourceFile]+ , internal_modules :: [HsSourceFile]+ , unresolved_modules :: [UnresolvedModule]+ }+ deriving (Eq,Show)++++data CabalFileError = ERR_CABAL_FILE_MISSING FilePath+ | ERR_CABAL_FILE_PARSE String+ deriving (Eq,Show)+++cabalFileErrorMsg :: CabalFileError -> String+cabalFileErrorMsg (ERR_CABAL_FILE_MISSING s) = "*** Error: missing file - " ++ s+cabalFileErrorMsg (ERR_CABAL_FILE_PARSE s) = "*** Error: parse error - " ++ s++-----++ +data HsSourceFile = HsSourceFile + { module_name :: ModName+ , full_path_to :: FilePath + }+ deriving (Eq,Ord,Show)++-- | An unresolved module couldn\'t be found in the listed source+-- directories.+--+newtype UnresolvedModule = UnresolvedModule { unresolved_name :: ModName }+ deriving (Eq,Ord,Show)+++-- smart constructor++hsSourceFile :: ModName -> FilePath -> HsSourceFile+hsSourceFile name path = HsSourceFile name (FP.normalise path)+
+ src/Precis/Cabal/InterimDatatypes.hs view
@@ -0,0 +1,183 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Cabal.InterimDatatypes+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Datatype for working with Cabal files...+--+--------------------------------------------------------------------------------+++module Precis.Cabal.InterimDatatypes+ (++ FileExtension++ , CabalFilePath + , cabalFilePath+ , pathToCabalFile+ , directoriesToCabalFile++ , ExeMainPath(..)+ , CabalSourceDir+ , cabalSourceDir+ , directoriesToSource++ , ModName+ , modName+ , getModName+ + , ModuleDesc+ , moduleDesc + , moduleDescName+ , moduleDirectories++ , CabalPrecis(..)+ , CabalLibrary(..)+ , CabalExe(..)++ ) where++import qualified Distribution.ModuleName as D++import Data.List ( intersperse )+import System.FilePath++++type FileExtension = String+++-- | 'CabalFilePath' is both the full, normalized path to the +-- cabal file and the directory parts to the file.+--+-- This is an opaque type - construct with 'cabalFilePath'.+-- +data CabalFilePath = CabalFilePath + { cabal_full_loc :: FilePath+ , cabal_path_to_split :: [FilePath]+ }+ deriving (Eq,Ord,Show) ++-- | Constructor for 'CabalFilePath' - the input FilePath is +-- normalized before constructing the data type.+--+cabalFilePath :: FilePath -> CabalFilePath+cabalFilePath path = + CabalFilePath { cabal_full_loc = full, cabal_path_to_split = parts }+ where+ full = normalise path+ parts = splitPath $ dropFileName full+ +pathToCabalFile :: CabalFilePath -> FilePath+pathToCabalFile = cabal_full_loc++directoriesToCabalFile :: CabalFilePath -> [FilePath]+directoriesToCabalFile = cabal_path_to_split+++newtype ExeMainPath = ExeMainPath { relPathToExeMain :: FilePath }+ deriving (Eq,Ord,Show)++data CabalSourceDir = CabalSourceDir+ { srcdir_rel_loc :: FilePath+ , srcdir_path_to_split :: [FilePath]+ }+ deriving (Eq,Ord,Show) ++cabalSourceDir :: FilePath -> CabalSourceDir+cabalSourceDir path = + CabalSourceDir { srcdir_rel_loc = rel, srcdir_path_to_split = parts }+ where+ rel = normalise path+ parts = splitPath rel+++directoriesToSource :: CabalSourceDir -> [FilePath]+directoriesToSource = srcdir_path_to_split+++newtype ModName = ModName { mod_name :: String }+ deriving (Eq,Ord,Show)++modName :: D.ModuleName -> ModName+modName = ModName . concat . intersperse "." . D.components++getModName :: ModName -> String+getModName = mod_name+++data ModuleDesc = ModuleDesc + { module_desc_name :: ModName+ , module_components :: [FilePath]+ }+ deriving (Eq,Ord,Show)+++moduleDesc :: D.ModuleName -> ModuleDesc+moduleDesc mname = + ModuleDesc { module_desc_name = name, module_components = parts }+ where+ xs = D.components mname+ name = ModName $ concat $ intersperse "." xs++ -- Add separator to inits but not last...+ parts = foldr fn [] xs where fn e [] = [e]+ fn e ac = (e++[pathSeparator]):ac+ ++moduleDescName :: ModuleDesc -> ModName+moduleDescName = module_desc_name++moduleDirectories :: ModuleDesc -> [FilePath]+moduleDirectories = module_components++-- Do we want /resolution/ during the building +-- the CabalPrecis or afterwards?+-- +-- i.e. when do we query the file system to locate the modules? +++-- Because of CondTree/Conditional a Cabal file can appear as+-- though it contains more than one Library, some normalization+-- has to be performed on this structure...+--+data CabalPrecis = CabalPrecis+ { pkg_name :: String+ , pkg_version :: String+ , path_to_cabal_file :: CabalFilePath+ , cond_libraries :: [CabalLibrary]+ , cond_exes :: [CabalExe]+ }+ deriving (Eq,Show)++-- One library per cabal file / package.++data CabalLibrary = CabalLibrary + { library_src_dirs :: [CabalSourceDir]+ , public_modules :: [ModuleDesc]+ , private_modules :: [ModuleDesc]+ }+ deriving (Eq,Ord,Show) ++-- Zero / one or more exe per cabal file / package.+-- The executable file will include the extension...++data CabalExe = CabalExe+ { exe_main_module :: ExeMainPath+ , exe_src_dirs :: [CabalSourceDir]+ , exe_other_modules :: [ModuleDesc] + }+ deriving (Eq,Ord,Show)+++++
+ src/Precis/Cabal/ResolveM.hs view
@@ -0,0 +1,243 @@+{-# OPTIONS -Wall #-}+{-# LANGUAGE ScopedTypeVariables #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Cabal.ResolveM+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- A Monad transofrmer (over IO) for revolving module names +-- to FilePaths.+--+--------------------------------------------------------------------------------+++module Precis.Cabal.ResolveM+ (++ resolvePrecis+ , ResolveM+ , runResolve+ , getFilePathLoc+ , getEIU++ ) where++import Precis.Cabal.Datatypes+import Precis.Cabal.InterimDatatypes+import Precis.Utils.Common+import Precis.Utils.ControlOperators++import Control.Applicative+import Control.Monad++import Data.Set ( Set )+import qualified Data.Set as Set+import System.Directory+import qualified System.FilePath as FP++++-- Are there any more useful manipulations than simply +-- resolving module_names to file_paths?++resolvePrecis :: CabalPrecis + -> [FileExtension]+ -> IO ([HsSourceFile],[HsSourceFile],[UnresolvedModule])+resolvePrecis precis exts =+ do { (_,st) <- runResolve (path_to_cabal_file precis) exts process+ ; return $ getEIU st+ }+ where+ process = do { mapM_ resolveLibrary (cond_libraries precis)+ ; mapM_ resolveExe (cond_exes precis)+ }+ + ++resolveLibrary :: CabalLibrary -> ResolveM ()+resolveLibrary lib@(CabalLibrary {library_src_dirs = src_dirs}) =+ do { mapM_ (resolveExposedModule src_dirs) (public_modules lib)+ ; mapM_ (resolveHiddenModule src_dirs) (private_modules lib)+ }++ ++resolveExe :: CabalExe -> ResolveM ()+resolveExe exe@(CabalExe {exe_src_dirs=src_dirs}) = + do { mapM_ (resolveHiddenModule src_dirs) (exe_other_modules exe)+ ; return () -- THE EXE MODULE TODO...+ }+++resolveExposedModule :: [CabalSourceDir] -> ModuleDesc -> ResolveM ()+resolveExposedModule = resolveModule logExposed++resolveHiddenModule :: [CabalSourceDir] -> ModuleDesc -> ResolveM ()+resolveHiddenModule = resolveModule logHidden++resolveModule :: (ModName -> FilePath -> ResolveM ()) + -> [CabalSourceDir] -> ModuleDesc -> ResolveM ()+resolveModule sk src_dirs mod_desc =+ getFilePathLoc src_dirs mod_desc >>= \ans ->+ case ans of + Nothing -> logUnresolved (moduleDescName mod_desc) + Just path -> sk (moduleDescName mod_desc) path+++getFilePathLoc :: [CabalSourceDir] -> ModuleDesc -> ResolveM (Maybe (FilePath))+getFilePathLoc src_dirs mod_desc = do + root <- asks root_path+ exts <- asks known_exts+ firstSuccess validFile (makeAll root exts)+ where+ makeAll root exts = + directoryProduct (\opt_dir ext -> fullPath root opt_dir mod_desc ext) + src_dirs+ exts+ ++directoryProduct :: (Maybe a -> b -> c) -> [a] -> [b] -> [c] +directoryProduct f [] ys = [f Nothing b | b <- ys]+directoryProduct f xs ys = [f (Just a) b | a <- xs , b <- ys ]+++fullPath :: CabalFilePath -> Maybe CabalSourceDir -> ModuleDesc -> FileExtension + -> FilePath+fullPath root opt_src_dir mdesc ext = FP.normalise $ + prepend (directoriesToCabalFile root) $ + prepend (maybe [] directoriesToSource opt_src_dir) $ + modulePath mdesc ext ++prepend :: [FilePath] -> FilePath -> FilePath+prepend xs = FP.combine (FP.joinPath xs)++modulePath :: ModuleDesc -> FileExtension -> FilePath+modulePath mdesc ext = step (moduleDirectories mdesc) + where+ step [] = ext -- Really an error?+ step [a] = FP.addExtension a ext+ step (a:as) = FP.combine a $ step as++++++ +--------------------------------------------------------------------------------+--+++data RSt = RSt { internal_mods :: Set HsSourceFile+ , exposed_mods :: Set HsSourceFile+ , unresolveds :: [UnresolvedModule]+ }++stateZero :: RSt +stateZero = RSt Set.empty Set.empty []++getEIU :: RSt -> ([HsSourceFile],[HsSourceFile],[UnresolvedModule])+getEIU rst = ( Set.toList $ exposed_mods rst+ , Set.toList $ internal_mods rst + , unresolveds rst )+++data REnv = REnv { root_path :: CabalFilePath, known_exts :: [FileExtension] }++newtype ResolveM a = ResolveM { getResolveM :: REnv -> RSt -> IO (a,RSt) }++instance Functor ResolveM where+ fmap f mf = ResolveM $ \env st -> getResolveM mf env st >>= \(a,st') -> + return (f a,st')+++instance Applicative ResolveM where+ pure a = ResolveM $ \_ st -> return (a,st)+ af <*> a = ResolveM $ \env st -> getResolveM af env st >>= \(f,st') ->+ getResolveM a env st' >>= \(b,st'') -> + return (f b, st'')+++instance Monad ResolveM where+ return a = ResolveM $ \_ st -> return (a,st)+ m >>= k = ResolveM $ \env st -> getResolveM m env st >>= \(a,st') -> + getResolveM (k a) env st' + +++runResolve :: CabalFilePath -> [FileExtension] -> ResolveM a -> IO (a,RSt)+runResolve root exts mf = getResolveM mf env stateZero+ where+ env = REnv { root_path = root, known_exts = exts }++ask :: ResolveM REnv+ask = ResolveM $ \env st -> return (env,st)++asks :: (REnv -> a) -> ResolveM a+asks f = liftM f ask++{-+get :: ResolveM RSt+get = ResolveM $ \_ st -> return (st,st)++set :: RSt -> ResolveM ()+set st = ResolveM $ \_ _ -> return ((),st)++sets :: (RSt -> (a,RSt)) -> ResolveM a+sets f = ResolveM $ \_ st -> return (f st)+-}++sets_ :: (RSt -> RSt) -> ResolveM ()+sets_ f = ResolveM $ \_ st -> return ((), f st)+++liftIO :: IO a -> ResolveM a+liftIO ma = ResolveM $ \_ st -> ma >>= \a -> return (a,st)++validFile :: FilePath -> ResolveM (Maybe FilePath)+validFile path = valid (liftIO . doesFileExist) path+++logUnresolved :: ModName -> ResolveM ()+logUnresolved name = sets_ (star unresolveds upd)+ where+ upd us s = s {unresolveds = UnresolvedModule name : us}+ ++++-- The module might already be hidden or even exposed...+--+-- If already hidded - don't add+-- If already exposed - don't add+-- +logHidden :: ModName -> FilePath -> ResolveM ()+logHidden name path = sets_ (star2 exposed_mods internal_mods upd)+ where+ hs_src = HsSourceFile name path+ upd exs ins s = if Set.member hs_src exs + then s+ else s { internal_mods = Set.insert hs_src ins }+ ++-- The module might already be exposed or hidden...+--+-- If already hidded - remove from hidden list add to exposed list+-- If already exposed - don't add+-- +logExposed :: ModName -> FilePath -> ResolveM ()+logExposed name path = sets_ (star2 exposed_mods internal_mods upd)+ where+ hs_src = HsSourceFile name path+ upd exs ins s = if Set.member hs_src ins+ then s { internal_mods = Set.delete hs_src ins+ , exposed_mods = optAdd hs_src exs }+ else s { exposed_mods = optAdd hs_src exs }++ optAdd a s = if Set.member a s then s else Set.insert a s+
− src/Precis/CabalPackage.hs
@@ -1,181 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Precis.CabalPackage--- Copyright : (c) Stephen Tetley 2010--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------------------------------------------------------------------------------------------module Precis.CabalPackage - ( - Extension- , extractPrecis- , known_extensions-- ) where--import Precis.Datatypes-import Precis.PathUtils-import Precis.Utils--import Distribution.ModuleName-import Distribution.Package-import Distribution.PackageDescription-import Distribution.PackageDescription.Parse-import Distribution.Verbosity-import Distribution.Version--import Control.Monad-import Data.List ( intersperse, nub )-import System.Directory-import System.FilePath--type Extension = String---extractPrecis :: FilePath -> [Extension] -> IO (Either CabalFileError CabalPrecis)-extractPrecis cabal_file exts = do- exists <- doesFileExist cabal_file- if exists then extractP cabal_file exts `onSuccessM` post- else return $ Left $ ERR_CABAL_FILE_MISSING cabal_file- where- post = return . nubSourceFiles---known_extensions :: [Extension]-known_extensions = ["hs", "lhs"]--extractP :: FilePath -> [String] -> IO (Either CabalFileError CabalPrecis)-extractP cabal_file_path exts =- safeReadPackageDescription normal cabal_file_path `onSuccessM` sk- where- root_to_cabal = dropFileName cabal_file_path - sk gen_pkg = do { (expos,privs) <- getSourceFiles gen_pkg root_to_cabal exts- ; return $ CabalPrecis - { package_name = getName gen_pkg- , package_version = getVersion gen_pkg- , path_to_cabal_file = cabal_file_path- , exposed_modules = expos- , internal_modules = privs- }- }--type SafeGPD = Either CabalFileError GenericPackageDescription--safeReadPackageDescription :: Verbosity -> FilePath -> IO SafeGPD-safeReadPackageDescription verbo path = - catch (liftM Right $ readPackageDescription verbo path)- (\e -> return $ Left $ ERR_CABAL_FILE_PARSE $ show e)------------------------------------------------------------------------------------- Extract from Package description--getName :: GenericPackageDescription -> String-getName = extrNameText . package . packageDescription --getVersion :: GenericPackageDescription -> String-getVersion = extrVersionText . package . packageDescription - --extrNameText :: PackageIdentifier -> String-extrNameText = fn . pkgName- where fn (PackageName str) = str --extrVersionText :: PackageIdentifier -> String-extrVersionText = fn . versionBranch . pkgVersion- where fn = concat . intersperse "." . map show------ extract source files--getSourceFiles :: GenericPackageDescription - -> FilePath- -> [String] - -> IO ([SourceFile], [SourceFile])-getSourceFiles pkg_desc root exts = do - lib_mods <- mapM (resolveLibrary root exts) $ allLibraries pkg_desc- exe_mods <- mapM (resolveExecutable root exts) $ allExecutables pkg_desc- let (lib_expos, lib_privs) = foldr fn ([],[]) lib_mods - return (lib_expos, lib_privs ++ concat exe_mods)- where - fn (a,b) (xs,ys) = (a++xs,b++ys) ---allLibraries :: GenericPackageDescription -> [Library]-allLibraries = maybe [] fn . condLibrary - where- fn :: CondTree ConfVar [Dependency] Library -> [Library]- fn = ctfold (:) []-- -allExecutables :: GenericPackageDescription -> [Executable]-allExecutables = concat . map (ctfold (:) [] . snd) . condExecutables---resolveLibrary :: FilePath -> [String] -> Library -> IO ([SourceFile], [SourceFile])-resolveLibrary root exts lib = liftM2 (,) (fn expos) (fn others)- where- fn mods = resolveFiles root src_paths mods exts- (src_paths, expos, others) = libraryContents lib --libraryContents :: Library -> ([FilePath], [ModuleName], [ModuleName])-libraryContents lib = (src_paths, expo_modules, other_modules)- where- src_paths = hsSourceDirs $ libBuildInfo lib- expo_modules = exposedModules lib- other_modules = otherModules $ libBuildInfo lib--resolveExecutable :: FilePath -> [String] -> Executable -> IO [SourceFile]-resolveExecutable root exts exe = resolveFiles root src_paths mods exts- where- (src_paths, mods) = executableModules exe---executableContents :: Executable -> ([FilePath], FilePath, [ModuleName])-executableContents exe = (src_paths, exe_main_module, other_modules)- where- src_paths = hsSourceDirs $ buildInfo exe- exe_main_module = modulePath exe- other_modules = otherModules $ buildInfo exe----- All executable modules considered internal...--executableModules :: Executable -> ([FilePath], [ModuleName])-executableModules = fn . executableContents - where- fn (as,exe,cs) = (as, exeModuleName exe : cs)------------------------------------------------------------------------------------- reconcile modules---- Initially a precis may have dublicates (via Cabal\'s --- conditional mechanism).----nubSourceFiles :: CabalPrecis -> CabalPrecis-nubSourceFiles cp@(CabalPrecis _ _ _ exs ins) = - cp { exposed_modules = exs', internal_modules = ins' }- where- exs' = nub exs- ins' = filter (not . (`elem` exs')) $ nub ins ------------------------------------------------------------------------------------- General helper--ctfold :: (a -> b -> b) -> b -> (CondTree v c a) -> b-ctfold op initial node = foldr compfold x (condTreeComponents node)- where- x = condTreeData node `op` initial- compfold (_,t1, Nothing) b = ctfold op b t1- compfold (_,t1, Just t2) b = ctfold op (ctfold op b t1) t2- -
− src/Precis/Datatypes.hs
@@ -1,163 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Precis.Datatypes--- Copyright : (c) Stephen Tetley 2010--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------------------------------------------------------------------------------------------module Precis.Datatypes- (- StrName- , TextRep- , CabalFileError(..)- , cabalFileErrorMsg-- , CabalPrecis(..)- , SourceFile(..)- , sourceFile - , sourceFileModule-- , MacroExpandedSrcFile(..)- , ModuleParseError(..)- , moduleParseErrorMsg-- , ExportItem(..)- , exportItemName-- , InstanceDecl(..)- , instanceDeclName-- , DatatypeDecl(..)- , datatypeDeclName-- , TypeSigDecl(..)- , typeSigDeclName-- ) where---import System.FilePath----- Don\'t use the Name type from haskell-src-exts.--- Precis doesn\'t need its distinction between identifiers--- and symbols.-----type StrName = String-type TextRep = String--data CabalFileError = ERR_CABAL_FILE_MISSING FilePath- | ERR_CABAL_FILE_PARSE String- deriving (Eq,Show)---cabalFileErrorMsg :: CabalFileError -> String-cabalFileErrorMsg (ERR_CABAL_FILE_MISSING s) = "*** Error: missing file - " ++ s-cabalFileErrorMsg (ERR_CABAL_FILE_PARSE s) = "*** Error: parse error - " ++ s---data CabalPrecis = CabalPrecis- { package_name :: StrName- , package_version :: String- , path_to_cabal_file :: FilePath- , exposed_modules :: [SourceFile]- , internal_modules :: [SourceFile]- }- deriving (Eq,Show)---- -data SourceFile- = SourceFile { module_name :: StrName- , full_path_to :: FilePath - }- | UnresolvedFile { unresolved_file_name :: StrName } - deriving (Eq,Ord,Show)----- smart constructor--sourceFile :: String -> FilePath -> SourceFile-sourceFile name path = SourceFile name (normalise path)----sourceFileModule :: SourceFile -> StrName-sourceFileModule (SourceFile n _) = n-sourceFileModule (UnresolvedFile n) = n -- defer to unresolved---------------------------------------------------------------------------------------- Precis for individual source files--data MacroExpandedSrcFile = MacroExpandedSrcFile- { source_file_name :: String- , expanded_source :: String- }----- | Module file names are derived from the cabal file.--- So the name is tracked if it is missing...----data ModuleParseError = ERR_MODULE_FILE_MISSING String- | ERR_MODULE_FILE_PARSE String- deriving (Eq,Show)--moduleParseErrorMsg :: ModuleParseError -> String-moduleParseErrorMsg (ERR_MODULE_FILE_MISSING s) = - "*** Error: missing file - " ++ s-moduleParseErrorMsg (ERR_MODULE_FILE_PARSE s) = - "*** Error: parse error - " ++ s---data ExportItem = ModuleExport StrName- | DataOrClass StrName TextRep- | Variable StrName - deriving (Eq,Show)--exportItemName :: ExportItem -> StrName-exportItemName (ModuleExport s) = s-exportItemName (DataOrClass s _) = s-exportItemName (Variable s) = s ---data InstanceDecl = InstanceDecl - { class_name :: StrName- , type_rep :: TextRep- , full_rep :: TextRep- }- deriving (Eq,Show)--instanceDeclName :: InstanceDecl -> StrName-instanceDeclName = class_name---data DatatypeDecl = DatatypeDecl- { datatype_name :: StrName- , datatype_rep :: TextRep- }- deriving (Eq,Show)--datatypeDeclName :: DatatypeDecl -> StrName-datatypeDeclName = datatype_name---data TypeSigDecl = TypeSigDecl- { type_decl_name :: StrName- , type_signature :: TextRep- }- deriving (Eq,Show)--typeSigDeclName :: TypeSigDecl -> StrName-typeSigDeclName = type_decl_name
src/Precis/Diff.hs view
@@ -32,7 +32,7 @@ ) where -import Precis.Utils+import Precis.Utils.Common import Data.List ( find ) @@ -57,7 +57,6 @@ fmap f (Add a) = Add (f a) fmap f (Equ a) = Equ (f a) fmap f (Del a) = Del (f a)-
+ src/Precis/HsSrc/Datatypes.hs view
@@ -0,0 +1,108 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.HsSrc.Datatypes+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+--+--------------------------------------------------------------------------------+++module Precis.HsSrc.Datatypes+ (+ TextRep+ , StrName++ , MacroExpandedSrcFile(..)+ , ModuleParseError(..)+ , moduleParseErrorMsg++ , ExportItem(..)+ , exportItemName++ , InstanceDecl(..)+ , instanceDeclName++ , DatatypeDecl(..)+ , datatypeDeclName++ , TypeSigDecl(..)+ , typeSigDeclName++ ) where+++++type TextRep = String+type StrName = String++--------------------------------------------------------------------------------+-- Precis for individual source files++data MacroExpandedSrcFile = MacroExpandedSrcFile+ { source_file_name :: String+ , expanded_source :: String+ }+++-- | Module file names are derived from the cabal file.+-- So the name is tracked if it is missing...+--+data ModuleParseError = ERR_MODULE_FILE_MISSING String+ | ERR_MODULE_FILE_PARSE String+ deriving (Eq,Show)++moduleParseErrorMsg :: ModuleParseError -> String+moduleParseErrorMsg (ERR_MODULE_FILE_MISSING s) = + "*** Error: missing file - " ++ s+moduleParseErrorMsg (ERR_MODULE_FILE_PARSE s) = + "*** Error: parse error - " ++ s+++data ExportItem = ModuleExport StrName+ | DataOrClass StrName TextRep+ | Variable StrName + deriving (Eq,Show)++exportItemName :: ExportItem -> StrName+exportItemName (ModuleExport s) = s+exportItemName (DataOrClass s _) = s+exportItemName (Variable s) = s +++data InstanceDecl = InstanceDecl + { class_name :: StrName+ , type_rep :: TextRep+ , full_rep :: TextRep+ }+ deriving (Eq,Show)++instanceDeclName :: InstanceDecl -> StrName+instanceDeclName = class_name+++data DatatypeDecl = DatatypeDecl+ { datatype_name :: StrName+ , datatype_rep :: TextRep+ }+ deriving (Eq,Show)++datatypeDeclName :: DatatypeDecl -> StrName+datatypeDeclName = datatype_name+++data TypeSigDecl = TypeSigDecl+ { type_decl_name :: StrName+ , type_signature :: TextRep+ }+ deriving (Eq,Show)++typeSigDeclName :: TypeSigDecl -> StrName+typeSigDeclName = type_decl_name
+ src/Precis/HsSrc/Utils.hs view
@@ -0,0 +1,101 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.HsSrc.Utils+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+--+--------------------------------------------------------------------------------+++module Precis.HsSrc.Utils+ (++ readModule + , parseModuleWithExts+ , extractQName+ , extractCName+ , extractModuleName+ , extractName+ , extractSpecialCon++ , getModuleName++ , namedDecls++ , hsppList++ ) where++import Precis.HsSrc.Datatypes++import Language.Haskell.Exts hiding ( name ) -- package: haskell-src-exts+++readModule :: MacroExpandedSrcFile -> Either ModuleParseError Module+readModule (MacroExpandedSrcFile filename mx_src) = + case parseModuleWithExts knownExtensions filename mx_src of+ ParseFailed loc msg -> Left $ ERR_MODULE_FILE_PARSE $ mkMsg msg loc+ ParseOk a -> Right $ a+ where+ mkMsg msg loc = msg ++ " - " ++ ppLoc loc+ ppLoc (SrcLoc _ l c) = unwords ["line:", show l ++ ",", "column:", show c]++parseModuleWithExts :: [Extension] -> FilePath -> String -> ParseResult Module+parseModuleWithExts exts file_name txt = parseModuleWithMode pmode txt+ where+ pmode = defaultParseMode { extensions = exts+ , parseFilename = file_name+ , ignoreLinePragmas = False }+++extractQName :: QName -> String+extractQName (Qual mname name) = extractModuleName mname ++ extractName name+extractQName (UnQual name) = extractName name+extractQName (Special spc) = extractSpecialCon spc++extractCName :: CName -> String+extractCName (VarName name) = extractName name+extractCName (ConName name) = extractName name++extractModuleName :: ModuleName -> String +extractModuleName (ModuleName name) = name++extractName :: Name -> String+extractName (Ident name) = name+extractName (Symbol name) = name++extractSpecialCon :: SpecialCon -> String+extractSpecialCon = prettyPrint++--------------------------------------------------------------------------------++getModuleName :: Module -> ModuleName +getModuleName (Module _ mn _ _ _ _ _) = mn +++--------------------------------------------------------------------------------++--+namedDecls :: Decl -> [(StrName,TextRep)]+namedDecls t@(TypeDecl _ n _ _) = [(extractName n, prettyPrint t)]+namedDecls t@(TypeFamDecl _ n _ _) = [(extractName n, prettyPrint t)]+namedDecls t@(DataDecl _ _ _ n _ _ _) = [(extractName n, prettyPrint t)]+namedDecls t@(GDataDecl _ _ _ n _ _ _ _) = [(extractName n, prettyPrint t)]+namedDecls t@(DataFamDecl _ _ n _ _) = [(extractName n, prettyPrint t)]+namedDecls t@(ClassDecl _ _ n _ _ _) = [(extractName n, prettyPrint t)]+namedDecls t@(InstDecl _ _ q _ _) = [(extractQName q, prettyPrint t)]+namedDecls t@(DerivDecl _ _ q _) = [(extractQName q, prettyPrint t)]+namedDecls t@(TypeSig _ ns _) = map fn ns+ where fn n = (extractName n, prettyPrint t)+namedDecls _ = []+++hsppList :: Pretty a => [a] -> String+hsppList = unwords . map prettyPrint
− src/Precis/HsSrcUtils.hs
@@ -1,101 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Precis.HsSrcUtils--- Copyright : (c) Stephen Tetley 2010--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------------------------------------------------------------------------------------------module Precis.HsSrcUtils- (-- readModule - , parseModuleWithExts- , extractQName- , extractCName- , extractModuleName- , extractName- , extractSpecialCon-- , getModuleName-- , namedDecls-- , hsppList-- ) where--import Precis.Datatypes--import Language.Haskell.Exts hiding ( name ) -- package: haskell-src-exts---readModule :: MacroExpandedSrcFile -> Either ModuleParseError Module-readModule (MacroExpandedSrcFile filename mx_src) = - case parseModuleWithExts knownExtensions filename mx_src of- ParseFailed loc msg -> Left $ ERR_MODULE_FILE_PARSE $ mkMsg msg loc- ParseOk a -> Right $ a- where- mkMsg msg loc = msg ++ " - " ++ ppLoc loc- ppLoc (SrcLoc _ l c) = unwords ["line:", show l ++ ",", "column:", show c]--parseModuleWithExts :: [Extension] -> FilePath -> String -> ParseResult Module-parseModuleWithExts exts file_name txt = parseModuleWithMode pmode txt- where- pmode = defaultParseMode { extensions = exts- , parseFilename = file_name- , ignoreLinePragmas = False }---extractQName :: QName -> String-extractQName (Qual mname name) = extractModuleName mname ++ extractName name-extractQName (UnQual name) = extractName name-extractQName (Special spc) = extractSpecialCon spc--extractCName :: CName -> String-extractCName (VarName name) = extractName name-extractCName (ConName name) = extractName name--extractModuleName :: ModuleName -> String -extractModuleName (ModuleName name) = name--extractName :: Name -> String-extractName (Ident name) = name-extractName (Symbol name) = name--extractSpecialCon :: SpecialCon -> String-extractSpecialCon = prettyPrint------------------------------------------------------------------------------------getModuleName :: Module -> ModuleName -getModuleName (Module _ mn _ _ _ _ _) = mn ----------------------------------------------------------------------------------------namedDecls :: Decl -> [(StrName,TextRep)]-namedDecls t@(TypeDecl _ n _ _) = [(extractName n, prettyPrint t)]-namedDecls t@(TypeFamDecl _ n _ _) = [(extractName n, prettyPrint t)]-namedDecls t@(DataDecl _ _ _ n _ _ _) = [(extractName n, prettyPrint t)]-namedDecls t@(GDataDecl _ _ _ n _ _ _ _) = [(extractName n, prettyPrint t)]-namedDecls t@(DataFamDecl _ _ n _ _) = [(extractName n, prettyPrint t)]-namedDecls t@(ClassDecl _ _ n _ _ _) = [(extractName n, prettyPrint t)]-namedDecls t@(InstDecl _ _ q _ _) = [(extractQName q, prettyPrint t)]-namedDecls t@(DerivDecl _ _ q _) = [(extractQName q, prettyPrint t)]-namedDecls t@(TypeSig _ ns _) = map fn ns- where fn n = (extractName n, prettyPrint t)-namedDecls _ = []---hsppList :: Pretty a => [a] -> String-hsppList = unwords . map prettyPrint
src/Precis/HtmlReport.hs view
@@ -22,13 +22,14 @@ ) where -import Precis.Datatypes+import Precis.Cabal import Precis.Diff-import Precis.StyleSheet+import Precis.HsSrc.Datatypes import Precis.ModuleProperties-import Precis.PPShowS ( toString, line ) import Precis.ReportMonad+import Precis.StyleSheet import Precis.TextOutput+import Precis.Utils.PPShowS ( toString, line ) import Language.Haskell.Exts ( Module ) -- package: haskell-src-exts import Text.XHtml hiding ( name ) -- package: xhtml@@ -40,28 +41,29 @@ makeShortReport :: ModuleParseFunction - -> CabalPrecis - -> CabalPrecis + -> Package + -> Package -> IO TextSummary makeShortReport pf ncp ocp = liftM snd $ makeReport MSG_AND_HTML pf ncp ocp makeFullReport :: ModuleParseFunction - -> CabalPrecis - -> CabalPrecis + -> Package + -> Package -> IO (Html,TextSummary) makeFullReport = makeReport MSG_AND_HTML makeReport :: ReportLevel -> ModuleParseFunction - -> CabalPrecis - -> CabalPrecis + -> Package + -> Package -> IO (Html,TextSummary) makeReport lvl pf new old = liftM post $ execReportM pf lvl $ do { packageNamesAndVersions new old+ ; countUnresolveds (unresolved_modules new) ; moduleCountSummary new old- ; compareExposedModules (exposed_modules new) (exposed_modules old)+ ; compareExposedModules new old } where post (hs,stats) = (assembleDoc (package_name new) hs, mkText stats)@@ -78,7 +80,7 @@ -------------------------------------------------------------------------------- -- -packageNamesAndVersions :: CabalPrecis -> CabalPrecis -> ReportM ()+packageNamesAndVersions :: Package -> Package -> ReportM () packageNamesAndVersions new old = do { tellHtml $ h1 << ("Change summary: " ++ package_name new) ; tellHtml $ h2 << (toString $ comparingMsg new old)@@ -98,8 +100,8 @@ -moduleCountSummary :: CabalPrecis -> CabalPrecis -> ReportM ()-moduleCountSummary new old = +moduleCountSummary :: Package -> Package -> ReportM ()+moduleCountSummary new old = do { countDeletions incrRemovedModules expos ; tellHtml $ docModulesDiffs expos privs }@@ -109,18 +111,19 @@ -compareExposedModules :: [SourceFile] -> [SourceFile] -> ReportM ()+compareExposedModules :: Package -> Package -> ReportM () compareExposedModules new old = - mapM_ compareSrcFileEdit $ diffExposedSrcFiles new old+ mapM_ compareSrcFileEdit $ + diffExposedSrcFiles (exposed_modules new) (exposed_modules old) -compareSrcFileEdit :: Edit4 SourceFile -> ReportM ()-compareSrcFileEdit (DIF a b) = compareSourceFiles a b+compareSrcFileEdit :: Edit4 HsSourceFile -> ReportM ()+compareSrcFileEdit (DIF a b) = compareHsSourceFiles a b compareSrcFileEdit _ = return () -compareSourceFiles :: SourceFile -> SourceFile -> ReportM ()-compareSourceFiles new old = do +compareHsSourceFiles :: HsSourceFile -> HsSourceFile -> ReportM ()+compareHsSourceFiles new old = do do { tellHtml $ docStartSummary new ; pf <- askParseFun ; new_ans <- liftIO $ pf new@@ -131,7 +134,7 @@ (_, Left err) -> failk (OLD old) err } where - failk cmpmod err = do { tellParseFail (fmap sourceFileModule cmpmod)+ failk cmpmod err = do { tellParseFail (fmap (getModName . module_name) cmpmod) ; tellHtml $ docModuleParseError cmpmod err } @@ -205,7 +208,8 @@ -+countUnresolveds :: [UnresolvedModule] -> ReportM ()+countUnresolveds = mapM_ (tellUnresolved . NEW . getModName . unresolved_name) -------------------------------------------------------------------------------- -- Helpers@@ -256,16 +260,16 @@ doc_title = thetitle << ("Change summary: " +++ pkg_name) doc_style = style ! [thetype "text/css"] << inline_stylesheet -docStartSummary :: SourceFile -> Html-docStartSummary src_file = h2 << (sourceFileModule src_file ++ ":")+docStartSummary :: HsSourceFile -> Html+docStartSummary src_file = h2 << ((getModName $ module_name src_file) ++ ":") -docModuleParseError :: CMP SourceFile -> ModuleParseError -> Html+docModuleParseError :: CMP HsSourceFile -> ModuleParseError -> Html docModuleParseError (OLD _src) err = pre << (moduleParseErrorMsg err) docModuleParseError (NEW _src) err = pre << (moduleParseErrorMsg err) -docModulesDiffs :: [Edit3 StrName] -> [Edit3 StrName] -> Html+docModulesDiffs :: [Edit3 ModName] -> [Edit3 ModName] -> Html docModulesDiffs expos privs = expos_doc +++ privs_doc where expos_doc = maybe docNoExpos (withHeader2 "Exposed modules:")@@ -291,13 +295,13 @@ [ "No internal modules counted." ] -modulesTable :: [Edit3 StrName] -> Maybe Html+modulesTable :: [Edit3 ModName] -> Maybe Html modulesTable [] = Nothing modulesTable xs = Just $ table << zipWith fn xs [1::Int ..] where- fn (Add a) i = makeRow i "+" a- fn (Equ a) i = makeRow i "" a- fn (Del a) i = makeRow i "-" a+ fn (Add a) i = makeRow i "+" $ getModName a+ fn (Equ a) i = makeRow i "" $ getModName a+ fn (Del a) i = makeRow i "-" $ getModName a makeRow i op name = tr << [ td << (show i), td << op, td << name ]
src/Precis/ModuleProperties.hs view
@@ -35,9 +35,10 @@ ) where -import Precis.Datatypes+import Precis.Cabal import Precis.Diff-import Precis.HsSrcUtils+import Precis.HsSrc.Datatypes+import Precis.HsSrc.Utils import Language.Haskell.Exts hiding ( name, op ) -- package: haskell-src-exts @@ -45,32 +46,29 @@ + -------------------------------------------------------------------------------- -- all modules (exposed and internal) in a cabal file -diffExposedModules :: CabalPrecis -> CabalPrecis -> [Edit3 StrName]+diffExposedModules :: Package -> Package -> [Edit3 ModName] diffExposedModules new old = diff3 (==) new' old' where- new' = map getName $ exposed_modules new- old' = map getName $ exposed_modules old+ new' = map module_name $ exposed_modules new+ old' = map module_name $ exposed_modules old -diffInternalModules :: CabalPrecis -> CabalPrecis -> [Edit3 StrName]++diffInternalModules :: Package -> Package -> [Edit3 ModName] diffInternalModules new old = diff3 (==) new' old' where- new' = map getName $ internal_modules new- old' = map getName $ internal_modules old--getName :: SourceFile -> StrName-getName (SourceFile m _) = m-getName (UnresolvedFile s) = s -+ new' = map module_name $ internal_modules new+ old' = map module_name $ internal_modules old -diffExposedSrcFiles :: [SourceFile] -> [SourceFile] -> [Edit4 SourceFile]+diffExposedSrcFiles :: [HsSourceFile] -> [HsSourceFile] -> [Edit4 HsSourceFile] diffExposedSrcFiles new old = diff4 equal (/=) new old where- s `equal` t = getName s == getName t+ s `equal` t = module_name s == module_name t -------------------------------------------------------------------------------- -- export lists
− src/Precis/PPShowS.hs
@@ -1,246 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Precis.PPShowS--- Copyright : (c) Stephen Tetley 2010--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------ Pretty print combinators for ShowS---------------------------------------------------------------------------------------module Precis.PPShowS- (-- toString- , putShowS- , putShowSLine-- , punctuate- , encloseSep- , list - , tupled- , semiBrace-- , hcat - , hsep- , vsep- , (<>)- , (<+>)-- , sep- , line-- , squotes- , dquotes- , braces- , parens- , angles- , brackets-- , lparen- , rparen- , langle- , rangle- , lbrace- , rbrace- , lbracket- , rbracket-- , sglquote- , dblquote- , semi- , colon- , comma- , space- , dot- , equal- , backslash- , newline- , bar-- , empty- , text - , char- , int-- , repeatChar- , prefixLines- , nextLine-- ) where--infixr 5 `line`-infixr 6 <>,<+>--toString :: ShowS -> String-toString = ($ [])--putShowS :: ShowS -> IO ()-putShowS = putStr . toString--putShowSLine :: ShowS -> IO ()-putShowSLine = putStrLn . toString---punctuate :: ShowS -> [ShowS] -> [ShowS]-punctuate _ [] = []-punctuate _ [x] = [x]-punctuate s (x:xs) = (x . s) : punctuate s xs--encloseSep :: ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS-encloseSep l r _ [] = l . r-encloseSep l r _ [x] = l . x . r-encloseSep l r s xs = l . hcat (punctuate s xs) . r--list :: [ShowS] -> ShowS-list = encloseSep lbracket rbracket comma--tupled :: [ShowS] -> ShowS-tupled = encloseSep lparen rparen comma--semiBrace :: [ShowS] -> ShowS-semiBrace = encloseSep lbrace rbrace semi--hcat :: [ShowS] -> ShowS-hcat = fold (.)--hsep :: [ShowS] -> ShowS-hsep = fold sep--vsep :: [ShowS] -> ShowS-vsep = fold line---(<>) :: ShowS -> ShowS -> ShowS-(<>) = (.)--(<+>) :: ShowS -> ShowS -> ShowS-(<+>) f g = f <> space <> g---fold :: (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS-fold _ [] = id-fold f xs = foldr1 f xs--sep :: ShowS -> ShowS -> ShowS-x `sep` y = x . space . y --line :: ShowS -> ShowS -> ShowS-x `line` y = x . newline . y--squotes :: ShowS -> ShowS-squotes = enclose sglquote sglquote--dquotes :: ShowS -> ShowS-dquotes = enclose dblquote dblquote--braces :: ShowS -> ShowS-braces = enclose lbrace rbrace--parens :: ShowS -> ShowS-parens = enclose lparen rparen--angles :: ShowS -> ShowS-angles = enclose langle rangle--brackets :: ShowS -> ShowS-brackets = enclose lbracket rbracket--enclose :: ShowS -> ShowS -> ShowS -> ShowS-enclose l r x = l . x . r--lparen :: ShowS-lparen = showChar '('--rparen :: ShowS-rparen = showChar ')'--langle :: ShowS-langle = showChar '<'--rangle :: ShowS-rangle = showChar '>'--lbrace :: ShowS-lbrace = showChar '{'--rbrace :: ShowS-rbrace = showChar '}'--lbracket :: ShowS-lbracket = showChar '['--rbracket :: ShowS-rbracket = showChar ']' ---sglquote :: ShowS-sglquote = showChar '\''---dblquote :: ShowS-dblquote = showChar '"'--semi :: ShowS-semi = showChar ';'--colon :: ShowS-colon = showChar ':'--comma :: ShowS-comma = showChar ','--space :: ShowS-space = showChar ' '--dot :: ShowS-dot = showChar '.'--equal :: ShowS-equal = showChar '='--backslash :: ShowS-backslash = showChar '\\'--newline :: ShowS-newline = showChar '\n'--bar :: ShowS-bar = showChar '|'---empty :: ShowS-empty = id--text :: String -> ShowS-text = showString--char :: Char -> ShowS-char = showChar--int :: Int -> ShowS-int = shows---repeatChar :: Int -> Char -> ShowS-repeatChar i = showString . replicate i---prefixLines :: ShowS -> String -> ShowS-prefixLines pre xs = vsep $ map ((pre <>) . text) $ lines xs---- | Note - this function evaluates the second arg and uses (++) --- via 'showString'.----nextLine :: ShowS -> ShowS -> ShowS-nextLine f g = step $ toString g - where- step str | null str = f- | otherwise = f `line` (showString str)
− src/Precis/PathUtils.hs
@@ -1,92 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Precis.PathUtils--- Copyright : (c) Stephen Tetley 2010--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------------------------------------------------------------------------------------------module Precis.PathUtils- (- exeModuleName- , resolveFiles- , removePrefix- , resolveToCabalFileLoc- ) where--import Precis.Datatypes--import Distribution.ModuleName--import Data.List ( intersperse )-import Data.Monoid-import System.Directory-import System.FilePath----- should have \".hs\" or \".lhs\" extension-exeModuleName :: FilePath -> ModuleName-exeModuleName = fromString . dropExtension--resolveFiles :: FilePath - -> [FilePath] - -> [ModuleName] - -> [String]- -> IO [SourceFile]-resolveFiles path_root src_dirs mod_names exts = - let cp_paths = map fn $ longCrossProduct src_dirs mod_names in- mapM resolve cp_paths - where- fn (path,modu) = (mname modu, moduleLongPath path_root path modu)-- resolve (mod_name,path) = do { ans <- findByExtension path exts- ; case ans of- Nothing -> - return $ UnresolvedFile $ mod_name- Just path' -> - return $ sourceFile mod_name path'- }---findByExtension :: FilePath -> [String] -> IO (Maybe FilePath)-findByExtension _ [] = return Nothing-findByExtension path (e:es) = let full = addExtension path e in - doesFileExist full >>= \ans -> if ans then return (Just full) - else findByExtension path es---moduleLongPath :: FilePath -> FilePath -> ModuleName -> FilePath-moduleLongPath root src_dir mod_name = - joinPath $ splitPath root ++ splitPath src_dir ++ components mod_name ---longCrossProduct :: Monoid a => [a] -> [b] -> [(a,b)]-longCrossProduct [] ys = map (\b -> (mempty,b)) ys-longCrossProduct xs ys = [(a,b) | a <- xs , b <- ys ]---mname :: ModuleName -> String -mname = concat . intersperse "." . components------------------------------------------------------------------------------------removePrefix :: FilePath -> FilePath -> FilePath-removePrefix pre path = joinPath $ step (fn pre) (fn path) - where- fn = splitPath . normalise- step (x:xs) (y:ys) | x == y = step xs ys - step _ ys = ys------------------------------------------------------------------------------------resolveToCabalFileLoc :: FilePath -> FilePath -> FilePath-resolveToCabalFileLoc cabal_file src_file = - (dropFileName cabal_file) `combine` src_file
src/Precis/ReportMonad.hs view
@@ -33,6 +33,7 @@ , liftIO , tellHtml+ , tellUnresolved , tellParseFail , incrRemovedModules@@ -48,9 +49,11 @@ ) where -import Precis.Datatypes-import Precis.Utils +import Precis.Cabal.Datatypes+import Precis.HsSrc.Datatypes+import Precis.Utils.Common+ import Language.Haskell.Exts ( Module ) -- package: haskell-src-exts import Text.XHtml hiding ( name ) -- package: xhtml @@ -75,8 +78,9 @@ fmap f (OLD a) = OLD (f a) data ChangeStats = ChangeStats - { unparseable_modules :: [CMP StrName]- , removed_modules :: Int+ { unresolved_mods :: [CMP StrName]+ , unparseable_mods :: [CMP StrName]+ , removed_mods :: Int -- exports from a module , removed_exports :: Int@@ -96,7 +100,7 @@ } deriving (Show) -type ModuleParseFunction = SourceFile -> IO (Either ModuleParseError Module)+type ModuleParseFunction = HsSourceFile -> IO (Either ModuleParseError Module) data ReportLevel = JUST_MSG | MSG_AND_HTML deriving (Eq,Show)@@ -128,7 +132,7 @@ log_zero :: Log log_zero = ([],stats_zero) where- stats_zero = ChangeStats [] 0 0 0 0 0 0 0 0 0+ stats_zero = ChangeStats [] [] 0 0 0 0 0 0 0 0 0 runReportM :: ModuleParseFunction -> ReportLevel -> ReportM a -> IO (a,Log) runReportM pf lvl mf = (getReportM mf) (pf,lvl) log_zero `bindIO` post@@ -154,13 +158,17 @@ updateStats fn = ReportM $ \_ (hs,stats) -> returnIO ((),(hs, fn stats)) +tellUnresolved :: CMP StrName -> ReportM ()+tellUnresolved name = updateStats $ + pstar (\xs s -> s { unresolved_mods = name:xs}) unresolved_mods+ tellParseFail :: CMP StrName -> ReportM () tellParseFail name = updateStats $ - pstar (\xs s -> s { unparseable_modules = name:xs}) unparseable_modules+ pstar (\xs s -> s { unparseable_mods = name:xs}) unparseable_mods incrRemovedModules :: ReportM () incrRemovedModules = updateStats $- pstar (\i s -> s { removed_modules = i+1}) removed_modules+ pstar (\i s -> s { removed_mods = i+1}) removed_mods incrRemovedExports :: ReportM ()
src/Precis/TextOutput.hs view
@@ -21,16 +21,18 @@ , comparingMsg ) where -import Precis.Datatypes-import Precis.PPShowS+import Precis.Cabal.Datatypes import Precis.ReportMonad+import Precis.Utils.PPShowS import Data.Maybe showChangeStats :: ChangeStats -> ShowS showChangeStats = vsep . catMaybes . sequence funs where- funs = [ unparseableModules, removedModules+ funs = [ unresolvedModules+ , unparseableModules+ , removedModules , removedExports, changedExports , removedDatatypes, changedDatatypes , removedTypeSigs, changedTypeSigs@@ -38,8 +40,20 @@ ] ++unresolvedModules :: ChangeStats -> Maybe ShowS+unresolvedModules = step . unresolved_mods + where+ step [] = Nothing+ step xs = Just $ prolog $ vsep $ map fn xs++ fn (NEW s) = space <> text s <+> parens (text "new")+ fn (OLD s) = space <> text s <+> parens (text "old")++ prolog k = text "The following modules could not be found: " `line` k+ unparseableModules :: ChangeStats -> Maybe ShowS-unparseableModules = step . unparseable_modules +unparseableModules = step . unparseable_mods where step [] = Nothing step xs = Just $ prolog $ vsep $ map fn xs@@ -52,7 +66,7 @@ removedModules :: ChangeStats -> Maybe ShowS removedModules = - countMsg "removed" "exposed module" "exposed modules" . removed_modules+ countMsg "removed" "exposed module" "exposed modules" . removed_mods removedExports :: ChangeStats -> Maybe ShowS removedExports = @@ -99,7 +113,7 @@ -------------------------------------------------------------------------------- -comparingMsg :: CabalPrecis -> CabalPrecis -> ShowS+comparingMsg :: Package -> Package -> ShowS comparingMsg new old = suffixEllipses $ hsep $ map text [ "Comparing", package_name new, package_version new , "to", package_name old, package_version old
− src/Precis/Utils.hs
@@ -1,78 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Precis.Utils--- Copyright : (c) Stephen Tetley 2010--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------ Utils---------------------------------------------------------------------------------------module Precis.Utils- (- unlist-- , H - , snocH- , toListH- - , onSuccess- , onSuccessM-- , pstar- , pstar2--- ) where---import Control.Monad--unlist :: [String] -> String-unlist [] = ""-unlist [w] = w-unlist (w:ws) = w ++ ',' : ' ' : unwords ws---- Hughes lists--type H a = [a] -> [a]--snocH :: H a -> a -> H a-snocH f a = f . (a:)--toListH :: H a -> [a]-toListH = ($ [])-- -onSuccess :: Monad m => Either a b -> (b -> m c) -> m (Either a c)-onSuccess (Left a) _ = return (Left a)-onSuccess (Right b) mf = liftM Right $ mf b -- -onSuccessM :: Monad m => m (Either a b) -> (b -> m c) -> m (Either a c)-onSuccessM ma msk = ma >>= step - where- step (Left a) = return (Left a)- step (Right b) = liftM Right $ msk b ------------------------------------------------------------------------------------- pstars - starling combinator with args permuted--- useful for record updates--pstar :: (a -> r -> ans) - -> (r -> a) - -> r -> ans-pstar f fa x = f (fa x) x--pstar2 :: (a -> b -> r -> ans) - -> (r -> a) -> (r -> b) - -> r -> ans-pstar2 f fa fb x = f (fa x) (fb x) x-
+ src/Precis/Utils/Common.hs view
@@ -0,0 +1,145 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Utils.Common+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Utils+--+--------------------------------------------------------------------------------+++module Precis.Utils.Common+ (+ -- * Hughes list+ H+ , emptyH+ , wrapH+ , consH+ , snocH+ , appendH+ , veloH+ , concatH+ + , toListH+ , fromListH++ -- * Others + , unlist++ , mapLeft+ , mapRight+ + , onSuccessM++ , pstar+ , pstar2+ , star + , star2++ ) where+++import Control.Monad+++-- Hughes lists++type H a = [a] -> [a]++infixr 2 `snocH`+++emptyH :: H a+emptyH = id++wrapH :: a -> H a+wrapH a = consH a id ++consH :: a -> H a -> H a+consH a f = (a:) . f++snocH :: H a -> a -> H a+snocH f a = f . (a:)++appendH :: H a -> H a -> H a+appendH f g = f . g+++-- | Traverse a list as per 'map' applying the supplied function +-- to each element, *but* pruduce a Hughes list as output.+--+-- +-- +veloH :: (a -> b) -> [a] -> H b+veloH _ [] = id+veloH f (x:xs) = consH (f x) $ veloH f xs ++concatH :: [H a] -> H a+concatH = foldr (.) id+++toListH :: H a -> [a]+toListH = ($ [])++fromListH :: [a] -> H a+fromListH [] = id+fromListH xs = (xs++)++--------------------------------------------------------------------------------++unlist :: [String] -> String+unlist [] = ""+unlist [w] = w+unlist (w:ws) = w ++ ',' : ' ' : unwords ws+++-- Where\'s the bifunctor class when you need it...++mapLeft :: (a -> s) -> Either a b -> Either s b+mapLeft f (Left a) = Left $ f a+mapLeft _ (Right b) = Right b++mapRight :: (b -> t) -> Either a b -> Either a t+mapRight _ (Left a) = Left a+mapRight f (Right b) = Right $ f b+++ + +onSuccessM :: Monad m => m (Either a b) -> (b -> m c) -> m (Either a c)+onSuccessM ma msk = ma >>= step + where+ step (Left a) = return (Left a)+ step (Right b) = liftM Right $ msk b ++--------------------------------------------------------------------------------+-- pstars - starling combinator with args permuted+-- useful for record updates++pstar :: (a -> r -> ans) + -> (r -> a) + -> r -> ans+pstar f fa x = f (fa x) x++pstar2 :: (a -> b -> r -> ans) + -> (r -> a) -> (r -> b) + -> r -> ans+pstar2 f fa fb x = f (fa x) (fb x) x++star :: (r -> a) + -> (a -> r -> ans) + -> r -> ans+star fa f x = f (fa x) x++star2 :: (r -> a) -> (r -> b) + -> (a -> b -> r -> ans) + -> r -> ans+star2 fa fb f x = f (fa x) (fb x) x+
+ src/Precis/Utils/ControlOperators.hs view
@@ -0,0 +1,59 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Utils.ControlOperators+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- ALL NAMES PROVISIONAL...+--+--------------------------------------------------------------------------------+++module Precis.Utils.ControlOperators+ (+ suppress+ , elaborate++ , firstSuccess+ , valid+ , validE++ ) where++++suppress :: Either e a -> Maybe a+suppress (Right a) = Just a+suppress _ = Nothing++elaborate :: e -> Maybe a -> Either e a+elaborate ex Nothing = Left ex+elaborate _ (Just a) = Right a +++++-- | Apply the function to the list+firstSuccess :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)+firstSuccess mf xs0 = step xs0 + where+ step [] = return Nothing+ step (x:xs) = mf x >>= \ans -> case ans of+ Just a -> return $ Just a+ Nothing -> step xs+ +++valid :: Monad m => (a -> m Bool) -> a -> m (Maybe a)+valid test a = test a >>= \ans -> + if ans then return (Just a) else return Nothing++validE :: Monad m => ex -> (a -> m Bool) -> a -> m (Either ex a)+validE ex test a = test a >>= \ans -> + if ans then return (Right a) else return (Left ex)
+ src/Precis/Utils/PPShowS.hs view
@@ -0,0 +1,246 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Precis.Utils.PPShowS+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Pretty print combinators for ShowS+--+--------------------------------------------------------------------------------+++module Precis.Utils.PPShowS+ (++ toString+ , putShowS+ , putShowSLine++ , punctuate+ , encloseSep+ , list + , tupled+ , semiBrace++ , hcat + , hsep+ , vsep+ , (<>)+ , (<+>)++ , sep+ , line++ , squotes+ , dquotes+ , braces+ , parens+ , angles+ , brackets++ , lparen+ , rparen+ , langle+ , rangle+ , lbrace+ , rbrace+ , lbracket+ , rbracket++ , sglquote+ , dblquote+ , semi+ , colon+ , comma+ , space+ , dot+ , equal+ , backslash+ , newline+ , bar++ , empty+ , text + , char+ , int++ , repeatChar+ , prefixLines+ , nextLine++ ) where++infixr 5 `line`+infixr 6 <>,<+>++toString :: ShowS -> String+toString = ($ [])++putShowS :: ShowS -> IO ()+putShowS = putStr . toString++putShowSLine :: ShowS -> IO ()+putShowSLine = putStrLn . toString+++punctuate :: ShowS -> [ShowS] -> [ShowS]+punctuate _ [] = []+punctuate _ [x] = [x]+punctuate s (x:xs) = (x . s) : punctuate s xs++encloseSep :: ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS+encloseSep l r _ [] = l . r+encloseSep l r _ [x] = l . x . r+encloseSep l r s xs = l . hcat (punctuate s xs) . r++list :: [ShowS] -> ShowS+list = encloseSep lbracket rbracket comma++tupled :: [ShowS] -> ShowS+tupled = encloseSep lparen rparen comma++semiBrace :: [ShowS] -> ShowS+semiBrace = encloseSep lbrace rbrace semi++hcat :: [ShowS] -> ShowS+hcat = fold (.)++hsep :: [ShowS] -> ShowS+hsep = fold sep++vsep :: [ShowS] -> ShowS+vsep = fold line+++(<>) :: ShowS -> ShowS -> ShowS+(<>) = (.)++(<+>) :: ShowS -> ShowS -> ShowS+(<+>) f g = f <> space <> g+++fold :: (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS+fold _ [] = id+fold f xs = foldr1 f xs++sep :: ShowS -> ShowS -> ShowS+x `sep` y = x . space . y ++line :: ShowS -> ShowS -> ShowS+x `line` y = x . newline . y++squotes :: ShowS -> ShowS+squotes = enclose sglquote sglquote++dquotes :: ShowS -> ShowS+dquotes = enclose dblquote dblquote++braces :: ShowS -> ShowS+braces = enclose lbrace rbrace++parens :: ShowS -> ShowS+parens = enclose lparen rparen++angles :: ShowS -> ShowS+angles = enclose langle rangle++brackets :: ShowS -> ShowS+brackets = enclose lbracket rbracket++enclose :: ShowS -> ShowS -> ShowS -> ShowS+enclose l r x = l . x . r++lparen :: ShowS+lparen = showChar '('++rparen :: ShowS+rparen = showChar ')'++langle :: ShowS+langle = showChar '<'++rangle :: ShowS+rangle = showChar '>'++lbrace :: ShowS+lbrace = showChar '{'++rbrace :: ShowS+rbrace = showChar '}'++lbracket :: ShowS+lbracket = showChar '['++rbracket :: ShowS+rbracket = showChar ']' +++sglquote :: ShowS+sglquote = showChar '\''+++dblquote :: ShowS+dblquote = showChar '"'++semi :: ShowS+semi = showChar ';'++colon :: ShowS+colon = showChar ':'++comma :: ShowS+comma = showChar ','++space :: ShowS+space = showChar ' '++dot :: ShowS+dot = showChar '.'++equal :: ShowS+equal = showChar '='++backslash :: ShowS+backslash = showChar '\\'++newline :: ShowS+newline = showChar '\n'++bar :: ShowS+bar = showChar '|'+++empty :: ShowS+empty = id++text :: String -> ShowS+text = showString++char :: Char -> ShowS+char = showChar++int :: Int -> ShowS+int = shows+++repeatChar :: Int -> Char -> ShowS+repeatChar i = showString . replicate i+++prefixLines :: ShowS -> String -> ShowS+prefixLines pre xs = vsep $ map ((pre <>) . text) $ lines xs++-- | Note - this function evaluates the second arg and uses (++) +-- via 'showString'.+--+nextLine :: ShowS -> ShowS -> ShowS+nextLine f g = step $ toString g + where+ step str | null str = f+ | otherwise = f `line` (showString str)
src/Precis/VersionNumber.hs view
@@ -24,4 +24,4 @@ -- | Version number -- precis_version_number :: String-precis_version_number = "0.4.0"+precis_version_number = "0.5.0"