Replace fromJust with fromJustNote everywhere

This commit is contained in:
Daniel Gröber 2016-01-13 04:49:38 +01:00
parent 0974eec9a5
commit 54fe4a0edb
7 changed files with 16 additions and 9 deletions

View File

@ -3,6 +3,7 @@ module Language.Haskell.GhcMod.Browse (
BrowseOpts(..) BrowseOpts(..)
) where ) where
import Safe
import Control.Applicative import Control.Applicative
import Control.Exception (SomeException(..)) import Control.Exception (SomeException(..))
import Data.Char import Data.Char
@ -49,7 +50,7 @@ browse opts pkgmdl = do
goHomeModule = runGmlT [Right mdlname] $ do goHomeModule = runGmlT [Right mdlname] $ do
processExports opts =<< tryModuleInfo =<< G.findModule mdlname Nothing processExports opts =<< tryModuleInfo =<< G.findModule mdlname Nothing
tryModuleInfo m = fromJust <$> G.getModuleInfo m tryModuleInfo m = fromJustNote "browse, tryModuleInfo" <$> G.getModuleInfo m
(mpkg, mdl) = splitPkgMdl pkgmdl (mpkg, mdl) = splitPkgMdl pkgmdl
mdlname = G.mkModuleName mdl mdlname = G.mkModuleName mdl

View File

@ -19,6 +19,7 @@ import Language.Haskell.GhcMod.Stack
import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Error
import Safe
import Control.Applicative import Control.Applicative
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.Maybe import Data.Maybe
@ -46,7 +47,7 @@ findCradle' dir = run $
, sandboxCradle dir , sandboxCradle dir
, plainCradle dir , plainCradle dir
] ]
where run a = fillTempDir =<< (fromJust <$> runMaybeT a) where run a = fillTempDir =<< (fromJustNote "findCradle'" <$> runMaybeT a)
findSpecCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle findSpecCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
findSpecCradle dir = do findSpecCradle dir = do

View File

@ -73,6 +73,8 @@ import Language.Haskell.GhcMod.Monad.Out
import Language.Haskell.GhcMod.Monad.Newtypes import Language.Haskell.GhcMod.Monad.Newtypes
import Language.Haskell.GhcMod.Monad.Orphans () import Language.Haskell.GhcMod.Monad.Orphans ()
import Safe
import GHC import GHC
import DynFlags import DynFlags
import Exception import Exception
@ -116,13 +118,13 @@ instance (MonadIO m, MonadBaseControl IO m) => GhcMonad (GmlT m) where
-- | Get the underlying GHC session -- | Get the underlying GHC session
gmlGetSession :: (MonadIO m, MonadBaseControl IO m) => GmlT m HscEnv gmlGetSession :: (MonadIO m, MonadBaseControl IO m) => GmlT m HscEnv
gmlGetSession = do gmlGetSession = do
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet ref <- gmgsSession . fromJustNote "gmlGetSession" . gmGhcSession <$> gmsGet
liftIO $ readIORef ref liftIO $ readIORef ref
-- | Set the underlying GHC session -- | Set the underlying GHC session
gmlSetSession :: (MonadIO m, MonadBaseControl IO m) => HscEnv -> GmlT m () gmlSetSession :: (MonadIO m, MonadBaseControl IO m) => HscEnv -> GmlT m ()
gmlSetSession a = do gmlSetSession a = do
ref <- gmgsSession . fromJust . gmGhcSession <$> gmsGet ref <- gmgsSession . fromJustNote "gmlSetSession" . gmGhcSession <$> gmsGet
liftIO $ flip writeIORef a ref liftIO $ flip writeIORef a ref
instance GhcMonad LightGhc where instance GhcMonad LightGhc where

View File

@ -16,7 +16,7 @@
module Language.Haskell.GhcMod.Stack where module Language.Haskell.GhcMod.Stack where
import Safe
import Control.Applicative import Control.Applicative
import Control.Exception as E import Control.Exception as E
import Control.Monad import Control.Monad
@ -51,7 +51,7 @@ patchStackPrograms _crdl progs = return progs
getStackEnv :: (IOish m, GmOut m, GmLog m) => FilePath -> m (Maybe StackEnv) getStackEnv :: (IOish m, GmOut m, GmLog m) => FilePath -> m (Maybe StackEnv)
getStackEnv projdir = U.withDirectory_ projdir $ runMaybeT $ do getStackEnv projdir = U.withDirectory_ projdir $ runMaybeT $ do
env <- map (liToTup . splitOn ": ") . lines <$> readStack ["path"] env <- map (liToTup . splitOn ": ") . lines <$> readStack ["path"]
let look k = fromJust $ lookup k env let look k = fromJustNote "getStackEnv" $ lookup k env
return StackEnv { return StackEnv {
seDistDir = look "dist-dir" seDistDir = look "dist-dir"
, seBinPath = splitSearchPath $ look "bin-path" , seBinPath = splitSearchPath $ look "bin-path"

View File

@ -40,6 +40,7 @@ import Language.Haskell.GhcMod.LightGhc
import Language.Haskell.GhcMod.CustomPackageDb import Language.Haskell.GhcMod.CustomPackageDb
import Language.Haskell.GhcMod.Output import Language.Haskell.GhcMod.Output
import Safe
import Data.Maybe import Data.Maybe
import Data.Monoid as Monoid import Data.Monoid as Monoid
import Data.Either import Data.Either
@ -188,13 +189,13 @@ targetGhcOptions crdl sefnmn = do
let cns = filter (/= ChSetupHsName) $ Map.keys mcs let cns = filter (/= ChSetupHsName) $ Map.keys mcs
gmLog GmDebug "" $ strDoc $ "Could not find a component assignment, falling back to picking library component in cabal file." gmLog GmDebug "" $ strDoc $ "Could not find a component assignment, falling back to picking library component in cabal file."
return $ gmcGhcOpts $ fromJust $ Map.lookup (head cns) mcs return $ gmcGhcOpts $ fromJustNote "targetGhcOptions, no-assignment" $ Map.lookup (head cns) mcs
else do else do
when noCandidates $ when noCandidates $
throwError $ GMECabalCompAssignment mdlcs throwError $ GMECabalCompAssignment mdlcs
let cn = pickComponent candidates let cn = pickComponent candidates
return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs return $ gmcGhcOpts $ fromJustNote "targetGhcOptions" $ Map.lookup cn mcs
resolvedComponentsCache :: IOish m => FilePath -> resolvedComponentsCache :: IOish m => FilePath ->
Cached (GhcModT m) GhcModState Cached (GhcModT m) GhcModState

View File

@ -8,6 +8,7 @@ import Distribution.Simple.InstallDirs as ID
import Distribution.Simple.LocalBuildInfo import Distribution.Simple.LocalBuildInfo
import Distribution.PackageDescription import Distribution.PackageDescription
import Safe
import Control.Arrow import Control.Arrow
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
@ -99,7 +100,7 @@ xInstallTarget pd lbi fn = do
libexecdir' = fromPathTemplate (libexecdir idirtpl) libexecdir' = fromPathTemplate (libexecdir idirtpl)
pd_extended = onlyExePackageDesc [exe] pd pd_extended = onlyExePackageDesc [exe] pd
install_target = fromJust $ installTarget exe install_target = fromJustNote "xInstallTarget" $ installTarget exe
install_target' = ID.substPathTemplate env install_target install_target' = ID.substPathTemplate env install_target
-- $libexec isn't a real thing :/ so we have to simulate it -- $libexec isn't a real thing :/ so we have to simulate it
install_target'' = substLibExec' libexecdir' install_target' install_target'' = substLibExec' libexecdir' install_target'

View File

@ -186,6 +186,7 @@ Library
, fclabels == 2.0.* , fclabels == 2.0.*
, extra == 1.4.* , extra == 1.4.*
, pipes == 4.1.* , pipes == 4.1.*
, safe < 0.4 && >= 0.3.9
if impl(ghc < 7.8) if impl(ghc < 7.8)
Build-Depends: convertible Build-Depends: convertible
if impl(ghc < 7.5) if impl(ghc < 7.5)