CabalInspector: collect info about tests

SublimeHaskell · Mar 30, 2013 · 8139f07 · 8139f07
1 parent 2366ff9
commit 8139f07
Showing 1 changed file with 24 additions and 8 deletions.
diff --git a/CabalInspector.hs b/CabalInspector.hs
@@ -7,20 +7,22 @@ import qualified Data.Aeson as Json
 import Data.Aeson ((.=))
 import qualified Data.Text.Lazy.Encoding as T
 import qualified Data.Text.Lazy.IO as T
-import Distribution.PackageDescription
+import qualified Distribution.PackageDescription as PD
 import Distribution.PackageDescription.Parse
 import Distribution.ModuleName (components)
 import qualified System.Environment as Environment
 
 data CabalInfo = CabalInfo {
     cabalLibrary :: Maybe CabalLibrary,
-    cabalExecutables :: [CabalExecutable] }
+    cabalExecutables :: [CabalExecutable],
+    cabalTests :: [CabalTest] }
         deriving (Show)
 
 instance Json.ToJSON CabalInfo where
     toJSON info = Json.object [
         "library" .= cabalLibrary info,
-        "executables" .= cabalExecutables info]
+        "executables" .= cabalExecutables info,
+        "tests" .= cabalTests info]
 
 data CabalLibrary = CabalLibrary {
     libraryModules :: [[String]],
@@ -44,6 +46,18 @@ instance Json.ToJSON CabalExecutable where
         "path" .= executablePath exe,
         "info" .= executableBuildInfo exe]
 
+data CabalTest = CabalTest {
+    testName :: String,
+    testEnabled :: Bool,
+    testBuildInfo :: Info }
+        deriving (Show)
+
+instance Json.ToJSON CabalTest where
+    toJSON tst = Json.object [
+        "name" .= testName tst,
+        "enabled" .= testEnabled tst,
+        "info" .= testBuildInfo tst]
+
 data Info = Info {
     infoSourceDirs :: [FilePath] }
         deriving (Show)
@@ -55,14 +69,16 @@ instance Json.ToJSON Info where
 analyzeCabal :: String -> Either String CabalInfo
 analyzeCabal source = case parsePackageDescription source of
     ParseOk _ r -> Right CabalInfo {
-        cabalLibrary = fmap (toLibrary . condTreeData) $ condLibrary r,
-        cabalExecutables = fmap (toExecutable . second condTreeData) $ condExecutables r }
+        cabalLibrary = fmap (toLibrary . PD.condTreeData) $ PD.condLibrary r,
+        cabalExecutables = fmap (toExecutable . second PD.condTreeData) $ PD.condExecutables r,
+        cabalTests = fmap (toTest . second PD.condTreeData) $ PD.condTestSuites r }
     ParseFailed e -> Left $ "Parse failed: " ++ show e
     where
-        toLibrary (Library exposeds _ info) = CabalLibrary (map components exposeds) (toInfo info)
-        toExecutable (name, Executable _ path info) = CabalExecutable name path (toInfo info)
+        toLibrary (PD.Library exposeds _ info) = CabalLibrary (map components exposeds) (toInfo info)
+        toExecutable (name, PD.Executable _ path info) = CabalExecutable name path (toInfo info)
+        toTest (name, PD.TestSuite _ _ info enabled) = CabalTest name enabled (toInfo info)
         toInfo info = Info {
-            infoSourceDirs = hsSourceDirs info }
+            infoSourceDirs = PD.hsSourceDirs info }
 
 main :: IO ()
 main = do