Move stack code into seperate module

Language/Haskell/GhcMod/CabalHelper.hs

@@ -42,6 +42,7 @@ import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Logging
 import Language.Haskell.GhcMod.Output
 import Language.Haskell.GhcMod.CustomPackageDb
+import Language.Haskell.GhcMod.Stack
 import System.FilePath
 import System.Process
 import System.Exit
@@ -137,16 +138,6 @@ prepareCabalHelper = do
   when (isCabalHelperProject $ cradleProject crdl) $
        withCabal $ liftIO $ prepare readProc projdir distdir
 
-patchStackPrograms :: (IOish m, GmOut m) => Cradle -> Programs -> m Programs
-patchStackPrograms Cradle { cradleProject = (StackProject senv) } progs = do
-  Just ghc <- getStackGhcPath senv
-  Just ghcPkg <- getStackGhcPkgPath senv
-  return $ progs {
-      ghcProgram = ghc
-    , ghcPkgProgram = ghcPkg
-    }
-patchStackPrograms _crdl progs = return progs
-
 withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
 withCabal action = do
     crdl <- cradle

Language/Haskell/GhcMod/Cradle.hs

@@ -14,6 +14,7 @@ import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
+import Language.Haskell.GhcMod.Stack
 
 import Control.Applicative
 import Control.Monad

Language/Haskell/GhcMod/Debug.hs

@@ -14,8 +14,8 @@ import Language.Haskell.GhcMod.Internal
 import Language.Haskell.GhcMod.Target
 import Language.Haskell.GhcMod.Pretty
 import Language.Haskell.GhcMod.Utils
-import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Cradle
+import Language.Haskell.GhcMod.Stack
 
 ----------------------------------------------------------------
 

Language/Haskell/GhcMod/GhcPkg.hs

@@ -23,6 +23,7 @@ import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.CabalHelper
 import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.CustomPackageDb
+import Language.Haskell.GhcMod.Stack
 
 ghcVersion :: Int
 ghcVersion = read cProjectVersionInt
@@ -72,7 +73,6 @@ getGhcPkgProgram = do
     _ ->
         return $ ghcPkgProgram progs
 
-
 getPackageDbStack :: IOish m => GhcModT m [GhcPkgDb]
 getPackageDbStack = do
   crdl <- cradle

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -86,46 +86,6 @@ findStackConfigFile dir = do
       Just (d, Just a)  -> return $ Just $ d </> a
       Just (_, Nothing) -> error "findStackConfigFile"
 
-getStackEnv :: (IOish m, GmOut m) => FilePath -> m (Maybe StackEnv)
-getStackEnv projdir = U.withDirectory_ projdir $ runMaybeT $ do
-    env <- map (liToTup . splitOn ": ") . lines <$> readStack ["path"]
-    let look k = fromJust $ lookup k env
-    return StackEnv {
-        seDistDir       = look "dist-dir"
-      , seBinPath       = splitSearchPath $ look "bin-path"
-      , seSnapshotPkgDb = look "snapshot-pkg-db"
-      , seLocalPkgDb    = look "local-pkg-db"
-      }
- where
-   liToTup [k,v] = (k,v)
-   liToTup _ = error "getStackEnv"
-
-getStackGhcPath :: IOish m => StackEnv -> m (Maybe FilePath)
-getStackGhcPath = findExecutablesInStackBinPath "ghc"
-
-getStackGhcPkgPath :: IOish m => StackEnv -> m (Maybe FilePath)
-getStackGhcPkgPath = findExecutablesInStackBinPath  "ghc-pkg"
-
-findExecutablesInStackBinPath :: IOish m => String -> StackEnv -> m (Maybe FilePath)
-findExecutablesInStackBinPath exe StackEnv {..} =
-    liftIO $ listToMaybe <$> findExecutablesInDirectories' seBinPath exe
-
-findExecutablesInDirectories' :: [FilePath] -> String -> IO [FilePath]
-findExecutablesInDirectories' path binary =
-    U.findFilesWith' isExecutable path (binary <.> exeExtension)
-   where isExecutable file = do
-             perms <- getPermissions file
-             return $ executable perms
-
-         exeExtension = if isWindows then "exe" else ""
-
-readStack :: (IOish m, GmOut m) => [String] -> MaybeT m String
-readStack args = do
-  stack <- MaybeT $ liftIO $ findExecutable "stack"
-  readProc <- lift gmReadProcess
-  liftIO $ flip E.catch (\(e :: IOError) -> throw $ GMEStackBootrap $ show e) $ do
-    evaluate =<< readProc stack args ""
-
 -- | Get path to sandbox config file
 getSandboxDb :: Cradle -> IO (Maybe GhcPkgDb)
 getSandboxDb crdl = do

Language/Haskell/GhcMod/Stack.hs

@@ -0,0 +1,89 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+module Language.Haskell.GhcMod.Stack where
+
+
+import Control.Applicative
+import Control.Exception as E
+import Control.Monad
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Class
+import Data.List
+import Data.List.Split
+import Data.Maybe
+import System.Directory
+import System.FilePath
+import System.Info.Extra
+import Exception
+
+import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Monad.Types
+import Language.Haskell.GhcMod.Output
+import qualified Language.Haskell.GhcMod.Utils as U
+import Prelude
+
+patchStackPrograms :: (IOish m, GmOut m) => Cradle -> Programs -> m Programs
+patchStackPrograms Cradle { cradleProject = (StackProject senv) } progs = do
+  Just ghc <- getStackGhcPath senv
+  Just ghcPkg <- getStackGhcPkgPath senv
+  return $ progs {
+      ghcProgram = ghc
+    , ghcPkgProgram = ghcPkg
+    }
+patchStackPrograms _crdl progs = return progs
+
+getStackEnv :: (IOish m, GmOut m) => FilePath -> m (Maybe StackEnv)
+getStackEnv projdir = U.withDirectory_ projdir $ runMaybeT $ do
+    env <- map (liToTup . splitOn ": ") . lines <$> readStack ["path"]
+    let look k = fromJust $ lookup k env
+    return StackEnv {
+        seDistDir       = look "dist-dir"
+      , seBinPath       = splitSearchPath $ look "bin-path"
+      , seSnapshotPkgDb = look "snapshot-pkg-db"
+      , seLocalPkgDb    = look "local-pkg-db"
+      }
+ where
+   liToTup [k,v] = (k,v)
+   liToTup _ = error "getStackEnv"
+
+getStackGhcPath :: IOish m => StackEnv -> m (Maybe FilePath)
+getStackGhcPath = findExecutablesInStackBinPath "ghc"
+
+getStackGhcPkgPath :: IOish m => StackEnv -> m (Maybe FilePath)
+getStackGhcPkgPath = findExecutablesInStackBinPath  "ghc-pkg"
+
+findExecutablesInStackBinPath :: IOish m => String -> StackEnv -> m (Maybe FilePath)
+findExecutablesInStackBinPath exe StackEnv {..} =
+    liftIO $ listToMaybe <$> findExecutablesInDirectories' seBinPath exe
+
+findExecutablesInDirectories' :: [FilePath] -> String -> IO [FilePath]
+findExecutablesInDirectories' path binary =
+    U.findFilesWith' isExecutable path (binary <.> exeExtension)
+   where isExecutable file = do
+             perms <- getPermissions file
+             return $ executable perms
+
+         exeExtension = if isWindows then "exe" else ""
+
+readStack :: (IOish m, GmOut m) => [String] -> MaybeT m String
+readStack args = do
+  stack <- MaybeT $ liftIO $ findExecutable "stack"
+  readProc <- lift gmReadProcess
+  lift $ flip gcatch (\(e :: IOError) -> exToErr e) $ do
+    liftIO $ evaluate =<< readProc stack args ""
+ where
+   exToErr = throw . GMEStackBootrap . show

ghc-mod.cabal

@@ -138,6 +138,7 @@ Library
                         Language.Haskell.GhcMod.Pretty
                         Language.Haskell.GhcMod.Read
                         Language.Haskell.GhcMod.SrcUtils
+                        Language.Haskell.GhcMod.Stack
                         Language.Haskell.GhcMod.Target
                         Language.Haskell.GhcMod.Types
                         Language.Haskell.GhcMod.Utils