Allow both relative and absolute module paths.

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Common.hs

@@ -38,12 +38,12 @@ fileInDirWithExtensionAndComponents ::
        MonadIO m
     => m (Path Abs Dir)
     -> String
-    -> Path Rel File
+    -> Path Abs File
     -> [String]
     -> m (Path Abs File)
 fileInDirWithExtensionAndComponents genDir ext f comps = do
     dd <- genDir
-    let fileStr = intercalate "-" $ dropExtensions (toFilePath f) : comps
+    let fileStr = intercalate "-" $ dropExtensions (toFilePath $ filename f) : comps
     liftIO $ (dd </>) <$> parseRelFile (concat [fileStr, ".", ext])
 
 signatureInferenceStrategies :: [ES.SignatureInferenceStrategy]

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Data/Averages.hs

@@ -216,7 +216,7 @@ instance FromJSON AverageEvaluatorOutput where
 
 data AverageCsvLine = AverageCsvLine
     { averageCsvLineBaseDir :: Path Abs Dir
-    , averageCsvLineSourceFile :: Path Rel File
+    , averageCsvLineSourceFile :: Path Abs File
     , averageCsvLineEvaluatorName :: String
     , averageCsvLineStrategyName :: String
     , averageCsvLineAverage :: AverageOutput
@@ -273,15 +273,15 @@ makeAverageCsvLinesFromAverageEvaluatorOutput is stratName AverageEvaluatorOutpu
     }
 
 jsonAverageFileWithComponents ::
-       MonadIO m => Path Rel File -> [String] -> m (Path Abs File)
+       MonadIO m => Path Abs File -> [String] -> m (Path Abs File)
 jsonAverageFileWithComponents = averagesFile "json"
 
 csvAverageFileWithComponents ::
-       MonadIO m => Path Rel File -> [String] -> m (Path Abs File)
+       MonadIO m => Path Abs File -> [String] -> m (Path Abs File)
 csvAverageFileWithComponents = averagesFile "csv"
 
 averagesFile ::
-       MonadIO m => String -> Path Rel File -> [String] -> m (Path Abs File)
+       MonadIO m => String -> Path Abs File -> [String] -> m (Path Abs File)
 averagesFile = fileInDirWithExtensionAndComponents averagesDir
 
 averagesDir :: MonadIO m => m (Path Abs Dir)

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Data/Common/TH.hs

@@ -55,8 +55,7 @@ makeExampleCache = do
                 putStrLn $
                     unlines $
                     [ "Gathering a cache of the functions defined in the following file:"
-                    , toFilePath $
-                      ES.inputSpecBaseDir ex </> ES.inputSpecFile ex
+                    , toFilePath $ ES.inputSpecFile ex
                     , unwords
                           [ "Found these"
                           , show (length ns)

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Data/Files.hs

@@ -84,7 +84,7 @@ dataFileForStrategy ::
 dataFileForStrategy = evaluatedFileForStrategy
 
 csvDataFileWithComponents ::
-       MonadIO m => Path Rel File -> [String] -> m (Path Abs File)
+       MonadIO m => Path Abs File -> [String] -> m (Path Abs File)
 csvDataFileWithComponents = dataFileWithComponents "csv"
 
 dataFilesForGroupAndExample ::
@@ -118,7 +118,7 @@ allDataFile :: MonadIO m => m (Path Abs File)
 allDataFile = evaluatedFileForAllData
 
 dataFileWithComponents ::
-       MonadIO m => String -> Path Rel File -> [String] -> m (Path Abs File)
+       MonadIO m => String -> Path Abs File -> [String] -> m (Path Abs File)
 dataFileWithComponents = fileInDirWithExtensionAndComponents dataDir
 
 --

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Data/Raw.hs

@@ -43,7 +43,7 @@ rawDataRulesForGroupFileNameAndStrat ::
 rawDataRulesForGroupFileNameAndStrat ghciResource groupName is name infStrat = do
     jsonF <- rawDataFileFor groupName is name infStrat
     jsonF $%> do
-        let absFile = ES.inputSpecAbsFile is
+        let absFile = ES.inputSpecFile is
         needP [absFile]
         ip <-
             withResource ghciResource 1 $ do

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Hackage.hs

@@ -64,8 +64,8 @@ packageExamples (package, sourceDirs, modulePaths) = do
             fmap catMaybes $
             forM modulePaths $ \modulePath -> do
                 bd <- liftIO $ resolveDir pd sourceDir
-                fp <- liftIO $ parseRelFile $ modulePath ++ ".hs"
-                exists <- liftIO $ Path.IO.doesFileExist $ bd </> fp
+                fp <- liftIO . resolveFile bd $ modulePath ++ ".hs"
+                exists <- liftIO $ Path.IO.doesFileExist fp
                 pure $
                     if exists
                         then Just

easyspec-evaluate/src/EasySpec/Evaluate/Analyse/Plots/Files.hs

@@ -24,12 +24,14 @@ scriptFile :: MonadIO m => String -> m (Path Abs File)
 scriptFile fname = liftIO $ resolveFile' $ "rscripts/" ++ fname
 
 pdfPlotFileWithComponents ::
-       MonadIO m => Path Rel File -> [String] -> m (Path Abs File)
+       MonadIO m => Path Abs File -> [String] -> m (Path Abs File)
 pdfPlotFileWithComponents = fileInDirWithExtensionAndComponents plotsDir "pdf"
 
 exampleModule :: Example -> String
 exampleModule = map go . dropExtensions . toFilePath . ES.inputSpecFile
   where
+    -- TODO: This method of converting paths to module names is just
+    -- incorrect.
     go :: Char -> Char
     go '/' = '.'
     go c = c

easyspec-evaluate/src/EasySpec/Evaluate/OptParse.hs

@@ -32,14 +32,9 @@ combineToInstructions cmd Flags Configuration = (,) <$> disp <*> pure Settings
                 bd <- resolveDir' dirpath
                 fs <-
                     case mfilepath of
-                        Just f -> do
-                            af <- resolveFile' f
-                            rf <- makeRelative bd af
-                            pure [rf]
+                        Just f -> pure <$> resolveFile' f
                         Nothing ->
-                            (mapMaybe (makeRelative bd) .
-                             filter ES.isSourceFile . snd) <$>
-                            listDirRecur bd
+                          filter ES.isSourceFile . snd <$> listDirRecur bd
                 pure $ DispatchEvaluate $ map (ES.InputSpec bd) fs
             CommandBuild target -> pure $ DispatchBuild target
             CommandBuildEverything -> pure DispatchBuildEverything

easyspec-evaluate/src/EasySpec/Evaluate/Types.hs

@@ -94,7 +94,7 @@ instance FromJSON EvaluationInputPoint where
 
 data EvaluatorCsvLine = EvaluatorCsvLine
     { eclBaseDir :: Path Abs Dir
-    , eclFile :: Path Rel File
+    , eclFile :: !(Path Abs File)
     , eclStratName :: String
     , eclFocusFuncName :: String
     , eclEvaluatorName :: ES.EvaluatorName
@@ -106,7 +106,7 @@ data EvaluatorCsvLine = EvaluatorCsvLine
 
 instance FromNamedRecord EvaluatorCsvLine where
     parseNamedRecord r =
-        EvaluatorCsvLine <$> p parseAbsDir "base-dir" <*> p parseRelFile "file" <*>
+        EvaluatorCsvLine <$> p parseAbsDir "base-dir" <*> p parseAbsFile "file" <*>
         r .: "strategy" <*>
         r .: "focus" <*>
         r .: "evaluator" <*>

easyspec/easyspec.cabal

@@ -71,6 +71,12 @@ library
         unordered-containers >=0.2 && <0.3,
         vector >=0.11 && <0.12,
         exceptions >=0.8 && <0.9
+      , binary
+      , bytestring >= 0.10
+      , deepseq
+      , fingertree >= 0.1.1
+      , text >= 1.2
+      , quickspec
     default-language: Haskell2010
     default-extensions: NoImplicitPrelude
     hs-source-dirs: src/

easyspec/src/EasySpec/Discover/GatherFromGHC.hs

@@ -16,10 +16,15 @@ import Var
 import EasySpec.Discover.Types
 import EasySpec.Discover.Utils
 
+data RootModule = RootModule
+  { rmFile :: !(Path Abs File)
+  , rmModuleName :: !GHC.ModuleName
+  } deriving (Eq, Ord)
+
 data IdData = IdData
     { idDataId :: GHC.Id
     , idDataExportingMods :: [GHC.ModuleName]
-    , idDataRootloc :: Maybe (Path Rel File)
+    , idDataRootInfo :: !(Maybe RootModule)
     } deriving (Eq)
 
 getGHCIds :: MonadIO m => InputSpec -> m [IdData]
@@ -35,17 +40,24 @@ getGHCIds is =
                           [toFilePath $ inputSpecBaseDir is]
                     }
         setDFlagsNoLinking compdflags
-        let targetModName = getTargetModName $ inputSpecFile is
-        target <- guessTarget (moduleNameString targetModName) Nothing
+        let targetModFile = toFilePath $ inputSpecFile is
+        target <- guessTarget targetModFile Nothing
         setTargets [target]
         loadSuccessfully LoadAllTargets
-        modSum <- getModSummary targetModName
+        modSum <- do
+          g <- getModuleGraph
+          let ms' = [ ml_hs_file (ms_location m) | m <- g ]
+          let ms = [ m
+                   | m <- g, Just targetModFile == ml_hs_file (ms_location m) ]
+          case ms of
+            [] -> fail $ "Didn't find target " ++ targetModFile ++ " in module graph." ++ show ms'
+            m : _ -> pure m
         parsedModule <- parseModule modSum
         tmod <- typecheckModule parsedModule
         getGHCIdsFromTcModule (inputSpecFile is) tmod
 
 getGHCIdsFromTcModule ::
-       GhcMonad m => Path Rel File -> TypecheckedModule -> m [IdData]
+       GhcMonad m => Path Abs File -> TypecheckedModule -> m [IdData]
 getGHCIdsFromTcModule file tmod = do
     let (tcenv, _) = tm_internals_ tmod
         -- Get the global reader elementss out of the global env
@@ -59,7 +71,11 @@ getGHCIdsFromTcModule file tmod = do
                     IdData
                     { idDataId = i
                     , idDataExportingMods = []
-                    , idDataRootloc = Just file
+                    , idDataRootInfo = Just $! RootModule
+                        { rmFile = file
+                        , rmModuleName =
+                            ms_mod_name . pm_mod_summary $ tm_parsed_module tmod
+                        }
                     }
     others <-
         fmap concat $
@@ -76,7 +92,7 @@ getGHCIdsFromTcModule file tmod = do
                             { idDataId = i
                             , idDataExportingMods =
                                   modulesFromWhichWeImportedThis
-                            , idDataRootloc = Nothing
+                            , idDataRootInfo = Nothing
                             }
     pure $ nubBy (\i1 i2 -> idDataId i1 == idDataId i2) $ locals ++ others
   where

easyspec/src/EasySpec/Discover/QuickSpec.hs

@@ -37,7 +37,7 @@ runEasySpec ::
 runEasySpec ds iSig = do
     sets <- ask
     liftIO $ do
-        let sourceFile = inputSpecAbsFile $ setDiscInputSpec ds
+        let sourceFile = toFilePath . inputSpecFile $ setDiscInputSpec ds
         runGhc (Just libdir) $ do
             initGhcMonad (Just libdir)
             dflags <- getSessionDynFlags
@@ -54,9 +54,16 @@ runEasySpec ds iSig = do
                 -- See these:
                 -- - https://stackoverflow.com/questions/12790341/haskell-ghc-dynamic-compliation-only-works-on-first-compile
                 -- - https://mail.haskell.org/pipermail/glasgow-haskell-users/2011-October/021009.html
-            target <- guessTarget ("*" ++ toFilePath sourceFile) Nothing
+            target <- guessTarget ("*" ++ sourceFile) Nothing
             setTargets [target]
             loadSuccessfully LoadAllTargets
+            modName <- do
+              g <- getModuleGraph
+              let mns = [ ms_mod_name m
+                        | m <- g, Just sourceFile == ml_hs_file (ms_location m) ]
+              case mns of
+                [] -> fail $ "Didn't find target " ++ sourceFile ++ " in module graph."
+                mn : _ -> pure mn
             let imp = GHC.simpleImportDecl . GHC.mkModuleName
             let qsModules =
                     [ IIDecl $ (imp "QuickSpec") {ideclQualified = True}
@@ -72,8 +79,7 @@ runEasySpec ds iSig = do
                     , IIDecl $ (imp "Data.Maybe") {ideclQualified = True}
                     , IIDecl $ (imp "Data.Monoid") {ideclQualified = True}
                     , IIDecl $ imp "Prelude"
-                    , IIModule $
-                      getTargetModName $ inputSpecFile $ setDiscInputSpec ds
+                    , IIModule modName
                     ]
             setContext qsModules
             let declaretc =

easyspec/src/EasySpec/Discover/SourceGathering.hs

@@ -28,7 +28,7 @@ gatherSourceOf is d@IdData {..} = do
             (_:_) -> pure Nothing
         -- It was defined locally, so we may be able to get the implementation out of the current file.
             [] -> do
-                let sourceFile = inputSpecAbsFile is
+                let sourceFile = inputSpecFile is
                 mainContents <- liftIO $ readFile $ toFilePath sourceFile
                 case parseModule mainContents of
                     ParseFailed loc err -> do

easyspec/src/EasySpec/Discover/TypeTranslation.hs

@@ -3,9 +3,6 @@
 module EasySpec.Discover.TypeTranslation where
 
 import Import hiding (tyConName)
-
-import System.FilePath as FP
-
 import Class
 import GHC
 import qualified Module
@@ -26,7 +23,7 @@ toEasyId d impl =
     { E.idName = toEasyQNameFromSources d
     , E.idType = toEasyType $ Var.varType $ idDataId d
     , E.idImpl = impl
-    , E.idRootloc = idDataRootloc d
+    , E.idRootloc = rmFile <$> idDataRootInfo d
     }
 
 toEasyName :: Monoid a => GHC.Name -> H.Name a
@@ -40,17 +37,12 @@ toEasyQNameFromSources :: Monoid a => IdData -> H.QName a
 toEasyQNameFromSources d =
     case idDataExportingMods d of
         [] ->
-            case idDataRootloc d of
+            case idDataRootInfo d of
                 Nothing ->
                     UnQual mempty (toEasyName $ Var.varName $ idDataId d) -- This should not occur, but it's not enforced by the type system.
-                Just fp ->
-                    toEasyQName (Var.varName $ idDataId d) $
-                    map
-                        (\c ->
-                             case c of
-                                 '/' -> '.'
-                                 _ -> c) $
-                    FP.dropExtensions $ toFilePath fp
+                Just (RootModule { rmModuleName = mname }) ->
+                    toEasyQName (Var.varName $ idDataId d)
+                                (GHC.moduleNameString mname)
         (mn:_) ->
             toEasyQName (Var.varName $ idDataId d) (Module.moduleNameString mn)
 

easyspec/src/EasySpec/Discover/Types.hs

@@ -57,12 +57,9 @@ deriving instance TH.Lift l => TH.Lift (SpecialCon l)
 
 data InputSpec = InputSpec
     { inputSpecBaseDir :: Path Abs Dir
-    , inputSpecFile :: Path Rel File
+    , inputSpecFile :: !(Path Abs File)
     } deriving (Show, Eq, Data, Typeable, TH.Lift)
 
-inputSpecAbsFile :: InputSpec -> Path Abs File
-inputSpecAbsFile InputSpec {..} = inputSpecBaseDir </> inputSpecFile
-
 data SignatureInferenceStrategy = SignatureInferenceStrategy
     { sigInfStratName :: String
     , inferSignature :: [EasyId] -> [EasyId] -> InferredSignature
@@ -119,7 +116,7 @@ data Id m = Id
     { idName :: QName m
     , idType :: Type m
     , idImpl :: Maybe (Impl m)
-    , idRootloc :: Maybe (Path Rel File) -- The module name where it was defined
+    , idRootloc :: !(Maybe (Path Abs File)) -- The module name where it was defined
     } deriving (Show, Eq, Ord, Generic)
 
 type EasyId = Id ()

easyspec/src/EasySpec/Discover/Utils.hs

@@ -1,16 +1,17 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ViewPatterns     #-}
 
 module EasySpec.Discover.Utils where
 
 import Import
-
-import System.FilePath
+import GHC
+import GHC.Paths (libdir)
 
 import qualified Data.Set as Set
 import DynFlags hiding (Settings)
 import GHC
-       (GhcMonad, LoadHowMuch, ModuleName, SuccessFlag(..),
-        getProgramDynFlags, load, mkModuleName, setSessionDynFlags)
+       (GhcMonad, LoadHowMuch, SuccessFlag(..),
+        getProgramDynFlags, load, setSessionDynFlags)
 import GHC.LanguageExtensions
 import Outputable (Outputable(..), showPpr)
 
@@ -27,14 +28,14 @@ loadSuccessfully hm = do
 prepareFlags :: DynFlags -> DynFlags
 prepareFlags dflags = foldl xopt_set dflags [Cpp, ImplicitPrelude, MagicHash]
 
-getTargetModName :: Path Rel File -> GHC.ModuleName
-getTargetModName = mkModuleName . filePathToModuleName
-
-filePathToModuleName :: Path Rel File -> String
-filePathToModuleName = map go . dropExtensions . toFilePath
-  where
-    go '/' = '.'
-    go c = c
+filePathToModuleName :: MonadIO m => Path Abs File -> m String
+filePathToModuleName (toFilePath -> p) = liftIO . runGhc (Just libdir) $ do
+  target <- guessTarget p Nothing
+  setTargets [target]
+  g <- depanal [] True
+  case [ m | m <- g, Just p == ml_hs_file (ms_location m) ] of
+    [] -> fail $ "Couldn't get ModSummary for " ++ p
+    m : _ -> pure . moduleNameString $ ms_mod_name m
 
 showGHC :: (GhcMonad m, Outputable a) => a -> m String
 showGHC a = do