1 files changed, 86 insertions, 0 deletions
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
new file mode 100644
index 0000000..4751f0a
--- /dev/null
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -0,0 +1,86 @@
+-- cabal-helper: Simple interface to Cabal's configuration state
+-- Copyright (C) 2018  Daniel Gröber <cabal-helper@dxld.at>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU 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 General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-|
+Module      : CabalHelper.Compiletime.Program.Stack
+Description : Stack program interface
+License     : GPL-3
+-}
+
+{-# LANGUAGE GADTs, DataKinds #-}
+
+module CabalHelper.Compiletime.Program.Stack where
+
+import Control.Monad
+import Data.Char
+import Data.List hiding (filter)
+import Data.String
+import Data.Maybe
+import Data.Function
+import System.FilePath hiding ((<.>))
+import Prelude
+
+import CabalHelper.Compiletime.Types
+import CabalHelper.Compiletime.Types.RelativePath
+
+getUnit :: QueryEnvI c 'Stack -> CabalFile -> IO Unit
+getUnit qe (CabalFile cabal_file) = do
+  let pkgdir = takeDirectory cabal_file
+  let pkg_name = dropExtension $ takeFileName cabal_file
+  look <- paths qe pkgdir
+  let distdirv1 = look "dist-dir:"
+  return $ Unit
+    { uUnitId     = UnitId pkg_name
+    , uPackageDir = pkgdir
+    , uDistDir    = DistDirLib distdirv1
+    }
+
+-- TODO: patch ghc/ghc-pkg program paths like in ghc-mod when using stack so
+-- compilation logic works even if no system compiler is installed
+
+packageDistDir :: QueryEnvI c 'Stack -> FilePath -> IO FilePath
+packageDistDir qe pkgdir = do
+  look <- paths qe pkgdir
+  return $ look "dist-dir:"
+
+projPaths :: QueryEnvI c 'Stack -> IO StackProjPaths
+projPaths qe@QueryEnv {qeProjectDir=ProjDirStack projdir} = do
+  look <- paths qe projdir
+  return StackProjPaths
+    { sppGlobalPkgDb = PackageDbDir $ look "global-pkg-db:"
+    , sppSnapPkgDb   = PackageDbDir $ look "snapshot-pkg-db:"
+    , sppLocalPkgDb  = PackageDbDir $ look "local-pkg-db:"
+    }
+
+paths :: QueryEnvI c 'Stack
+      -> FilePath
+      -> IO (String -> FilePath)
+paths qe dir = do
+    out <- qeReadProcess qe (Just dir) (stackProgram $ qePrograms qe)
+      (workdirArg qe ++ [ "path" ]) ""
+    return $ \k -> let Just x = lookup k $ map split $ lines out in x
+  where
+    split l = let (key, ' ' : val) = span (not . isSpace) l in (key, val)
+
+listPackageCabalFiles :: QueryEnvI c 'Stack -> IO [CabalFile]
+listPackageCabalFiles qe@QueryEnv{qeProjectDir=ProjDirStack projdir} = do
+  out <- qeReadProcess qe (Just projdir) (stackProgram $ qePrograms qe)
+    [ "ide", "packages", "--cabal-files" ] ""
+  return $ map CabalFile $ lines out
+
+workdirArg :: QueryEnvI c 'Stack -> [String]
+workdirArg QueryEnv{qeDistDir=DistDirStack mworkdir} =
+  maybeToList $ ("--work-dir="++) . unRelativePath <$> mworkdir