Fix checkComponent
This commit is contained in:
parent
9077e96aeb
commit
95b16ded6d
@ -1,10 +1,12 @@
|
|||||||
module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo, componentInfo) where
|
module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo, componentInfo) where
|
||||||
|
|
||||||
import Control.Arrow (first)
|
import Control.Arrow (first)
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
import Data.List.Split
|
||||||
import Text.PrettyPrint
|
import Text.PrettyPrint
|
||||||
import Language.Haskell.GhcMod.Convert
|
import Language.Haskell.GhcMod.Convert
|
||||||
import Language.Haskell.GhcMod.Monad
|
import Language.Haskell.GhcMod.Monad
|
||||||
@ -13,6 +15,7 @@ import Language.Haskell.GhcMod.Internal
|
|||||||
import Language.Haskell.GhcMod.CabalHelper
|
import Language.Haskell.GhcMod.CabalHelper
|
||||||
import Language.Haskell.GhcMod.Target
|
import Language.Haskell.GhcMod.Target
|
||||||
import Language.Haskell.GhcMod.Pretty
|
import Language.Haskell.GhcMod.Pretty
|
||||||
|
import Language.Haskell.GhcMod.Utils
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
@ -60,7 +63,7 @@ componentInfo ts = do
|
|||||||
-- TODO: most of this is copypasta of targetGhcOptions. Factor out more
|
-- TODO: most of this is copypasta of targetGhcOptions. Factor out more
|
||||||
-- useful function from there.
|
-- useful function from there.
|
||||||
crdl <- cradle
|
crdl <- cradle
|
||||||
let sefnmn = Set.fromList $ map guessModuleFile ts
|
sefnmn <- Set.fromList `liftM` mapM guessModuleFile ts
|
||||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
||||||
mcs <- resolveGmComponents Nothing comps
|
mcs <- resolveGmComponents Nothing comps
|
||||||
let
|
let
|
||||||
@ -79,10 +82,17 @@ componentInfo ts = do
|
|||||||
where
|
where
|
||||||
zipMap f l = l `zip` (f `map` l)
|
zipMap f l = l `zip` (f `map` l)
|
||||||
|
|
||||||
guessModuleFile :: String -> Either FilePath ModuleName
|
guessModuleFile :: MonadIO m => String -> m (Either FilePath ModuleName)
|
||||||
guessModuleFile mn@(h:r)
|
guessModuleFile m
|
||||||
| isUpper h && all isAlphaNum r = Right $ mkModuleName mn
|
| (isUpper . head .&&. (all $ all $ isAlphaNum .||. (=='.')) . splitOn ".") m =
|
||||||
guessModuleFile str = Left str
|
return $ Right $ mkModuleName m
|
||||||
|
where
|
||||||
|
infixr 1 .||.
|
||||||
|
infixr 2 .&&.
|
||||||
|
(.||.) = liftA2 (||)
|
||||||
|
(.&&.) = liftA2 (&&)
|
||||||
|
|
||||||
|
guessModuleFile str = Left `liftM` liftIO (canonFilePath str)
|
||||||
|
|
||||||
graphDoc :: GmModuleGraph -> Doc
|
graphDoc :: GmModuleGraph -> Doc
|
||||||
graphDoc GmModuleGraph{..} =
|
graphDoc GmModuleGraph{..} =
|
||||||
|
@ -34,6 +34,7 @@ import System.FilePath (splitDrive, takeDirectory, takeFileName, pathSeparators,
|
|||||||
(</>))
|
(</>))
|
||||||
import System.IO.Temp (createTempDirectory)
|
import System.IO.Temp (createTempDirectory)
|
||||||
import System.Environment
|
import System.Environment
|
||||||
|
import System.Directory
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
|
|
||||||
import Paths_ghc_mod (getLibexecDir)
|
import Paths_ghc_mod (getLibexecDir)
|
||||||
@ -159,3 +160,9 @@ getExecutablePath' = getExecutablePath
|
|||||||
#else
|
#else
|
||||||
getExecutablePath' = getProgName
|
getExecutablePath' = getProgName
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
canonFilePath f = do
|
||||||
|
p <- canonicalizePath f
|
||||||
|
e <- doesFileExist p
|
||||||
|
when (not e) $ error $ "canonFilePath: not a file: " ++ p
|
||||||
|
return p
|
||||||
|
Loading…
Reference in New Issue
Block a user