Update to compile with ghc 8.6.5

.gitignore

@@ -1,4 +1,5 @@
 dist
+dist-newstyle
 cabal-dev
 *.o
 *.hi

dash-haskell.cabal

@@ -73,7 +73,7 @@ executable dash-haskell
                   PackageId
 
   build-depends:  Cabal                  >= 1.18.0
-                  , base                 >= 4.7 && <= 4.9
+                  , base                 >= 4.7 && <= 5
                   , containers           >= 0.5.5.1
                   , direct-sqlite        >= 2.3.13
                   , directory            >= 1.2.1.0
@@ -85,7 +85,8 @@ executable dash-haskell
                   , sqlite-simple        >= 0.4.5.0
                   , tagsoup              >= 0.12.7
                   , text                 >= 0.7.1
-                  , transformers         >= 0.2 && < 0.5
+                  , transformers         >= 0.2 && < 0.6
+                  , transformers-either
                   , parsec               >= 3.1.5
                   , haddock-api          >= 2.15.0
   ghc-options:         -Wall -rtsopts

src/Haddock/Artifact.hs

@@ -19,7 +19,7 @@ parseError :: String -> FilePath -> M r
 parseError e p = 
   err $ preposition "parser error" "in" "haddock interface" p [e]
 
-fromInterfaces :: Ghc.PackageKey -> [InstalledInterface] -> [Artifact]
+fromInterfaces :: Ghc.UnitId -> [InstalledInterface] -> [Artifact]
 fromInterfaces _   []       = []  
 fromInterfaces pkg (i:rest) =
    let moduleName = instMod i in
@@ -33,7 +33,7 @@ fromInterfaces pkg (i:rest) =
      else
        fromInterfaces pkg rest 
 
-toArtifacts :: Ghc.PackageKey -> FilePath -> M [Artifact]
+toArtifacts :: Ghc.UnitId -> FilePath -> M [Artifact]
 toArtifacts pkg haddock' = do 
   interface_file <- liftIO $ readInterfaceFile freshNameCache haddock'
   case interface_file of

src/Haddock/Sqlite.hs

@@ -15,14 +15,16 @@ data IndexRow = IndexRow {
   , modAttr :: T.Text 
 } deriving (Show)
 
+instance Semigroup IndexRow where
+  (<>) l r =
+    IndexRow
+      ((<>) (nameAttr l) (nameAttr r))
+      ((<>) (typeAttr l) (typeAttr r))
+      ((<>) (pathAttr l) (pathAttr r))
+      ((<>) (modAttr l) (modAttr r))
+
 instance Monoid IndexRow where
   mempty = IndexRow mempty mempty mempty mempty
-  mappend l r =  
-    IndexRow 
-      (mappend (nameAttr l) (nameAttr r))
-      (mappend (typeAttr l) (typeAttr r))
-      (mappend (pathAttr l) (pathAttr r))
-      (mappend (modAttr l) (modAttr r))
 
 -- TODO lensify
 instance ToRow IndexRow where
@@ -61,7 +63,7 @@ escapeSpecial =
     specialChars :: String = "!&|+$%(,)*<>-/=#^\\?"
 
 -- | Update the sqlite database with the given haddock artifact.
-fromArtifact :: Ghc.PackageKey -> Connection -> Artifact -> M ()
+fromArtifact :: Ghc.UnitId -> Connection -> Artifact -> M ()
 fromArtifact p conn art = do
   attributes <- toAttributes
   case attributes of 
@@ -85,7 +87,7 @@ fromArtifact p conn art = do
          return Nothing 
        Package                 ->  
          return . Just $ 
-           (Ghc.packageKeyString p, "Package", "index.html", [])
+           (Ghc.unitIdString p, "Package", "index.html", [])
        Module ghcmod           -> 
          return . Just $
             (modStr ghcmod, "Module" , modUrl ghcmod ++ ".html" , modStr ghcmod)

src/Options.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Options where
-import           Data.Monoid
 import qualified Distribution.Package as C
 import           Distribution.Text
 import qualified Distribution.Version as V
@@ -79,7 +78,7 @@ parser =
       return $ if (L.null str') then Nothing else (Just str')
 
     versionless :: C.PackageIdentifier -> Bool 
-    versionless p = C.packageVersion p == V.Version [] []
+    versionless p = C.packageVersion p == V.nullVersion
 
     dep :: ReadM C.Dependency 
     dep = do

src/Options/Cabal.hs

@@ -7,17 +7,18 @@ import           Control.Monad.M
 
 import qualified Data.List as L
 import           Control.Monad
-import qualified Distribution.PackageDescription.Parse as C
+import qualified Distribution.PackageDescription.Parsec as C
 import qualified Distribution.Package as C
 import qualified Distribution.Version as C
 import qualified Distribution.PackageDescription as C
+import           Distribution.Verbosity
 import           Data.String.Util
 import           Control.Monad.IO.Class
 import           Data.Function (on)
 import           Data.Maybe
 
 toPkgName :: C.Dependency -> String
-toPkgName (C.Dependency (C.PackageName name) _) = name
+toPkgName (C.Dependency name _) = C.unPackageName name
 
 vintersection :: C.Dependency -> C.Dependency -> Bool
 vintersection (C.Dependency _ lv) (C.Dependency _ rv) = 
@@ -60,17 +61,8 @@ fromExclusions exclusions deps = do
 -- 2 unversioned packageId's satisfy cabal constraints 
 readPackages :: FilePath -> S.Set String -> M [C.Dependency]
 readPackages cabal_path exclusions = do 
-  parse_result <- liftIO $ C.parsePackageDescription <$> readFile cabal_path
-  case parse_result of
-    (C.ParseFailed fail_msg) ->
-      err . show $ fail_msg
-    (C.ParseOk warnings desc) -> do
-      unless (L.null warnings) . warning $ 
-        preposition 
-          "warnings during parse" "of" "cabal file" "warnings"
-          (map show warnings)
-      msg $ "parsing cabal file: " ++ cabal_path
-      fromExclusions exclusions . toDeps $ desc
+  parse_result <- liftIO $ C.readGenericPackageDescription normal cabal_path
+  fromExclusions exclusions . toDeps $ parse_result
    where
     toDeps :: C.GenericPackageDescription -> [C.Dependency] 
     toDeps gpd =

src/PackageConf.hs

@@ -4,7 +4,7 @@ import FilePath
 import Data.Maybe (catMaybes) 
 
 data PackageConf = PackageConf
-  { pkg           :: Ghc.PackageKey
+  { pkg           :: Ghc.UnitId
   , interfaceFile :: FilePath -- interface, i.e. .haddock file
   , htmlDir       :: FilePath -- root html source directory
   , exposed       :: Bool     -- module exposure flag

src/PackageId.hs

@@ -2,11 +2,8 @@ module PackageId where
 import Distribution.Package
 import Distribution.Version
 
-emptyVersion :: Version
-emptyVersion = Version [] []
-
 unversioned :: PackageId -> PackageId
-unversioned p = p { pkgVersion = emptyVersion } 
+unversioned p = p { pkgVersion = nullVersion }
 
 versionless :: String -> PackageId
-versionless n = PackageIdentifier (PackageName n) emptyVersion 
+versionless n = PackageIdentifier (mkPackageName n) nullVersion

src/Pipe/Conf.hs

@@ -67,8 +67,8 @@ cabalDb db =
 ghcVersionRange :: CV.VersionRange
 ghcVersionRange =
  CV.intersectVersionRanges
-   (CV.orLaterVersion (CV.Version [7,10]   []))
-   (CV.earlierVersion (CV.Version [7,10,2] []))
+   (CV.orLaterVersion (CV.mkVersion [7,10]  ))
+   (CV.earlierVersion (CV.mkVersion [8,6,5]))
 
 toIndex :: [CC.PackageDB] -> M CI.InstalledPackageIndex
 toIndex stack = do
@@ -87,8 +87,19 @@ toIndex stack = do
     minimal_programs <- CP.configureAllKnownPrograms CVB.normal $
       CP.restoreProgramDb [CP.ghcPkgProgram, CP.ghcProgram] CP.emptyProgramDb
 
-    CG.getInstalledPackages CVB.silent stack minimal_programs
+    CG.getInstalledPackages CVB.silent nullCompiler stack minimal_programs
   where
+    -- TODO: figure out how to get the real compiler information
+    nullCompiler :: CC.Compiler
+    nullCompiler =
+      CC.Compiler
+        { CC.compilerId = CC.CompilerId CC.GHC (CV.mkVersion [8,6,5]),
+          CC.compilerAbiTag = CC.NoAbiTag,
+          CC.compilerCompat = mempty,
+          CC.compilerLanguages = mempty,
+          CC.compilerExtensions = mempty,
+          CC.compilerProperties = mempty
+        }
     clause :: String
     clause =
       "results may not match current supported haddock: "
@@ -109,7 +120,7 @@ fromIndex dep index =
       htmlDir'       <- listToMaybe $ CI.haddockHTMLs info
       return $
         PackageConf
-          (Ghc.stringToPackageKey . show . CT.disp $ CI.sourcePackageId info)
+          (Ghc.stringToUnitId . show . CT.disp $ CI.sourcePackageId info)
           interfaceFile' htmlDir'
           (CI.exposed info)
 

src/Pipe/FileSystem.hs

@@ -41,8 +41,8 @@ plist str = unlines $
   , "</plist>"
   ]
 
-docsetDir :: Ghc.PackageKey -> FilePath
-docsetDir k = Ghc.packageKeyString k ++ ".docset" 
+docsetDir :: Ghc.UnitId -> FilePath
+docsetDir k = Ghc.unitIdString k ++ ".docset"
 
 leafs :: (FilePath -> Bool) -> FilePath -> ProducerM FilePath ()
 leafs incPred p = do
@@ -89,10 +89,10 @@ toRelativePath base path = do
        . length 
        . splitPath <$> stripPrefix pfx base 
 
-relativize :: Ghc.PackageKey -> FilePath -> Either String T.Text 
+relativize :: Ghc.UnitId -> FilePath -> Either String T.Text
 relativize package p = 
   let filename'      = takeFileName p
-      packageSubpath = Ghc.packageKeyString package
+      packageSubpath = Ghc.unitIdString package
       matches        = 
         filter (packageSubpath ==) . reverse $ splitPath (parent p)
   in 
@@ -102,7 +102,7 @@ relativize package p =
       else -- assume as a package doc file and make relative
         toRelativePath packageSubpath $ L.head matches </> filename'
 
-convertUrl ::  Ghc.PackageKey -> T.Text -> Either String T.Text 
+convertUrl ::  Ghc.UnitId -> T.Text -> Either String T.Text
 convertUrl p urlExp 
   | T.null urlExp = Right T.empty
   | otherwise     =  
@@ -122,7 +122,7 @@ attributes src other            =
     ++ show other  ++ "\n in: \n" ++ src 
 
 -- | Convert local package-compiled haddock links to local relative. 
-convertLink :: Ghc.PackageKey -> FilePath -> Tag' -> Either String Tag'
+convertLink :: Ghc.UnitId -> FilePath -> Tag' -> Either String Tag'
 convertLink package src tag =
   -- We're only interested in processing links             
   if not $ tagOpenLit "a" (anyAttrNameLit "href") tag then  
@@ -139,7 +139,7 @@ convertLink package src tag =
         Right . TagOpen "a" $ ("href", url') : preserved 
 
 pipe_htmlConvert :: 
-  Ghc.PackageKey -> PipeM FilePath (FilePath, Maybe String) ()
+  Ghc.UnitId -> PipeM FilePath (FilePath, Maybe String) ()
 pipe_htmlConvert p = 
   forever $ do
     src <- await
@@ -185,7 +185,7 @@ cons_writeFiles :: FilePath -> ConsumerM PackageConf ()
 cons_writeFiles docsets_root = forever $ do
   conf <- await
 
-  lift . msg $ "processing: " ++ (Ghc.packageKeyString . pkg $ conf)
+  lift . msg $ "processing: " ++ (Ghc.unitIdString . pkg $ conf)
   let docset_folder = docsetDir (pkg conf) 
       dst_root      = docsets_root </> docset_folder 
       dst_doc_root  = dst_root </> "Contents/Resources/Documents/"
@@ -207,7 +207,7 @@ cons_writeFiles docsets_root = forever $ do
   --    runHaddockIndex (interfaceFile conf) dst_doc_root
   lift . indentM 2 $ msg "writing plist.."
   liftIO . writeFile (dst_root </> "Contents/Info.plist") . plist . 
-    Ghc.packageKeyString . pkg $ conf 
+    Ghc.unitIdString . pkg $ conf
 
   let db_path = dst_root </> "Contents/Resources/docSet.dsidx" 
 
@@ -223,7 +223,7 @@ cons_writeFiles docsets_root = forever $ do
 
   lift . indentM 2 $ msg "populating database.."
 
-  -- Populate the SQlite Db 
+  -- Populate the SQlite Db
   liftIO $ execute_ c' "BEGIN;"
   artifacts <- lift $ toArtifacts (pkg conf) (interfaceFile conf) 
   lift $ mapM_ (fromArtifact (pkg conf) c') artifacts