To break cyclic import, this patch makes GhcPkg.hs independent from Monad.hs(refactoring for #244)

This removes `ghcPkgList`, `ghcPkgListEx` and `ghcPkgDbOpt`. I'm not sure
this is a right way to do.

Language/Haskell/GhcMod/GhcPkg.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-}
 module Language.Haskell.GhcMod.GhcPkg (
-    ghcPkgList
+    ghcPkgDbOpt
-  , ghcPkgListEx
-  , ghcPkgDbOpt
   , ghcPkgDbStackOpts
   , ghcDbStackOpts
   , ghcDbOpt
@@ -12,26 +10,17 @@ module Language.Haskell.GhcMod.GhcPkg (
   , getPackageDbStack
   ) where
 
-import Config (cProjectVersionInt,cProjectVersion,cTargetPlatformString)
+import Config (cProjectVersionInt)
-import DynFlags (DynFlags(..), systemPackageConfig,getDynFlags)
+import Control.Applicative ((<$>))
-import Exception (handleIO)
-import CoreMonad (liftIO)
-import Control.Applicative ((<$>),(<*>),(*>))
 import Control.Exception (SomeException(..))
-import Control.Monad (void)
 import qualified Control.Exception as E
-import Data.Char (isSpace,isAlphaNum)
+import Data.Char (isSpace)
 import Data.List (isPrefixOf, intercalate)
 import Data.List.Split (splitOn)
-import Data.Maybe (catMaybes)
 import Distribution.Package (InstalledPackageId(..))
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
-import {-# SOURCE #-} Language.Haskell.GhcMod.Monad
 import System.FilePath ((</>))
-import System.Directory (getAppUserDataDirectory,doesDirectoryExist)
-import Text.ParserCombinators.ReadP (ReadP, char, satisfy, between, sepBy1, many1, manyTill, skipMany, skipSpaces, string, choice)
-import qualified Text.ParserCombinators.ReadP as P
 
 ghcVersion :: Int
 ghcVersion = read cProjectVersionInt
@@ -65,43 +54,6 @@ getPackageDbStack cdir =
     (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
       `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb]
 
-
-
--- Copied from ghc module `Packages' unfortunately it's not exported :/
-resolvePackageDb :: DynFlags -> GhcPkgDb -> IO (Maybe FilePath)
-resolvePackageDb df GlobalDb = return $ Just (systemPackageConfig df)
-resolvePackageDb _ UserDb = handleIO (\_ -> return Nothing) $ do
-  appdir <- getAppUserDataDirectory "ghc"
-  let dir = appdir </> (target_os ++ '-':target_arch ++ '-':cProjectVersion)
-      pkgconf = dir </> "package.conf.d"
-  exist <- doesDirectoryExist pkgconf
-  return $ if exist then Just pkgconf else Nothing
- where
-  [target_arch,_,target_os] = splitOn "-" cTargetPlatformString
-resolvePackageDb _ (PackageDb name) = return $ Just name
-
-
--- | List packages in one or more ghc package store
-ghcPkgList :: [GhcPkgDb] -> GhcMod [PackageBaseName]
-ghcPkgList dbs = map fst3 <$> ghcPkgListEx dbs
-  where fst3 (x,_,_) = x
-
-ghcPkgListEx :: [GhcPkgDb] -> GhcMod [Package]
-ghcPkgListEx dbs = do
-    df <- getDynFlags
-    out <- liftIO $ readProcess' "ghc-pkg" opts
-    rdbs <- catMaybes <$> mapM (liftIO . resolvePackageDb df) dbs
-    return $ concatMap snd $ filter ((`elem` rdbs) . fst) $ parseGhcPkgOutput out
- where
-    opts = ["list", "-v"] ++ ghcPkgDbStackOpts dbs
-
-parseGhcPkgOutput :: String -> [(FilePath, [Package])]
-parseGhcPkgOutput p =
-    case P.readP_to_S ghcPkgOutputP p of
-      (a, rest):_  | all isSpace rest -> a
-      res@(a,reset):_ -> error $ "parseGhcPkgOutput: " ++ show a ++ "\nwith rest:```" ++ reset ++ "```\n\nwhole result: " ++ show res
-      _ -> error $ "parseGhcPkgOutput: failed to parse output!\n\n" ++ p
-
 fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
 fromInstalledPackageId' pid = let
     InstalledPackageId pkg = pid
@@ -116,59 +68,6 @@ fromInstalledPackageId pid =
       Nothing -> error $
         "fromInstalledPackageId: `"++show pid++"' is not a valid package-id"
 
-ghcPkgOutputP :: ReadP [(FilePath, [Package])]
-ghcPkgOutputP = do
-  dbs <- ghcPkgOutputP'
-  return $ do
-    (path, ps) <- dbs
-    return (path,map snd $ filter ((`elem`[Normal,Hidden]) . fst) ps)
-
-ghcPkgOutputP' :: ReadP [(FilePath, [(PackageState, Package)])]
-ghcPkgOutputP' = do
-    skipUseCacheLinesP *> (many1 $ (,) <$> pathLineP <*> many1 packageLineP)
- where
-    skipUseCacheLinesP = skipMany $ do
-      void $ string "using cache:"
-      void $ manyTill (satisfy $ const True) (char '\n')
-
-pathLineP :: ReadP FilePath
-pathLineP = do
-    p <- (:) <$> char '/' <*> manyTill (satisfy $ const True) (char ':')
-    void $ char '\n'
-    return p
-
-data PackageState = Normal | Hidden | Broken deriving (Eq,Show)
-
-packageLineP :: ReadP (PackageState, Package)
-packageLineP = do
-    skipSpaces
-    p <- choice [ (Hidden,) <$> between (char '(') (char ')') packageP
-                , (Broken,) <$> between (char '{') (char '}') packageP
-                , (Normal,) <$> packageP ]
-    void $ char '\n'
-    return p
-
-packageP :: ReadP (PackageBaseName, PackageVersion, PackageId)
-packageP = do
-    pkgSpec@(name,ver) <- packageSpecP
-    skipSpaces
-    i <- between (char '(') (char ')') $ packageIdSpecP pkgSpec
-    return (name,ver,i)
-
-packageSpecP :: ReadP (PackageBaseName,PackageVersion)
-packageSpecP = do
-  fs <- many1 packageCompCharP `sepBy1` char '-'
-  return (intercalate "-" (init fs), last fs)
-
-packageIdSpecP :: (PackageBaseName,PackageVersion) -> ReadP PackageId
-packageIdSpecP (name,ver) = do
-    string name >> char '-' >> string ver >> char '-' >> return ()
-    many1 (satisfy isAlphaNum)
-
-packageCompCharP :: ReadP Char
-packageCompCharP =
-    satisfy $ \c -> isAlphaNum c || c `elem` "_-."
-
 -- | Get options needed to add a list of package dbs to ghc-pkg's db stack
 ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
                   -> [String]

Language/Haskell/GhcMod/Monad.hs-boot

@@ -1,16 +0,0 @@
-{-# LANGUAGE RoleAnnotations #-}
-module Language.Haskell.GhcMod.Monad where
-
-import DynFlags (HasDynFlags)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Applicative (Applicative)
-
-data GhcMod a
-type role GhcMod nominal
-
-instance Functor GhcMod
-instance Applicative GhcMod
-instance Monad GhcMod
-
-instance HasDynFlags GhcMod
-instance MonadIO GhcMod

test/GhcPkgSpec.hs

@@ -1,18 +1,11 @@
 module GhcPkgSpec where
 
-import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.GhcPkg
-import Language.Haskell.GhcMod.Monad
 
-import CoreMonad (liftIO)
-
-import Control.Applicative
 import System.Directory
 import System.FilePath ((</>))
 import Test.Hspec
 
-import Dir
-
 spec :: Spec
 spec = do
     describe "getSandboxDb" $ do
@@ -23,10 +16,3 @@ spec = do
 
         it "throws an error if a config file is broken" $ do
             getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException
-
-    describe "getPackageDbPackages" $ do
-        it "find a config file and extracts packages" $
-           runGhcMod defaultOptions $ do
-            sdb <- liftIO $ getSandboxDb "test/data/check-packageid"
-            pkgs <- ghcPkgListEx [PackageDb sdb]
-            liftIO $ pkgs `shouldBe` [("template-haskell","2.8.0.0","32d4f24abdbb6bf41272b183b2e23e9c")]