gpah (empty) → 0.0.1
raw patch · 41 files changed
+1949/−0 lines, 41 filesdep +Cabaldep +HTTPdep +basesetup-changed
Dependencies added: Cabal, HTTP, base, bytestring, cmdargs, containers, csv, deepseq, directory, filepath, haskell-src-exts, hint, network, process, syb, tar, uniplate, uu-parsinglib, zlib
Files
- LICENSE +28/−0
- README.html +52/−0
- README.md +62/−0
- Setup.lhs +4/−0
- gpah.cabal +79/−0
- src/Generics/GPAH/Base.hs +53/−0
- src/Generics/GPAH/Conf.hs +48/−0
- src/Generics/GPAH/Cpp.hs +10/−0
- src/Generics/GPAH/Cpp/Analyze.hs +16/−0
- src/Generics/GPAH/Cpp/Base.hs +3/−0
- src/Generics/GPAH/Cpp/PPrint.hs +17/−0
- src/Generics/GPAH/Date.hs +10/−0
- src/Generics/GPAH/Date/Analyze.hs +45/−0
- src/Generics/GPAH/Date/Base.hs +39/−0
- src/Generics/GPAH/Date/PPrint.hs +23/−0
- src/Generics/GPAH/Derive.hs +10/−0
- src/Generics/GPAH/Derive/Analyze.hs +97/−0
- src/Generics/GPAH/Derive/Base.hs +131/−0
- src/Generics/GPAH/Derive/PPrint.hs +22/−0
- src/Generics/GPAH/Deriving.hs +10/−0
- src/Generics/GPAH/Deriving/Analyze.hs +174/−0
- src/Generics/GPAH/Deriving/Base.hs +115/−0
- src/Generics/GPAH/Deriving/PPrint.hs +43/−0
- src/Generics/GPAH/Function.hs +10/−0
- src/Generics/GPAH/Function/Analyze.hs +47/−0
- src/Generics/GPAH/Function/Base.hs +46/−0
- src/Generics/GPAH/Function/PPrint.hs +35/−0
- src/Generics/GPAH/Hackage.hs +10/−0
- src/Generics/GPAH/Hackage/Analyze.hs +61/−0
- src/Generics/GPAH/Hackage/Base.hs +35/−0
- src/Generics/GPAH/Hackage/PPrint.hs +28/−0
- src/Generics/GPAH/Interp.hs +10/−0
- src/Generics/GPAH/Interp/Analyze.hs +31/−0
- src/Generics/GPAH/Interp/Base.hs +25/−0
- src/Generics/GPAH/Interp/PPrint.hs +22/−0
- src/Generics/GPAH/Main.hs +140/−0
- src/Generics/GPAH/Upl.hs +10/−0
- src/Generics/GPAH/Upl/Analyze.hs +34/−0
- src/Generics/GPAH/Upl/Base.hs +30/−0
- src/Generics/GPAH/Upl/PPrint.hs +22/−0
- src/Generics/GPAH/Utils.hs +262/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2013 Nikolaos Bezirgiannis, Johan Jeuring, Sean Leather+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of Johan Jeuring nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README.html view
@@ -0,0 +1,52 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">+<html xmlns="http://www.w3.org/1999/xhtml">+<head>+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />+ <meta http-equiv="Content-Style-Type" content="text/css" />+ <meta name="generator" content="pandoc" />+ <title></title>+</head>+<body>+<h1 id="gp-analysis-of-hackage-readme">GP analysis of Hackage README</h1>+<p>For the report and documentation of the project, check the file <code>report.pdf</code></p>+<p>There is also the presentation we gave at the file <code>presentation.pdf</code></p>+<h2 id="building">Building</h2>+<pre><code>runghc Setup.lhs configure+runghc Setup.lhs build+runghc Setup.lhs install</code></pre>+<h1 id="before-running">Before running</h1>+<p>You have to fetch the the entire hackage repository and its activity log. You can automatically do that with:</p>+<pre><code>gpah --fetch</code></pre>+<h2 id="running-the-analysis">Running the analysis</h2>+<p>After building the program, run it with</p>+<p><code>gpah args</code></p>+<pre><code>Generic Programming Use in Hackage Project v0.0.1++gpah [OPTIONS]++Common flags:+ --fetch Fetch the Hackage archive tarball and Hackage+ activity log+ -d --deriving[=FILE] Run the deriving analysis and output it to the+ specified file+ -f --function[=FILE] Run the function analysis and output it to the+ specified file+ -u --uniplate[=FILE] Run the uniplate analysis and output it to the+ specified file+ -h --misc_hackage[=FILE] Print general analysis info or output it to the+ specified file+ -t --misc_date[=FILE] Get syb+uniplate date info and output it to the+ specified file (implies --misc_hackage)+ --hackage-dir=DIR Set the hackage archive directory+ --hackage-log=FILE Set the hackage archive log file+ -c --cpp[=FILE] Run preprocessing in hackage that yields an+ analysis with less failed-to-parse modules+ -i --interpret[=FILE] Do type-checking interpretation on modules that+ depend on SYB or Uniplate+ -e --derive[=FILE] Do analysis on packages that build on derive+ -? --help Display help message+ -V --version Print version information</code></pre>+<p>For a detailed description of the accepted arguments run:</p>+<p><code>gpah --help</code></p>+</body>+</html>
+ README.md view
@@ -0,0 +1,62 @@+# GP analysis of Hackage README++For the report and documentation of the project, check the file `report.pdf`++There is also the presentation we gave at the file `presentation.pdf`++## Building++~~~+runghc Setup.lhs configure+runghc Setup.lhs build+runghc Setup.lhs install+~~~+++# Before running++You have to fetch the the entire hackage repository and its activity log. You can automatically do that with:++~~~+gpah --fetch+~~~+++## Running the analysis++After building the program, run it with++`gpah args`++~~~+Generic Programming Use in Hackage Project v0.0.1++gpah [OPTIONS]++Common flags:+ --fetch Fetch the Hackage archive tarball and Hackage+ activity log+ -d --deriving[=FILE] Run the deriving analysis and output it to the+ specified file+ -f --function[=FILE] Run the function analysis and output it to the+ specified file+ -u --uniplate[=FILE] Run the uniplate analysis and output it to the+ specified file+ -h --misc_hackage[=FILE] Print general analysis info or output it to the+ specified file+ -t --misc_date[=FILE] Get syb+uniplate date info and output it to the+ specified file (implies --misc_hackage)+ --hackage-dir=DIR Set the hackage archive directory+ --hackage-log=FILE Set the hackage archive log file+ -c --cpp[=FILE] Run preprocessing in hackage that yields an+ analysis with less failed-to-parse modules+ -i --interpret[=FILE] Do type-checking interpretation on modules that+ depend on SYB or Uniplate+ -e --derive[=FILE] Do analysis on packages that build on derive+ -? --help Display help message+ -V --version Print version information+~~~++For a detailed description of the accepted arguments run:++`gpah --help`
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ gpah.cabal view
@@ -0,0 +1,79 @@+name: gpah+version: 0.0.1+synopsis: Generic Programming Use in Hackage+description: Generic Programming Use in Hackage:+category: Generics+copyright: (c) 2013 Nikolaos Bezirgiannis, Johan Jeuring, Sean Leather+license: BSD3+license-file: LICENSE+author: Nikolaos Bezirgiannis, Johan Jeuring, Sean Leather+maintainer: n.bezirgiannis@students.uu.nl+stability: provisional+extra-source-files: README.html,+ README.md+build-type: Simple+cabal-version: >= 1.8+tested-with: GHC == 7.6.1+ +Executable gpah+ Main-is: Generics/GPAH/Main.hs+ build-depends: base >= 3.0 && < 5, + cmdargs, + haskell-src-exts, + filepath, + Cabal >= 1.16.0, + directory, + deepseq, + bytestring, + containers >= 0.4.2.0, + syb, + uniplate, + process, + csv, + hint, + network, + HTTP, + tar, + zlib, + uu-parsinglib+ ghc-options: -rtsopts -with-rtsopts=-K50m+ hs-source-dirs: src+ other-modules: Generics.GPAH.Base,+ Generics.GPAH.Conf,+ Generics.GPAH.Cpp,+ Generics.GPAH.Cpp.Analyze+ Generics.GPAH.Cpp.Base+ Generics.GPAH.Cpp.PPrint+ Generics.GPAH.Date,+ Generics.GPAH.Date.Analyze+ Generics.GPAH.Date.Base+ Generics.GPAH.Date.PPrint+ Generics.GPAH.Derive,+ Generics.GPAH.Derive.Analyze+ Generics.GPAH.Derive.Base+ Generics.GPAH.Derive.PPrint+ Generics.GPAH.Deriving,+ Generics.GPAH.Deriving.Analyze+ Generics.GPAH.Deriving.Base+ Generics.GPAH.Deriving.PPrint+ Generics.GPAH.Function,+ Generics.GPAH.Function.Analyze+ Generics.GPAH.Function.Base+ Generics.GPAH.Function.PPrint+ Generics.GPAH.Hackage,+ Generics.GPAH.Hackage.Analyze+ Generics.GPAH.Hackage.Base+ Generics.GPAH.Hackage.PPrint+ Generics.GPAH.Interp,+ Generics.GPAH.Interp.Analyze+ Generics.GPAH.Interp.Base+ Generics.GPAH.Interp.PPrint+ Generics.GPAH.Upl,+ Generics.GPAH.Upl.Analyze+ Generics.GPAH.Upl.Base+ Generics.GPAH.Upl.PPrint+ Generics.GPAH.Utils++ ++
+ src/Generics/GPAH/Base.hs view
@@ -0,0 +1,53 @@+module Generics.GPAH.Base where++import qualified Generics.GPAH.Cpp.Base as Cpp+import qualified Generics.GPAH.Deriving.Base as Deriving+import qualified Generics.GPAH.Function.Base as Function+import qualified Generics.GPAH.Upl.Base as Upl+import qualified Generics.GPAH.Hackage.Base as Hackage+import qualified Generics.GPAH.Date.Base as Date+import qualified Generics.GPAH.Interp.Base as Interp+import qualified Generics.GPAH.Derive.Base as Derive++import Data.Maybe++import Control.DeepSeq++import Data.Monoid++data Analysis = Analysis {+ cppAnalysis :: Cpp.Analysis+ , derAnalysis :: Deriving.Analysis+ , funAnalysis :: Function.Analysis+ , uplAnalysis :: Upl.Analysis+ , hacAnalysis :: Hackage.Analysis+ , dteAnalysis :: Date.Analysis+ , intAnalysis :: Interp.Analysis+ , dveAnalysis :: Derive.Analysis+ } + deriving (Show)++instance NFData Analysis where+ rnf (Analysis a1 a2 a3 a4 a5 a6 a7 a8) = a1+ `deepseq` a2+ `deepseq` a3+ `deepseq` a4+ `deepseq` a5+ `deepseq` a6+ `deepseq` a7+ `deepseq` a8+ `deepseq` ()+++instance Monoid Analysis where+ mempty = Analysis mempty mempty mempty mempty mempty mempty mempty mempty+ (Analysis x1 x2 x3 x4 x5 x6 x7 x8) `mappend` (Analysis y1 y2 y3 y4 y5 y6 y7 y8) = Analysis+ (mappend x1 y1)+ (mappend x2 y2)+ (mappend x3 y3)+ (mappend x4 y4)+ (mappend x5 y5)+ (mappend x6 y6)+ (mappend x7 y7)+ (mappend x8 y8)+
+ src/Generics/GPAH/Conf.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Generics.GPAH.Conf where++import System.IO.Unsafe+import System.Console.CmdArgs+import Control.Monad+import Data.Maybe (maybe)++-- easier to have a top-level state for the conf+conf = unsafePerformIO getConf++getConf = cmdArgs confOpt++data Conf = Conf {+ fetchOpt :: Bool+ , derivingOpt :: Maybe FilePath+ , functionOpt :: Maybe FilePath+ , uniplateOpt :: Maybe FilePath+ , hackageOpt :: Maybe FilePath+ , dateOpt :: Maybe FilePath+ , hackageDirOpt :: FilePath+ , hackageLogOpt :: FilePath+ , cppOpt :: Maybe FilePath+ , intOpt :: Maybe FilePath+ , dveOpt :: Maybe FilePath+ } deriving (Show, Eq, Data, Typeable)++hasSubComponent :: Conf -> Bool+hasSubComponent (Conf fet der fun upl hac dte _ _ cpp int dve) = + maybe False (const True)+ (der `mplus` fun `mplus` upl `mplus` hac `mplus` dte `mplus` cpp `mplus` int `mplus` dve)++confOpt = Conf {+ fetchOpt = def &= explicit &= name "fetch" &= typFile &= help "Fetch the Hackage archive tarball and Hackage activity log"+ , derivingOpt = def &= explicit &= name "d" &= name "deriving" &= opt "d_analysis.csv" &= typFile &= help "Run the deriving analysis and output it to the specified file"+ , functionOpt = def &= explicit &= name "f" &= name "function" &= opt "f_analysis.csv" &= typFile &= help "Run the function analysis and output it to the specified file"+ , uniplateOpt = def &= explicit &= name "u" &= name "uniplate" &= opt "uni_analysis.csv" &= typFile &= help "Run the uniplate analysis and output it to the specified file"+ , hackageOpt = def &= explicit &= name "h" &= name "misc_hackage" &= opt "misc_hackage.csv" &= typFile &= help "Print general analysis info or output it to the specified file"+ , dateOpt = def &= explicit &= name "t" &= name "misc_date" &= opt "misc_date.csv" &= typFile &= help "Get syb+uniplate date info and output it to the specified file (implies --misc_hackage)"+ , hackageDirOpt = "hackage" &= explicit &= name "hackage-dir" &= typDir &= help "Set the hackage archive directory"+ , hackageLogOpt = "hackage.log" &= explicit &= name "hackage-log" &= typFile &= help "Set the hackage archive log file"+ , cppOpt = def &= explicit &= name "c" &= name "cpp" &= opt "c_analysis.csv" &= typFile &= help "Run preprocessing in hackage that yields an analysis with less failed-to-parse modules"+ , intOpt = def &= explicit &= name "i" &= name "interpret" &= opt "i_analysis.csv" &= typFile &= help "Do type-checking interpretation on modules that depend on SYB or Uniplate "+ , dveOpt = def &= explicit &= name "e" &= name "derive" &= opt "e_analysis.csv" &= typFile &= help "Do analysis on packages that build on derive"+ } &= summary "Generic Programming Use in Hackage Project v0.0.1" &= program "gpah"++
+ src/Generics/GPAH/Cpp.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Cpp (+ module Generics.GPAH.Cpp.Base+ ,module Generics.GPAH.Cpp.Analyze+ ,module Generics.GPAH.Cpp.PPrint+ )+where++import Generics.GPAH.Cpp.Base+import Generics.GPAH.Cpp.Analyze+import Generics.GPAH.Cpp.PPrint
+ src/Generics/GPAH/Cpp/Analyze.hs view
@@ -0,0 +1,16 @@+module Generics.GPAH.Cpp.Analyze where++import Generics.GPAH.Cpp.Base+import System.Process+import System.Exit+import Text.Printf+import Generics.GPAH.Utils+import Distribution.PackageDescription++analyzeModule :: FilePath -> FilePath -> GenericPackageDescription -> IO Analysis+analyzeModule fp pkgAbsDir cabal = do+ let cmd = (shell + (printf "ghc -cpp -E -optP-P %s %s -Wwarn %s" (cppOpts cabal) (ghcOpts cabal) fp)+ ) -- {cwd = Just pkgAbsDir}+ exitCode <- createProcess cmd >>= \ (_,_,_,ph) -> waitForProcess ph+ return $ if exitCode == ExitSuccess then [] else [fp]
+ src/Generics/GPAH/Cpp/Base.hs view
@@ -0,0 +1,3 @@+module Generics.GPAH.Cpp.Base where++type Analysis = [String] -- failed-to-cpp modules
+ src/Generics/GPAH/Cpp/PPrint.hs view
@@ -0,0 +1,17 @@+module Generics.GPAH.Cpp.PPrint where++import Generics.GPAH.Cpp.Base+import Text.CSV+import System.IO+++pprint :: Analysis -> FilePath -> IO ()+pprint x fp = do+ let p = [["FailedToCppModules", show $ length x]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Cpp Results:\n###############"+ putStrLn pCSV
+ src/Generics/GPAH/Date.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Date (+ module Generics.GPAH.Date.Base+ ,module Generics.GPAH.Date.Analyze+ ,module Generics.GPAH.Date.PPrint+ )+where++import Generics.GPAH.Date.Base+import Generics.GPAH.Date.Analyze+import Generics.GPAH.Date.PPrint
+ src/Generics/GPAH/Date/Analyze.hs view
@@ -0,0 +1,45 @@+module Generics.GPAH.Date.Analyze where++import Generics.GPAH.Utils+import Generics.GPAH.Date.Base+import qualified Generics.GPAH.Base+import qualified Generics.GPAH.Hackage.Base as Hackage++import Data.List+import qualified Data.Map as M+import Data.Function (on)+import Data.Monoid+++yearUpdatesToLib :: [String] -> [(Int, String)] -> M.Map Int Int+yearUpdatesToLib favLibs cLog = foldl (\ acc (year, pkg) -> if pkg `elem` favLibs + then M.insertWith (+) year 1 acc+ else acc) + M.empty cLog+yearNewToLib favLibs cLog = yearUpdatesToLib favLibs (nubBy ((==) `on` snd) cLog)+++cleanLog :: [[String]] -> [(Int, String)]+cleanLog = map cleanLog' where+ --cleanLog' [String] -> (PackageName, Year, Month)+ cleanLog' [_, _, _, _, _, y, _, pkg, _] = (read y :: Int, pkg)+ ++analyzeHackageLog :: String -> Generics.GPAH.Base.Analysis -> Generics.GPAH.Base.Analysis+analyzeHackageLog contents a = let hacTime = unwords $ take 6 $ words $ last $ lines contents+ log = map words $ lines contents :: [[String]]+ cLog = cleanLog log+ pus = M.findWithDefault [] "syb" $ (Hackage.reverseDeps . Generics.GPAH.Base.hacAnalysis) a -- packages that use syb+ puu = M.findWithDefault [] "uniplate" $ (Hackage.reverseDeps . Generics.GPAH.Base.hacAnalysis) a -- packages that use uniplate+ pud = M.findWithDefault [] "derive" $ (Hackage.reverseDeps . Generics.GPAH.Base.hacAnalysis) a -- packages that use uniplate+ -- construct a new base analysis and adds the date analysis+ in mempty {Generics.GPAH.Base.dteAnalysis = Analysis + (yearUpdatesToLib pus cLog) + (yearUpdatesToLib puu cLog) + (yearNewToLib pus cLog) + (yearNewToLib puu cLog) + hacTime+ (yearUpdatesToLib pud cLog)+ (yearNewToLib pud cLog)+ }+
+ src/Generics/GPAH/Date/Base.hs view
@@ -0,0 +1,39 @@+module Generics.GPAH.Date.Base where++import Control.DeepSeq+import Data.Monoid++import qualified Data.Map as M++data Analysis = Analysis {+ yearUpdatesToSyb :: M.Map Int Int+ , yearUpdatesToUpl :: M.Map Int Int+ , yearNewToSyb :: M.Map Int Int+ , yearNewToUpl :: M.Map Int Int+ , hackageTime :: String+ , yearUpdatesToDerive :: M.Map Int Int+ , yearNewToDerive :: M.Map Int Int+ }+ deriving (Show)++instance Monoid Analysis where+ mempty = Analysis mempty mempty mempty mempty mempty mempty mempty+ (Analysis x1 x2 x3 x4 x5 x6 x7) `mappend` (Analysis y1 y2 y3 y4 y5 y6 y7) = Analysis+ (M.unionWith (+) x1 y1)+ (M.unionWith (+) x2 y2)+ (M.unionWith (+) x3 y3)+ (M.unionWith (+) x4 y4)+ (x5 ++ y5)+ (M.unionWith (+) x6 y6)+ (M.unionWith (+) x7 y7)++instance NFData Analysis where+ rnf (Analysis a1 a2 a3 a4 a5 a6 a7) = a1 + `deepseq` a2+ `deepseq` a3+ `deepseq` a4+ `deepseq` a5+ `deepseq` a6+ `deepseq` a7+ `deepseq` ()+
+ src/Generics/GPAH/Date/PPrint.hs view
@@ -0,0 +1,23 @@+module Generics.GPAH.Date.PPrint where++import Generics.GPAH.Date.Base+import System.IO+import qualified Data.Map as M+import Text.CSV+ +pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis a1 a2 a3 a4 a5 a6 a7) fp = do+ let p = [["HackageArchiveCloneTime", a5],+ ["YearlyUpdatesToPackagesUsingSyb", show $ M.toList a1],+ ["YearlyUpdatesToPackagesUsingUniplate", show $ M.toList a2],+ ["YearlyUpdatesToPackagesUsingDerive", show $ M.toList a6],+ ["YearlyNewPackagesUsingSyb", show $ M.toList a3],+ ["YearlyNewPackagesUsingUniplate", show $ M.toList a4],+ ["YearlyNewPackagesUsingDerive", show $ M.toList a7]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Date Results:\n###############"+ putStrLn pCSV
+ src/Generics/GPAH/Derive.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Derive (+ module Generics.GPAH.Derive.Base+ ,module Generics.GPAH.Derive.Analyze+ ,module Generics.GPAH.Derive.PPrint+ )+where++import Generics.GPAH.Derive.Base+import Generics.GPAH.Derive.Analyze+import Generics.GPAH.Derive.PPrint
+ src/Generics/GPAH/Derive/Analyze.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE FlexibleContexts #-}+module Generics.GPAH.Derive.Analyze where++import Generics.GPAH.Derive.Base+import qualified Generics.GPAH.Hackage.Base as Hackage+import qualified Data.Map as M+import Data.Monoid+import Language.Haskell.Exts+import Language.Haskell.Exts.Comments+import Text.ParserCombinators.UU+import Text.ParserCombinators.UU.BasicInstances+import Text.ParserCombinators.UU.Utils++import Generics.SYB+++analyzeModule :: ParseResult (Module, [Comment]) -> Hackage.Analysis -> Analysis +analyzeModule (ParseOk (m, c)) hacPkg = Analysis+ (runDeriveTH m hacPkg)+ (runDerivePP c)+ (runDriftPP c)+ (runDriftGL c)+analyzeModule _ _ = mempty++runDeriveTH :: Module -> Hackage.Analysis -> M.Map String Int+runDeriveTH m hacPkg | "derive" `elem` (M.keys (Hackage.reverseDeps hacPkg)) = everything (M.unionWith (+)) (mempty `mkQ` thDecl) m+ where+ thDecl :: Splice -> M.Map String Int+ thDecl (ParenSplice (App (App (Var (UnQual (Ident "derive"))) (Var (UnQual (Ident class_)))) (TypQuote (UnQual (Ident dt))))) = M.singleton class_ 1+ thDecl (ParenSplice (App (App (Var (UnQual (Ident "derive"))) (Var (UnQual (Ident class_)))) (List dts))) = M.singleton class_ (length dts)+ thDecl (ParenSplice (App (App (Var (UnQual (Ident "derive"))) (List classes_ids)) (TypQuote (UnQual (Ident dt))))) = let classes = map (\ (Var (UnQual (Ident class_))) -> class_) classes_ids+ in+ M.fromList (zip classes (repeat 1))+ thDecl (ParenSplice (App (App (Var (UnQual (Ident "derive"))) (List classes_ids)) (List dts))) = let classes = map (\ (Var (UnQual (Ident class_))) -> class_) classes_ids+ in+ M.fromList (zip classes (repeat (length dts)))+ thDecl _ = mempty+runDeriveTH _ _ = mempty+++runDerivePP :: [Comment] -> M.Map String Int+runDerivePP cs = foldl (\ m r -> M.insertWith (+) r 1 m) mempty $ concatMap (\ (Comment ml _ s) -> case (ml, execParser pDerivePP s) of+ (True, (res, [])) -> res+ _ -> [] -- error in parsing or single-line+ ) cs++runDriftPP :: [Comment] -> M.Map String Int+runDriftPP cs = foldl (\ m r -> M.insertWith (+) r 1 m) mempty $ concatMap (\ (Comment _ _ s) -> case execParser pDriftPP s of+ (res, []) -> res+ _ -> [] -- error in parsing+ ) cs+++runDriftGL :: [Comment] -> M.Map String Int+runDriftGL cs =foldl (\ m r -> M.insertWith (+) r 1 m) mempty $ concatMap (\ (Comment _ _ s) -> case execParser pDriftGL s of+ (res, []) -> res+ _ -> [] -- error in parsing+ ) cs+++pDerivePP :: Parser [String]+pDerivePP = deriveStandalone <|> deriveInline+ where+ deriveInline :: Parser [String]+ deriveInline = pSym '!' *> pList1Sep (pSym ',') pcl <* pSpaces <* pSym '!'+ where+ pcl :: Parser String+ pcl =foldl1 (<|>) (map (\ c -> pSpaces *> pToken c) deriveClasses)+ deriveStandalone :: Parser [String]+ deriveStandalone = pSym '!' *> pSpaces *> pToken "deriving" *> pSpaces *> pToken "instance" *> pList1Sep (pSym ',') pcl <* pSpaces <* pSym '!'+ where+ pcl :: Parser String+ pcl =foldl1 (<|>) (map (\ c -> pSpaces *> pToken c) deriveClasses)++pDriftPP :: Parser [String]+pDriftPP = driftInline <|> driftStandalone+ where+ driftInline :: Parser [String]+ driftInline = pSym '!' *> pSpaces *> pToken "derive:" *> pList1Sep (pSym ',') pcl <* pSpaces <* pSym '!'+ where+ pcl :: Parser String+ pcl =foldl1 (<|>) (map (\ c -> pSpaces *> pToken c) driftClasses)+ driftStandalone :: Parser [String]+ driftStandalone = pSym '!' *> pSpaces *> pToken "for" *> pSpaces *> pMunch (`notElem` " \n\r") *> pSpaces *> pToken "derive:" *> pList1Sep (pSym ',') pcl <* pSpaces <* pSym '!'+ where+ pcl :: Parser String+ pcl =foldl1 (<|>) (map (\ c -> pSpaces *> pToken c) driftClasses)++pDriftGL :: Parser [String]+pDriftGL = driftGlobal+ where+ driftGlobal :: Parser [String]+ driftGlobal = pSym '!' *> pSpaces *> pToken "global:" *> pList1Sep (pSym ',') pcl <* pSpaces <* pSym '!'+ where+ pcl :: Parser String+ pcl =foldl1 (<|>) (map (\ c -> pSpaces *> pToken c) driftClasses)+
+ src/Generics/GPAH/Derive/Base.hs view
@@ -0,0 +1,131 @@+module Generics.GPAH.Derive.Base where++import qualified Data.Map as M+import Control.DeepSeq+import Data.Monoid++data Analysis = Analysis {+ deriveTH :: M.Map String Int-- derive directive strings+ , derivePP :: M.Map String Int+ , driftPP :: M.Map String Int+ , driftGL :: M.Map String Int+ }+ deriving (Show)++instance Monoid Analysis where+ mempty = Analysis mempty mempty mempty mempty+ (Analysis x1 x2 x3 x4) `mappend` (Analysis y1 y2 y3 y4) = Analysis+ (M.unionWith (+) x1 y1)+ (M.unionWith (+) x2 y2)+ (M.unionWith (+) x3 y3)+ (M.unionWith (+) x4 y4)+instance NFData Analysis where+ rnf (Analysis a1 a2 a3 a4) = a1 + `deepseq` a2+ `deepseq` a3+ `deepseq` a4+ `deepseq` ()++++deriveClasses = ["Arbitrary",+ "ArbitraryOld",+ "Arities",+ "Binary",+ "BinaryDefer",+ "Bounded",+ "Data",+ "DataAbstract",+ "Default",+ "Enum",+ "EnumCyclic",+ "Eq",+ "Fold",+ "Foldable",+ "From",+ "Fucntor",+ "Has",+ "Is",+ "JSON",+ "LazySet",+ "Lens",+ "Monoid",+ "NFData",+ "Ord",+ "Read",+ "Ref",+ "Serial",+ "Serialize",+ "Set",+ "Show",+ "Traversable",+ "Typeable",+ "UniplateDirect",+ "UniplateTypeable",+ "Update"]+ ++driftClasses = ["Binary",+ "GhcBinary",+ "Observable",+ "NFData",+ "Typeable",+ "FuncotrM",+ "HFoldable",+ "Monoid",+ "RMapM",+ "Term",+ "Bounded",+ "Enum",+ "Eq",+ "Ord",+ "Read",+ "Show",+ "ATermConvertible",+ "Haskell2Xml",+ "XmlContent",+ "Parse",+ "Query",+ "from",+ "get",+ "has",+ "is",+ "test",+ "un",+ "update"]+++defaultDerivations = ["makeArbitrary",+ "makeArbitraryOld",+ "makeArities",+ "makeBinary",+ "makeBinaryDefer",+ "makeBounded",+ "makeData",+ "makeDataAbstract",+ "makeDefault",+ "makeEnum",+ "makeEnumCyclic",+ "makeEq",+ "makeFold",+ "makeFoldable",+ "makeFrom",+ "makeFunctor",+ "makeHas",+ "makeIs",+ "makeJSON",+ "makeLazySet",+ "makeMonoid",+ "makeNFData",+ "makeOrd",+ "makeRead",+ "makeRef",+ "makeSerial",+ "makeSerialize",+ "makeSet",+ "makeShow",+ "makeTraversable",+ "makeTypeable",+ "makeUniplateDirect",+ "makeUniplateTypeable",+ "makeUpdate"]
+ src/Generics/GPAH/Derive/PPrint.hs view
@@ -0,0 +1,22 @@+module Generics.GPAH.Derive.PPrint where++import Generics.GPAH.Derive.Base+import Text.CSV+import System.IO+import qualified Data.Map as M+import Data.Function+import Data.List++pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis a1 a2 a3 a4) fp = do+ let p = [["DeriveTemplateHaskellDirectives", show $ sortBy (flip compare `on` snd) $ M.toList a1]+ ,["DerivePreprocessingDirectives", show $ sortBy (flip compare `on` snd) $ M.toList a2]+ ,["DrIFTNormalDirectives", show $ sortBy (flip compare `on` snd) $ M.toList a3]+ ,["DrIFTGlobalDirectives", show $ sortBy (flip compare `on` snd) $ M.toList a4] + ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Derive+DrIFT Results:\n###############"+ putStrLn pCSV
+ src/Generics/GPAH/Deriving.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Deriving (+ module Generics.GPAH.Deriving.Base+ ,module Generics.GPAH.Deriving.Analyze+ ,module Generics.GPAH.Deriving.PPrint+ )+where++import Generics.GPAH.Deriving.Base+import Generics.GPAH.Deriving.Analyze+import Generics.GPAH.Deriving.PPrint
+ src/Generics/GPAH/Deriving/Analyze.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, ScopedTypeVariables #-}+module Generics.GPAH.Deriving.Analyze where++import Generics.GPAH.Deriving.Base+import Generics.GPAH.Utils+import Language.Haskell.Exts+import Language.Haskell.Exts.Comments+import qualified Data.Map as M++import Data.List++import Data.Monoid++analyzeModule :: ParseResult (Module, [Comment]) -> Analysis+analyzeModule (ParseOk ((Module _ _ _ _ _ _ decls),_)) = foldr (\ decl acc -> analyzeDecl decl `mappend` acc) mempty decls+analyzeModule _ = mempty++analyzeDecl :: Decl -> Analysis++-- NORMAL+---------++-- data+analyzeDecl (DataDecl _ DataType _ _ name _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , normalStruct = 1+ , sizePos = (fromBool $ not $ null ds)+ , normalPos = (fromBool $ not $ null ds)+ , sizeDer = lds+ , normalDer = lds+ , topDer = (M.fromList $ zip nds (repeat 1))+ }+-- ok++-- newtype+analyzeDecl (DataDecl _ NewType _ _ name _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , normalStruct = 1+ , newtypeStructContains = 1+ , sizePos = (fromBool $ not $ null ds)+ , normalPos = (fromBool $ not $ null ds)+ , newtypePosContains = (fromBool $ not $ null ds)+ , sizeDer = lds+ , normalDer = lds+ , newtypeDerContains = lds+ }++-- ok++-- GADT+-------++-- data+analyzeDecl (GDataDecl _ DataType _ name _ _ _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , gadtStruct = 1+ , sizePos = (fromBool $ not $ null ds)+ , gadtPos = (fromBool $ not $ null ds)+ , sizeDer = lds+ , gadtDer = lds+ , topDer = (M.fromList $ zip nds (repeat 1))+ }++-- ok++-- newtype+analyzeDecl (GDataDecl _ NewType _ name _ _ _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , gadtStruct = 1+ , newtypeStructContains = 1+ , sizePos = (fromBool $ not $ null ds)+ , gadtPos = (fromBool $ not $ null ds)+ , newtypePosContains = (fromBool $ not $ null ds)+ , sizeDer = lds+ , gadtDer = lds+ , newtypeDerContains = lds+ }+-- ok++-- FAMSTRUCT+------------++-- data+analyzeDecl (DataInsDecl _ DataType _ _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , famStruct = 1+ , newtypeStructContains = 1+ , sizePos = (fromBool $ not $ null ds)+ , famPos = (fromBool $ not $ null ds)+ , newtypePosContains = (fromBool $ not $ null ds)+ , sizeDer = lds+ , famDer = lds+ , newtypeDerContains = lds+ }++-- ok++-- newtype+analyzeDecl (DataInsDecl _ NewType _ _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , famStruct = 1+ , newtypeStructContains = 1+ , sizePos = (fromBool $ not $ null ds)+ , famPos = (fromBool $ not $ null ds)+ , newtypePosContains = (fromBool $ not $ null ds)+ , sizeDer = lds+ , famDer = lds+ , newtypeDerContains = lds+ }++-- ok++-- GADTFAMSTRUCT+----------------++-- data+analyzeDecl (GDataInsDecl _ DataType typeParams _ _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , gadtFamStruct = 1+ , newtypeStructContains = 1+ , sizePos = (fromBool $ not $ null ds)+ , gadtFamPos = (fromBool $ not $ null ds)+ , newtypePosContains = (fromBool $ not $ null ds)+ , sizeDer = lds+ , gadtFamDer = lds+ , newtypeDerContains = lds+ }++-- ok++-- newtype+analyzeDecl (GDataInsDecl _ NewType typeParams _ _ ds) = let lds = length ds + nds = map derivingName ds+ in mempty {+ sizeStruct = 1+ , gadtFamStruct = 1+ , newtypeStructContains = 1+ , sizePos = (fromBool $ not $ null ds)+ , gadtFamPos = (fromBool $ not $ null ds)+ , newtypePosContains = (fromBool $ not $ null ds)+ , sizeDer = lds+ , gadtFamDer = lds+ , newtypeDerContains = lds+ }++-- ok++-- standalone deriving+analyzeDecl (DerivDecl _ _ derClass typeParams) = mempty { stdAloneDecl = 1}++analyzeDecl (InstDecl _ _ derClass typeParams _) = let isDeriveableInstance = qNameToString derClass `elem` deriveableClasses+ in mempty {+ sizeInst = 1+ , overloadInst = fromBool isDeriveableInstance+ , topOverload = if isDeriveableInstance + then M.singleton (qNameToString derClass) 1 + else M.empty+ }+ +analyzeDecl _ = mempty
+ src/Generics/GPAH/Deriving/Base.hs view
@@ -0,0 +1,115 @@+module Generics.GPAH.Deriving.Base where++import Language.Haskell.Exts+import Generics.GPAH.Utils+import Control.DeepSeq+import qualified Data.Map as M+import Data.Monoid++data Analysis = Analysis {+ sizeStruct :: Int+ , normalStruct :: Int+ , gadtStruct :: Int+ , famStruct :: Int+ , gadtFamStruct :: Int+ , newtypeStructContains :: Int+ , sizePos :: Int+ , normalPos :: Int+ , gadtPos :: Int+ , famPos :: Int+ , gadtFamPos :: Int+ , newtypePosContains :: Int+ , sizeDer :: Int+ , normalDer :: Int+ , gadtDer :: Int+ , famDer :: Int+ , gadtFamDer :: Int+ , newtypeDerContains :: Int+ , stdAloneDecl :: Int -- == stdAloneStruct == stdAlonePos+ , topDer :: M.Map ClassName Int+ , sizeInst :: Int+ , overloadInst :: Int+ , topOverload :: M.Map ClassName Int+ }+ deriving (Show)++instance Monoid Analysis where+ mempty = Analysis 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 mempty 0 0 mempty+ (Analysis x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23) `mappend` (Analysis y1 y2 y3 y4 y5 y6 y7 y8 y9 y10 y11 y12 y13 y14 y15 y16 y17 y18 y19 y20 y21 y22 y23) = Analysis+ (x1+y1)+ (x2+y2)+ (x3+y3)+ (x4+y4)+ (x5+y5)+ (x6+y6)+ (x7+y7)+ (x8+y8)+ (x9+y9)+ (x10+y10)+ (x11+y11)+ (x12+y12)+ (x13+y13)+ (x14+y14)+ (x15+y15)+ (x16+y16)+ (x17+y17)+ (x18+y18)+ (x19+y19)+ (M.unionWith (+) x20 y20)+ (x21+y21)+ (x22+y22)+ (M.unionWith (+) x23 y23)+++instance NFData Analysis where+ rnf (Analysis a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23) = a1+ `deepseq` a2+ `deepseq` a3+ `deepseq` a4+ `deepseq` a5+ `deepseq` a6+ `deepseq` a7+ `deepseq` a8+ `deepseq` a9+ `deepseq` a10+ `deepseq` a11+ `deepseq` a12+ `deepseq` a13+ `deepseq` a14+ `deepseq` a15+ `deepseq` a16+ `deepseq` a17+ `deepseq` a18+ `deepseq` a19+ `deepseq` a20+ `deepseq` a21+ `deepseq` a22+ `deepseq` a23+ `deepseq` ()+++-- instead of Normal, more precise DataDecl, GDataDecl, GDataInsDecl+data DerivingType = Normal | StandAlone | Overload+ deriving (Eq, Read, Show)++instance NFData DerivingType where+ rnf a = a `seq` ()++-- haskell98 [Eq, Ord, Enum, Ix Bounded, Show, Read]+-- ghc [Data, Typeable, Generic, Functor, Foldable, Traversable]++deriveableClasses = ["Bounded", "Data", "Enum", "Eq", "Functor", "Foldable", "Ix", "Ord", "Read", "Show", "Traversable", "Typeable", "Generic"]+nonGNDClasses = ["Read", "Show", "Typeable","Data"] -- classes that are not **inherited** when in generalized newtype deriving, but instead derived++derivingName :: Deriving -> String+derivingName (qName, _) = qNameToString qName++nameToString :: Name -> String+nameToString (Ident s) = s+nameToString (Symbol s) = s++qNameToString :: QName -> String+qNameToString (UnQual name) = nameToString name+qNameToString (Qual (ModuleName _mname) name) = nameToString name -- we don't have to care about qualified probably+qNameToString (Special specialCon) = show specialCon+
+ src/Generics/GPAH/Deriving/PPrint.hs view
@@ -0,0 +1,43 @@+module Generics.GPAH.Deriving.PPrint where++import Generics.GPAH.Deriving.Base+import Text.CSV+import System.IO+import qualified Data.Map as M+import Data.Function+import Data.List++pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23) fp = do+ let p = [["NumberOfDataStructures (Normal+GADT+FamStruct+GADTFamStruct)", show a1],+ ["NormalStructures", show a2],+ ["GadtStructures", show a3],+ ["FamStructures", show a4],+ ["GadtFamStructures", show a5],+ ["StructuresThatAreNewtype", show a6],+ ["StructuresThatContainAnInlineDeriving", show a7],+ ["NormalThatContainAnInlineDeriving", show a8],+ ["GadtThatContainAnInlineDeriving", show a9],+ ["FamStructThatContainAnInlineDeriving", show a10],+ ["GadtFamStructThatContainAnInlineDeriving", show a11],+ ["NewtypeThatContainAnInlineDeriving", show a12],+ ["NumberOfDerivedInstancesInAnyStruct", show a13],+ ["DerivedInstancesInNormal", show a14],+ ["DerivedInstancesInGadt", show a15],+ ["DerivedInstancesInFamStruct", show a16],+ ["DerivedInstancesInGadtFamStruct", show a17],+ ["DerivedInstancesInNewtype", show a18],+ ["StandaloneDerivingDeclarations", show a19],+ ["TopDerivedClasses", show $ sortBy (flip compare `on` snd) $ M.toList a20],+ ["InstancesChecked", show a21],+ ["InstancesPreferredToWriteManualThanAutoDerive", show $ a22],+ ["TopManual", show $ sortBy (flip compare `on` snd) $ M.toList a23],+ ["PossibleGenericity (Data+Typeable+Generic) Derived", show $ sum $ map (flip (M.findWithDefault 0) a20) ["Data","Typeable","Generic"]],+ ["PossibleGenericity (Data+Typeable+Generic) Manual", show $ sum $ map (flip (M.findWithDefault 0) a23) ["Data","Typeable","Generic"]]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Deriving Results:\n###############"+ putStrLn pCSV
+ src/Generics/GPAH/Function.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Function (+ module Generics.GPAH.Function.Base+ ,module Generics.GPAH.Function.Analyze+ ,module Generics.GPAH.Function.PPrint+ )+where++import Generics.GPAH.Function.Base+import Generics.GPAH.Function.Analyze+import Generics.GPAH.Function.PPrint
+ src/Generics/GPAH/Function/Analyze.hs view
@@ -0,0 +1,47 @@+module Generics.GPAH.Function.Analyze where++import Generics.GPAH.Function.Base+import Generics.GPAH.Utils+import Language.Haskell.Exts+import Language.Haskell.Exts.Comments+import Generics.GPAH.Hackage.Analyze++-- Cabal-related imports+import Distribution.PackageDescription hiding (Var)++import Data.Generics+import qualified Data.List as L+import qualified Data.Map as M++import Data.Monoid++-- | Constructs a list of keywords to search for+constructSearchList :: M.Map String [String] -> [String]+constructSearchList m = foldr (++) [] $ M.elems m++-- | if the given variable is the given function to search for a 1 is returned else a 0+findN :: FavFunction -> Exp -> Int+findN n e@(Var n') = case n' of + UnQual i -> case i of+ Ident a -> if a == n then 1 else 0+ Symbol a -> if a == n then 1 else 0+ Qual _ i -> case i of+ Ident a -> if a == n then 1 else 0+ Symbol a -> if a == n then 1 else 0+ _ -> 0+findN _ _ = 0 ++-- | collects for a given module the number of occurences of a given function+collectOccs :: Module -> FavFunction -> Int+collectOccs m n = everything (+) (0 `mkQ` findN n) m++-- | executes the function analysis on a given module+analyzeModule :: ParseResult (Module, [Comment]) -> GenericPackageDescription -> Analysis+analyzeModule (ParseOk (modul@(Module sloc _ _ _ _ _ _),_)) gpkgdesc = + let toSearch = L.nub $ constructSearchList {-(getImportNames modul)-} favorites+ ds = cabalDepends gpkgdesc+ in if "uniplate" `elem` ds || "syb" `elem` ds -- if uniplate or syb as dep+ then Analysis $ M.fromList $ filter (\(_,nr) -> nr > 0) $ map (\x -> (x, collectOccs modul x)) toSearch+ else mempty++analyzeModule _ _ = mempty
+ src/Generics/GPAH/Function/Base.hs view
@@ -0,0 +1,46 @@+module Generics.GPAH.Function.Base where++import Generics.GPAH.Utils+import qualified Data.Map as M+import Control.DeepSeq+import Data.Monoid++type Import = String++type FavFunction = String -- Function-name to search for+type OneLvlUp = String -- Function one level up from where a match was found++newtype Analysis = Analysis (M.Map FavFunction Int) -- wrap it as a newtype, because we want to override Data.Map 's Monoid instance+ deriving (Show)++instance Monoid Analysis where+ mempty = Analysis mempty+ (Analysis x) `mappend` (Analysis y) = Analysis $ M.unionWith (+) x y++instance NFData Analysis where+ rnf (Analysis x) = x `deepseq` ()++-- | Functions to search for sorted per module+favorites :: M.Map String [String]+favorites = + M.fromList+ [("Data.Generics.Aliases" , ["mkT", "mkQ", "mkM", "mkMp", "mkR", "ext0", "extT", "extQ", "extM", "extMp", "extB", "extR", "orElse", "recoverMp", "recoverQ", "choiceMp", "choiceQ", "ext1", "ext1T", "ext1M", "ext1Q", "ext1R", "ext1B", "ext2T", "ext2M", "ext2Q", "ext2R", "ext2B"]),+ ("Data.Generics.Schemes" , ["everywhere","everywhere'","everywhereBut","everywhereM","somewhere","everything","everythingBut","listify","something","synthesize","gsize","glength","gdepth","gcount","gnodecount","gtypecount","gfindtype"]),+ ("Data.Generics.Text" , ["gshow", "gshows", "gread"]),+ ("Data.Generics.Twins" , ["gfoldlAccum","gmapAccumT","gmapAccumM","gmapAccumQl","gmapAccumQr","gmapAccumQ","gmapAccumA","gzipWithT","gzipWithM","gzipWithQ","geq","gzip"]),+ ("Data.Generics.Builders" , ["empty", "constrs"]),+ ("Generics.SYB.Aliases" , ["mkT", "mkQ", "mkM", "mkMp", "mkR", "ext0", "extT", "extQ", "extM", "extMp", "extB", "extR", "orElse", "recoverMp", "recoverQ", "choiceMp", "choiceQ", "ext1", "ext1T", "ext1M", "ext1Q", "ext1R", "ext1B", "ext2T", "ext2M", "ext2Q", "ext2R", "ext2B"]),+ ("Generics.SYB.Schemes" , ["everywhere","everywhere'","everywhereBut","everywhereM","somewhere","everything","everythingBut","listify","something","synthesize","gsize","glength","gdepth","gcount","gnodecount","gtypecount","gfindtype"]),+ ("Generics.SYB.Text" , ["gshow", "gshows", "gread"]),+ ("Generics.SYB.Twins" , ["gfoldlAccum","gmapAccumT","gmapAccumM","gmapAccumQl","gmapAccumQr","gmapAccumQ","gmapAccumA","gzipWithT","gzipWithM","gzipWithQ","geq","gzip"]),+ ("Generics.SYB.Builders" , ["empty", "constrs"]),+ ("Data.Data" , ["gfoldl","gunfold","toConstr", "dataTypeOf","dataCast1", "dataCast2", "gmapT","gmapQ","gmapQl","gmapQr","gmapQi","gmapM","gmapMp","gmapMo", "mkDataType","mkIntType", "mkFloatType","mkStringType", "mkCharType", "mkNoRepType", "mkNorepType", "dataTypeName","dataTypeRep","repConstr", "isAlgType", "dataTypeConstrs","indexConstr", "maxConstrIndex", "isNorepType","mkConstr", "mkIntConstr", "mkFloatConstr", "mkIntegralConstr","mkRealConstr", "mkStringConstr", "mkCharConstr", "constrType", "ConstrRep", "constrRep", "constrFields", "constrFixity", "constrIndex", "showConstr", "readConstr", "tyconUQname", "tyconModule", "fromConstr", "fromConstrB", "fromConstrM"]),+ ("Data.Typeable" , ["mkTyCon","mkTyCon3","mkTyConApp","mkAppTy","typeRepTyCon","typeOfDefault","typeOf1Default","typeOf2Default","typeOf3Default","typeOf4Default","typeOf5Default","typeOf6Default","mkFunTy","splitTyConApp","funResultTy","typeRepArgs","showsTypeRep","tyConString","listTc","funTc"]),+ ("Data.Generics.Uniplate.Operations", ["uniplate","descend","descendM","biplate","descendBi","descendBiM","universe","children","transform","transformM","rewrite","rewriteM","contexts","holes","para","universeBi","childrenBi","transformBi","transformBiM","rewriteBi","rewriteBiM","contextsBi","holesBi"]),+ ("Data.Generics.Uniplate.Direct" , ["plate", "plateSelf", "|+", "|-", "|*", "||+", "||*", "plateProject"]),+ ("Data.Generics.Uniplate.Zipper" , ["zipper", "zipperBi", "fromZipper","left", "right","up", "down","hole","replaceHole"]),+ ("Data.Generics.Uniplate.Data" , ["transformBis", "transformer"]),+ ("Data.Generics.SYB" , ["gmapT", "gmapQl", "gmapQr", "gmapQ", "gmapQi", "gmapM", "mkT", "everywhere", "mkM", "everywhereM", "mkQ", "everything"]),+ ("Data.Generics.Compos" , ["composOp", "composOpM", "composOpM_", "composOpMonoid", "composOpMPlus", "composOpFold"])+ ]+
+ src/Generics/GPAH/Function/PPrint.hs view
@@ -0,0 +1,35 @@+module Generics.GPAH.Function.PPrint where++import Generics.GPAH.Function.Base+import Text.CSV+import System.IO+import qualified Data.Map as M+import Data.Function+import Data.List++import System.IO++pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis m) fp = do+ let p = [["TotalFunctionOccurences", show $ M.foldl (+) 0 m],+ ["TopFunctions", show $ sortBy (flip compare `on` snd) $ M.toList m],+ ["Transformation/QueryRatio", show $ countT m / countQ m]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Function Results:\n###############"+ putStrLn pCSV+++countT :: M.Map FavFunction Int -> Double+countT m = count m tList+countQ :: M.Map FavFunction Int -> Double+countQ m = count m qList+-- | the list of transformation-functions to search for +tList = ["mkT","mkM","gmapT","everywhere", "everywhereM", "transform", "transformBi"]+-- | the list of query-functions to search for+qList = ["mkQ","gmapQ","everything", "universe", "universeBi"]++count m fs = toEnum $ foldl (\ acc f -> acc + M.findWithDefault 0 f m) 0 fs
+ src/Generics/GPAH/Hackage.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Hackage (+ module Generics.GPAH.Hackage.Base+ ,module Generics.GPAH.Hackage.Analyze+ ,module Generics.GPAH.Hackage.PPrint+ )+where++import Generics.GPAH.Hackage.Base+import Generics.GPAH.Hackage.Analyze+import Generics.GPAH.Hackage.PPrint
+ src/Generics/GPAH/Hackage/Analyze.hs view
@@ -0,0 +1,61 @@+module Generics.GPAH.Hackage.Analyze where++import Generics.GPAH.Hackage.Base+import Generics.GPAH.Utils+import qualified Data.Map as M++import Data.List (nub, intersect)+import Data.Monoid+++import Language.Haskell.Exts+import Language.Haskell.Exts.Comments+import Distribution.PackageDescription+import Distribution.Package++analyzeModule :: ParseResult (Module, [Comment]) -> Analysis+analyzeModule (ParseOk _) = mempty {parsedModules=1}+analyzeModule (ParseFailed (SrcLoc {srcFilename = hs}) _) = mempty {failedModules = [hs]}++analyzePackage :: String -> GenericPackageDescription -> Analysis+analyzePackage pkgname gpkgdesc = Analysis + 1 + 0+ []+ (fromBool usesGP) + (fromBool isExe)+ reverseDeps+ where+ ds = cabalDepends gpkgdesc+ usesGP = any (`elem` ds) libsGP+ isExe = cabalHasExecs gpkgdesc && usesGP+ reverseDeps = M.fromList (zip + (ds `intersect` libsGP) -- the gp deps of the pkg+ (repeat [pkgname])+ )+++++cabalHasExecs :: GenericPackageDescription -> Bool+cabalHasExecs (GenericPackageDescription _ _ _ execs _ _) = not $ null execs++cabalDepends :: GenericPackageDescription -> [String]+cabalDepends gpkgdesc = + let pds = pkgDepends gpkgdesc+ dName :: Dependency -> String+ dName (Dependency (PackageName s) _) = s+ dNames = nub $ map dName pds+ in dNames+++-- Takes a parsed Cabal GenericPackageDescription and return a list of Dependencies+pkgDepends :: GenericPackageDescription -> [Dependency] +pkgDepends (GenericPackageDescription pkgdesc _ lib execs tests _) = pkgdescDepends pkgdesc ++ libDepends lib ++ execsDepends execs ++ testsDepends tests+ where + pkgdescDepends = buildDepends+ libDepends mnode = maybe [] nodeDepends mnode+ execsDepends es = concatMap (nodeDepends . snd) es+ testsDepends = execsDepends+ nodeDepends :: CondTree v [Dependency] a -> [Dependency]+ nodeDepends (CondNode {condTreeConstraints = ds}) = ds
+ src/Generics/GPAH/Hackage/Base.hs view
@@ -0,0 +1,35 @@+module Generics.GPAH.Hackage.Base where+++import Control.DeepSeq+import Data.Monoid+import qualified Data.Map as M++data Analysis = Analysis {+ totalPackages :: Int+ , parsedModules :: Int+ , failedModules :: [String]+ , pkgsUsingGP :: Int+ , exesUsingGP :: Int+ , reverseDeps :: M.Map String [String]+ }+ deriving (Show)++instance NFData Analysis where+ rnf (Analysis a1 a2 a3 a4 a5 a6) = a1+ `deepseq` a2+ `deepseq` a3+ `deepseq` a4+ `deepseq` a5+ `deepseq` a6+ `deepseq` ()++instance Monoid Analysis where+ mempty = Analysis 0 0 [] 0 0 M.empty+ (Analysis x1 x2 x3 x4 x5 x6) `mappend` (Analysis y1 y2 y3 y4 y5 y6) = Analysis+ (x1+y1)+ (x2+y2)+ (x3++y3)+ (x4+y4)+ (x5+y5)+ (M.unionWith (++) x6 y6)
+ src/Generics/GPAH/Hackage/PPrint.hs view
@@ -0,0 +1,28 @@+module Generics.GPAH.Hackage.PPrint where++import Generics.GPAH.Hackage.Base+import Text.CSV+import System.IO+import qualified Data.Map as M+import Data.List+import Data.Function (on)+++pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis a1 a2 a3 a4 a5 a6) fp = do+ let p = [["TotalNumberOfPackagesInHackage", show a1],+ ["SuccessfullyParsedModules", show a2],+ ["FailedToParseModules", show $ length a3],+ ["PackagesUsingGP", show a4],+ ["PackagesUsingGPwithAnExe", show a5],+ ["PackagesUsingSyb", show $ maybe 0 length $ M.lookup "syb" a6],+ ["PackagesUsingUniplate", show $ maybe 0 length $ M.lookup "uniplate" a6],+ ["ReverseDeps", show $ sortBy (flip compare `on` snd) $ M.toList $ M.map length a6]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Hackage Results:\n###############"+ putStrLn pCSV+
+ src/Generics/GPAH/Interp.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Interp (+ module Generics.GPAH.Interp.Base+ ,module Generics.GPAH.Interp.Analyze+ ,module Generics.GPAH.Interp.PPrint+ )+where++import Generics.GPAH.Interp.Base+import Generics.GPAH.Interp.Analyze+import Generics.GPAH.Interp.PPrint
+ src/Generics/GPAH/Interp/Analyze.hs view
@@ -0,0 +1,31 @@+module Generics.GPAH.Interp.Analyze where++import Generics.GPAH.Interp.Base+import qualified Generics.GPAH.Hackage.Base as Hackage++import Generics.GPAH.Utils+import qualified Data.Map as M+import Data.List+import System.FilePath +import Data.Monoid+import Language.Haskell.Interpreter++analyzeModule :: FilePath -> FilePath -> FilePath -> Hackage.Analysis -> IO Analysis+analyzeModule hs pkgName pkgAbsSrcDir hacPkg | pkgName `elem` excludePkgs = return mempty -- some pkgs are excluded+ | otherwise = let moduleName = map (\ c -> if isPathSeparator c then '.' else c) -- make the / to .+ (dropExtension (makeRelative pkgAbsSrcDir hs))+ interpr :: Interpreter [String]+ interpr = do+ set [searchPath:=[pkgAbsSrcDir]]+ -- the interpreter takes .hs not .hspp+ loadModules [replaceExtension hs (if pkgName `elem` ["HaRe","KiCS-debugger","couchdb-conduit"] then ".lhs" else ".hs")]+ setTopLevelModules [moduleName]+ es <- getModuleExports moduleName -- :browse equivalent+ ts <- sequence [typeOf x | e@(Fun x) <- es] -- typecheck the function of the module+ let fts = filter (\ t -> any (`isInfixOf` t) intTypes) ts -- the type signatures that contain syb or uniplate+ return fts+ in if any (`elem` (M.keys (Hackage.reverseDeps hacPkg))) ["syb","uniplate"] -- does the package have syb or uniplate as revdep+ then print hs >> runInterpreter interpr >>= either + (\ res -> print res >> return mempty) -- failed to interpret+ (\ res -> return $ Analysis $ if null res then M.empty else M.singleton pkgName res)+ else return mempty -- module skipped
+ src/Generics/GPAH/Interp/Base.hs view
@@ -0,0 +1,25 @@+module Generics.GPAH.Interp.Base where+++import Control.DeepSeq+import Data.Monoid+import qualified Data.Map as M++newtype Analysis = Analysis (M.Map String [String]) -- PackageName to TypeSignatures+ deriving (Show)+++instance Monoid Analysis where+ mempty = Analysis mempty+ (Analysis x) `mappend` (Analysis y) = Analysis $ M.unionWith (++) x y++instance NFData Analysis where+ rnf (Analysis x) = x `deepseq` ()++intTypes = sybTypes ++ uplTypes++sybTypes = ["GenericQ", "GenericT", "GenericM", "GenericB", "GenericR", "Generic'", "Generic ", "GenericT'", "GenericQ'", "GenericM'" ] ++uplTypes = ["Uniplate", "Biplate"]++excludePkgs = ["DSH", "freesect"] -- these pkgs contain modules that cannot be interpreted
+ src/Generics/GPAH/Interp/PPrint.hs view
@@ -0,0 +1,22 @@+module Generics.GPAH.Interp.PPrint where++import Generics.GPAH.Interp.Base+import Text.CSV+import System.IO+import qualified Data.Map as M+import Data.List+import Data.Function (on)+++pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis a1) fp = do+ let p = [["NrTypes", show $ length $ concat $ M.elems a1],+ ["AssocTypes", show $ map (\ t -> (t, length $ filter (t `isInfixOf`) $ concat $ M.elems a1)) intTypes]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Interpretation Results:\n###############"+ putStrLn pCSV+
+ src/Generics/GPAH/Main.hs view
@@ -0,0 +1,140 @@+module Main where++import Generics.GPAH.Base+import Generics.GPAH.Conf+import Generics.GPAH.Utils++-- the sub-components+import qualified Generics.GPAH.Cpp+import qualified Generics.GPAH.Deriving+import qualified Generics.GPAH.Function+import qualified Generics.GPAH.Date+import qualified Generics.GPAH.Hackage+import qualified Generics.GPAH.Upl+import qualified Generics.GPAH.Interp+import qualified Generics.GPAH.Derive++import Control.Exception (catch, SomeException (..), evaluate)+import Control.DeepSeq (force)++import Control.Monad +import Data.Monoid+import System.IO+ +-- Cabal-related imports+import Distribution.PackageDescription+import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Verbosity (silent)+import Distribution.Package++import System.FilePath+import System.Directory (removeDirectoryRecursive)++-- for doing the python job+import qualified Codec.Archive.Tar as Tar+import qualified Codec.Compression.GZip as GZip+import qualified Data.ByteString.Lazy.Char8 as BS++main = tryFetch >> analyze >>= pprint++tryFetch :: IO ()+tryFetch = when (fetchOpt conf) $ do+ log <- downloadURL "http://hackage.haskell.org/packages/archive/log"+ case log of+ Right res -> do+ -- Write the hackage log+ file <- openBinaryFile (hackageLogOpt conf) WriteMode+ hPutStr file res+ hClose file+ Left x -> error x+ tar <- downloadURL "http://hackage.haskell.org/packages/archive/00-archive.tar"+ case tar of+ Right res -> do+ -- Unpack the hackage archive tar+ Tar.unpack (hackageDirOpt conf) $ Tar.read $ BS.pack res+ -- Unpack each package in the hackage dir+ pkgNames <- getHackagePkgsNames++ mapM_ (\ pkgName -> do+ pkgVersion <- getPkgVersion pkgName+ let fp = (hackageDirOpt conf </> pkgName </> pkgVersion)+ catch (do+ h <- openBinaryFile (fp </> (pkgName ++ "-" ++ pkgVersion) <.> "tar.gz") ReadMode+ c <- BS.hGetContents h+ catch (Tar.unpack fp (Tar.read ( GZip.decompress c)) >> hClose h)+ (\ (SomeException _) -> do+ hClose h+ removeDirectoryRecursive (hackageDirOpt conf </> pkgName)+ )+ )+ (\ (SomeException _) ->+ removeDirectoryRecursive (hackageDirOpt conf </> pkgName)+ )+ ) pkgNames++ Left x -> error x+ + print "Done Fetching & Unpacking"++analyze :: IO Analysis+analyze = if hasSubComponent conf -- check for enabled subcomponents, so not to pointlessly traverse the modules+ then (print "Running the analysis" >> getHackagePkgsNames >>= mapM analyzePkg >>= return . mconcat >>= appendAnalyzeDate)+ else return mempty++appendAnalyzeDate :: Analysis -> IO Analysis+appendAnalyzeDate a = maybe + (return a) -- not enabled in the conf, skip+ (const $ do+ contents <- readFile (hackageLogOpt conf)+ return $ Generics.GPAH.Date.analyzeHackageLog contents a `mappend` a -- appends it to the main analysis+ )+ (dateOpt conf)+++analyzePkg :: String -> IO Analysis+analyzePkg pkgName = do+ vsn <- getPkgVersion pkgName++ let cabal = pkgCabal pkgName vsn :: FilePath -- absolute cabal files+ parsedCabal <- readPackageDescription silent cabal :: IO GenericPackageDescription++ let pkgAbsDir = pkgDir pkgName vsn -- the absolute directories of package+ let pkgSrcDirs = getSrcDirs parsedCabal :: [FilePath] -- fetch the source directories , relevant to package+ let pkgAbsSrcDirs = map (pkgAbsDir </>) pkgSrcDirs :: [FilePath] -- absolute source directories+ + haskellSrcs <- return . concat . zipWith (\ abssrcdir srcs -> zip (repeat abssrcdir) srcs) pkgAbsSrcDirs =<< mapM getHaskellSrcs pkgAbsSrcDirs++ let hacPkg = maybe mempty (const $ Generics.GPAH.Hackage.analyzePackage pkgName parsedCabal) (hackageOpt conf `mplus` dateOpt conf `mplus` intOpt conf `mplus` dveOpt conf) -- -t or -i or -e, imply -h++ let analyzeModule (pkgAbsSrcDir, hs) = do+ cpp <- maybe (return mempty) (const $ Generics.GPAH.Cpp.analyzeModule hs pkgAbsDir parsedCabal) (cppOpt conf)+ + int <- maybe (return mempty) (const $ Generics.GPAH.Interp.analyzeModule hs pkgName pkgAbsSrcDir hacPkg) (intOpt conf)++ parseRes <- parseModuleFile hs++ -- turn on specific sub analyses based on user-provided conf+ let der = maybe mempty (const $ Generics.GPAH.Deriving.analyzeModule parseRes) (derivingOpt conf)+ fun = maybe mempty (const $ Generics.GPAH.Function.analyzeModule parseRes parsedCabal) (functionOpt conf)+ upl = maybe mempty (const $ Generics.GPAH.Upl.analyzeModule parseRes parsedCabal) (uniplateOpt conf)+ hac = maybe mempty (const $ Generics.GPAH.Hackage.analyzeModule parseRes) (hackageOpt conf)+ dve = maybe mempty (const $ Generics.GPAH.Derive.analyzeModule parseRes hacPkg) (dveOpt conf) + evaluate . force $ Analysis cpp der fun upl hac mempty int dve+++ let appendAnalyzeHacPkg a = a { hacAnalysis = hacAnalysis a `mappend` hacPkg }++ return . appendAnalyzeHacPkg . mconcat =<< mapM analyzeModule haskellSrcs++++pprint :: Analysis -> IO ()+pprint (Analysis cpp der fun upl hac dte int dve) = do+ maybe (return ()) (Generics.GPAH.Cpp.pprint cpp) (cppOpt conf)+ maybe (return ()) (Generics.GPAH.Hackage.pprint hac) (hackageOpt conf)+ maybe (return ()) (Generics.GPAH.Deriving.pprint der) (derivingOpt conf)+ maybe (return ()) (Generics.GPAH.Function.pprint fun) (functionOpt conf)+ maybe (return ()) (Generics.GPAH.Upl.pprint upl) (uniplateOpt conf)+ maybe (return ()) (Generics.GPAH.Date.pprint dte) (dateOpt conf)+ maybe (return ()) (Generics.GPAH.Interp.pprint int) (intOpt conf)+ maybe (return ()) (Generics.GPAH.Derive.pprint dve) (dveOpt conf)
+ src/Generics/GPAH/Upl.hs view
@@ -0,0 +1,10 @@+module Generics.GPAH.Upl (+ module Generics.GPAH.Upl.Base+ ,module Generics.GPAH.Upl.Analyze+ ,module Generics.GPAH.Upl.PPrint+ )+where++import Generics.GPAH.Upl.Base+import Generics.GPAH.Upl.Analyze+import Generics.GPAH.Upl.PPrint
+ src/Generics/GPAH/Upl/Analyze.hs view
@@ -0,0 +1,34 @@+module Generics.GPAH.Upl.Analyze where++import Generics.GPAH.Upl.Base+import Generics.GPAH.Utils+import Language.Haskell.Exts+import Language.Haskell.Exts.Comments+import qualified Data.Map as M+import Generics.GPAH.Hackage.Analyze++import Data.Monoid++-- Cabal-related imports+import Distribution.PackageDescription+import Distribution.Package++analyseImports :: [ImportDecl] -> Maybe UniStyle+analyseImports is = if isMixed is+ then Just Mixed+ else analyseImports' is where+ isMixed is = any (\ (ImportDecl { importModule = ModuleName mn }) -> mn == mixed) is+ analyseImports' (ImportDecl { importModule = ModuleName mn} :xs) | mn `elem` manualSpeed = Just ManualSpeed+ analyseImports' (ImportDecl { importModule = ModuleName mn} :xs) | mn `elem` automatic = Just Automatic+ analyseImports' (ImportDecl { importModule = ModuleName mn} :xs) | mn `elem` manualPointless = Just ManualPointless+ analyseImports' (_:xs) = analyseImports' xs+ analyseImports' [] = Nothing+++analyzeModule :: ParseResult (Module, [Comment]) -> GenericPackageDescription -> Analysis+analyzeModule (ParseOk ((Module (SrcLoc {srcFilename = fn}) _ _ _ _ imports _),_)) gpkgdesc =+ if "uniplate" `elem` cabalDepends gpkgdesc -- if has uniplate as dep+ then Analysis $ maybe M.empty (\ s -> M.singleton s [fn]) $ analyseImports imports+ else mempty+analyzeModule _ _ = mempty+
+ src/Generics/GPAH/Upl/Base.hs view
@@ -0,0 +1,30 @@+module Generics.GPAH.Upl.Base where++import Generics.GPAH.Utils+import qualified Data.Map as M+import Control.DeepSeq+import Data.Monoid++manualSpeed = ["Data.Generics.Uniplate.Direct", + "Data.Generics.PlateDirect"]+automatic = ["Data.Generics.Uniplate.Data", + "Data.Generics.PlateData"]+manualPointless = ["Data.Generics.Uniplate.Typeable", + "Data.Generics.PlateTypeable"]+mixed = "Data.Generics.Uniplate.DataOnly"++data UniStyle = ManualSpeed | Automatic | ManualPointless | Mixed+ deriving (Read, Show, Eq, Ord)++instance NFData UniStyle -- enumeration type, so default instance++newtype Analysis = Analysis (M.Map UniStyle [ModuleFileName])+ deriving (Show)++instance NFData Analysis where+ rnf (Analysis x) = x `deepseq` ()++instance Monoid Analysis where+ mempty = Analysis (mempty)+ (Analysis x) `mappend` (Analysis y) = Analysis $ M.unionWith (++) x y+
+ src/Generics/GPAH/Upl/PPrint.hs view
@@ -0,0 +1,22 @@+module Generics.GPAH.Upl.PPrint where++import Generics.GPAH.Upl.Base+import Text.CSV+import System.IO+import qualified Data.Map as M+import Data.Function++pprint :: Analysis -> FilePath -> IO ()+pprint (Analysis m) fp = do+ let p = [["ModulesUsingManualSpeed(Direct)", show $ maybe 0 length $ M.lookup ManualSpeed m],+ ["ModulesUsingManualPointless(PlateTypeable)", show $ maybe 0 length $ M.lookup ManualPointless m],+ ["ModulesUsingAutomatic(PlateData)", show $ maybe 0 length $ M.lookup Automatic m],+ ["ModulesUsingMixed(DataOnly)", show $ maybe 0 length $ M.lookup Mixed m]+ ]+ pCSV = printCSV p++ writeFile fp pCSV++ putStrLn "Uniplate Results:\n###############"+ putStrLn pCSV+
+ src/Generics/GPAH/Utils.hs view
@@ -0,0 +1,262 @@+module Generics.GPAH.Utils where+ +import Generics.GPAH.Conf++import System.FilePath+import System.Directory+import Data.List+import Control.Monad (filterM, liftM)+import Data.Char (isSpace)+import Language.Haskell.Exts+import Language.Haskell.Exts.Comments+import Network.HTTP+import Network.URI+import Data.Maybe (fromJust)++import System.IO+import qualified Data.ByteString.Char8 as B++-- Cabal-related imports+import Distribution.PackageDescription+import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Verbosity (silent)+import Distribution.Package+import qualified Distribution.Compiler as Compiler (CompilerFlavor (GHC))++type ClassName = String+type DataName = String+type LineNumber = Int+type ModuleFileName = String++fromBool :: Bool -> Int+fromBool True = 1+fromBool False = 0++toBool :: Int -> Bool+toBool 1 = True+toBool 0 = False++-- returns the package directory relative to the hackage archive+-- e.g. hackage/syb/0.3.6/ACTUAL_PKG_DIR+pkgDir :: String -> String -> FilePath+pkgDir pkg vsn = hackageDirOpt conf </> pkg </> vsn </> pkg ++ "-" ++ vsn++pkgCabal :: FilePath -> FilePath -> FilePath+pkgCabal pkg vsn = pkgDir pkg vsn </> pkg ++ ".cabal"++-- ignore package hsc3, because of error:+-- gpanalysis.exe: In file hackage\hsc3\0.14\hsc3-0.14\Help\UGen\Panner\splay.help.lhs at line 1: program line before comment line.+-- +getHackagePkgsNames :: IO [String]+getHackagePkgsNames = liftM (delete "hsc3") $ getSubDirs (hackageDirOpt conf)+++getPkgVersion :: String -> IO String+getPkgVersion pkgName = liftM head $ getSubDirs (hackageDirOpt conf </> pkgName)++getSubDirs fp = do + ls <- getDirectoryContents fp + let clean_ls = ls \\ [".",".."]+ subdirs <- filterM (doesDirectoryExist . (fp </>)) clean_ls+ return subdirs+++getSrcDirs :: GenericPackageDescription -> [FilePath]+getSrcDirs (GenericPackageDescription {condLibrary = l, condExecutables = es, condTestSuites = ts}) = + let getSrcDirsLib = hsSourceDirs . libBuildInfo + getSrcDirsExec = hsSourceDirs . buildInfo+ getSrcDirsTest = hsSourceDirs . testBuildInfo+ pkgSrcDirs = nub $ concat $ + maybe [[]] ((: []) . getSrcDirsLib . condTreeData) l ++ + map (getSrcDirsExec . condTreeData . snd) es ++ + map (getSrcDirsTest . condTreeData . snd) ts+ in if null pkgSrcDirs + then [""] -- the srcdir of the package is its home dir+ else pkgSrcDirs++-- if using Data.Text, this function is provided+-- and is more efficient+strip :: String -> String+strip = f . f+ where f = reverse . dropWhile isSpace+++ghcOpts :: GenericPackageDescription -> String+ghcOpts (GenericPackageDescription {condLibrary = l, condExecutables = es, condTestSuites = ts}) =+ unwords [libGhcOptions,+ exesGhcOptions,+ testsGhcOptions]+ where+ libGhcOptions = maybe "" (ghcOptionsBI . libBuildInfo . condTreeData) l+ exesGhcOptions = unwords $ map (ghcOptionsBI . buildInfo . condTreeData . snd) es+ testsGhcOptions = unwords $ map (ghcOptionsBI . testBuildInfo . condTreeData . snd) ts+ ghcOptionsBI :: BuildInfo -> String+ ghcOptionsBI (BuildInfo {options = opts}) = maybe "" unwords $ lookup Compiler.GHC opts+++ +cppOpts :: GenericPackageDescription -> String+cppOpts (GenericPackageDescription {condLibrary = l, condExecutables = es, condTestSuites = ts}) =+ (strip . unwords) [libCppOptions,+ exesCppOptions,+ testsCppOptions,+ libIncludeDirs,+ exesIncludeDirs,+ testsIncludeDirs]+ where+ libCppOptions = maybe "" (cppOptionsBI . libBuildInfo . condTreeData) l+ exesCppOptions = unwords $ map (cppOptionsBI . buildInfo . condTreeData . snd) es+ testsCppOptions = unwords $ map (cppOptionsBI . testBuildInfo . condTreeData . snd) ts+ cppOptionsBI :: BuildInfo -> String+ cppOptionsBI (BuildInfo {cppOptions = opts}) = unwords opts++ libIncludeDirs = maybe "" (includeDirsBI . libBuildInfo . condTreeData) l+ exesIncludeDirs = unwords $ map (includeDirsBI . buildInfo . condTreeData . snd) es+ testsIncludeDirs = unwords $ map (includeDirsBI . testBuildInfo . condTreeData . snd) ts+ includeDirsBI :: BuildInfo -> String+ includeDirsBI (BuildInfo {includeDirs = opts}) = unwords $ map ("-I" ++) opts+ +++parseCabalSrcDirs :: FilePath -> IO [String]+parseCabalSrcDirs fp = do+ gpkgdesc <- readPackageDescription silent fp+ return (getSrcDirs gpkgdesc)+++getHaskellSrcs :: FilePath -> IO [FilePath]+getHaskellSrcs fp = do+ existsDir <- doesDirectoryExist fp -- it's possible that the srcdir is not there+ if existsDir + then do + ls <- getDirectoryContents fp + -- filter hs, lhs and not Setup.hs and Setup.lhs and no hidden+ let hs_lhs = filter (\ l -> (".hs" `isSuffixOf` l || ".lhs" `isSuffixOf` l) && not ("." `isPrefixOf` l) && (l /= "Setup.hs") && (l /= "Setup.lhs")) ls++ -- It prefers the ".hspp" version of the source file, over the ".hs" or ".lhs" version of it+ hs_lhs_hspp <- mapM (\ hsOrlhsFile -> do + let hsppFile = addExtension (dropExtension hsOrlhsFile) ".hspp"+ p <- doesFileExist (fp </> hsppFile)+ return $ if p then hsppFile else hsOrlhsFile)+ hs_lhs++ subDirs <- getSubDirs fp++ if null subDirs + then do+ return $ map (fp </>) hs_lhs_hspp+ else do+ hs_lhs_hspp' <- mapM getHaskellSrcs (map (fp </>) subDirs)+ return $ map (fp </>) hs_lhs_hspp ++ (concat hs_lhs_hspp')+ else do + return []+++parseModuleFile :: FilePath -> IO (ParseResult (Module, [Comment]))+parseModuleFile fp = do++ h <- openFile fp ReadMode++ te <- mkTextEncoding "UTF-8//IGNORE"+ hSetEncoding h te++ contents <- return . B.unpack =<< B.hGetContents h++ hClose h++ -- remove pragmas+ let clearedContents = removePragmas contents++ -- set parsing mode+ let parseMode = defaultParseMode { parseFilename = fp+ , extensions = knownExtensions -- support extensions+ , fixities = Nothing } -- no infix operators+ return $ parseFileContentsWithComments parseMode clearedContents+++removePragmas :: String -> String+removePragmas s = unlines $ map removePragma (lines s) where+ removePragma ('#':xs) = ""+ removePragma xs = xs+++downloadURL :: String -> IO (Either String String)+downloadURL url =+ do resp <- simpleHTTP request+ case resp of+ Left x -> return $ Left ("Error connecting: " ++ show x)+ Right r -> + case rspCode r of+ (2,_,_) -> return $ Right (rspBody r)+ (3,_,_) -> -- A HTTP redirect+ case findHeader HdrLocation r of+ Nothing -> return $ Left (show r)+ Just url -> downloadURL url+ _ -> return $ Left (show r)+ where request = Request {rqURI = uri,+ rqMethod = GET,+ rqHeaders = [],+ rqBody = ""}+ uri = fromJust $ parseURI url+++-- Libraries under the "Generics" , "Generic" categories of HackageDB + "syb-with-class" + "derive" + "DrIFT-cabalized"+libsGP = ["HsTools",+ "syb-extras",+ "algebraic-classes",+ "alloy",+ "alloy-proxy-fd",+ "Annotations",+ "compdata",+ "derive-IG",+ "emgm",+ "fixplate",+ "functorm",+ "gdiff-ig",+ "gdiff-th",+ "generic-binary",+ "generic-deepseq",+ "generic-deriving",+ "GenericPretty",+ "geniplate",+ "guarded-rewriting",+ "instant-generics",+ "instant-zipper",+ "ligd",+ "ListLike",+ "listlike-instances",+ "multifocal",+ "multiplate",+ "multiplate-simplified",+ "multirec",+ "multirec-alt-deriver",+ "multirec-binary",+ "one-liner",+ "pointless-haskell",+ "pointless-lenses",+ "pointless-rewrite",+ "putlenses",+ "regular",+ "regular-extras",+ "regular-web",+ "RepLib",+ "rewriting",+ "special-functors",+ "spine",+ "Strafunski-StrategyLib",+ "StrategyLib",+ "syb",+ "syz",+ "TYB",+ "unbound",+ "unfoldable",+ "uniplate",+ "xformat",+ "yoko",+ "zipper",+ "syb-with-class",+ "derive",+ "DrIFT-cabalized"+ ]++