From 679c3145fb8fdc346880c205c9dde369e782feee Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Sun, 14 Oct 2018 03:32:49 +0200
Subject: Add stack support
---
cabal-helper.cabal | 2 +
lib/Distribution/Helper.hs | 200 +++++-----------------
src/CabalHelper/Compiletime/Program/Stack.hs | 86 ++++++++++
src/CabalHelper/Compiletime/Types.hs | 180 ++++++++++++++++++-
src/CabalHelper/Compiletime/Types/RelativePath.hs | 39 +++++
5 files changed, 352 insertions(+), 155 deletions(-)
create mode 100644 src/CabalHelper/Compiletime/Program/Stack.hs
create mode 100644 src/CabalHelper/Compiletime/Types/RelativePath.hs
diff --git a/cabal-helper.cabal b/cabal-helper.cabal
index 3115522..324fd26 100644
--- a/cabal-helper.cabal
+++ b/cabal-helper.cabal
@@ -93,7 +93,9 @@ library
CabalHelper.Compiletime.Compat.Version
CabalHelper.Compiletime.Compile
CabalHelper.Compiletime.Data
+ CabalHelper.Compiletime.Program.Stack
CabalHelper.Compiletime.Types
+ CabalHelper.Compiletime.Types.RelativePath
CabalHelper.Shared.Common
CabalHelper.Shared.InterfaceTypes
CabalHelper.Shared.Sandbox
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index edf71f7..ad77eb3 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -119,7 +119,9 @@ import Text.Show.Pretty
import Prelude
import CabalHelper.Compiletime.Compile
+import qualified CabalHelper.Compiletime.Program.Stack as Stack
import CabalHelper.Compiletime.Types
+import CabalHelper.Compiletime.Types.RelativePath
import CabalHelper.Shared.InterfaceTypes
import CabalHelper.Shared.Sandbox
import CabalHelper.Shared.Common
@@ -127,6 +129,7 @@ import CabalHelper.Shared.Common
import CabalHelper.Compiletime.Compat.Version
import qualified CabalHelper.Compiletime.Compat.ProgramDb as ProgDb
( defaultProgramDb, programPath, lookupProgram, ghcProgram, ghcPkgProgram)
+import CabalHelper.Shared.Common
import Distribution.System (buildPlatform)
import Distribution.Text (display)
@@ -139,160 +142,6 @@ import qualified CabalHelper.Compiletime.Compat.ProgramDb as ProgDb
import CabalHelper.Compiletime.Compat.Version
import CabalHelper.Shared.Common
-
--- | The kind of project being managed by a 'QueryEnv' (pun intended).
-data ProjType
- = V1 -- ^ @cabal v1-build@ project, see 'DistDirV1'
- | V2 -- ^ @cabal v2-build@ project, see 'DistDirV2'
-
--- | A project directory. The project type of a given directory can be
--- determined by trying to access a set of marker files. See below.
-data ProjDir (pt :: ProjType) where
- -- | A @cabal v1-build@ project directory can be identified by one file
- -- ending in @.cabal@ existing in the directory. More than one such files
- -- existing is a user error. Note: For this project type the concepts of
- -- project and package coincide.
- ProjDirV1 :: FilePath -> ProjDir 'V1
-
- -- | A @cabal v2-build@ project\'s marker file is called
- -- @cabal.project@. This configuration file points to the packages that make
- -- up this project.
- ProjDirV2 :: FilePath -> ProjDir 'V2
-
-data DistDir (pt :: ProjType) where
- -- | Build directory for cabal /old-build/ aka. /v1-build/ aka. just
- -- /build/. Planned to be superceeded by /v2-build/, see 'DistDirV2' for
- -- that.
- --
- -- You can tell a builddir is a /v1/ builddir by looking for a file
- -- called @setup-config@ directly underneath it.
- DistDirV1 :: FilePath -> DistDir 'V1
-
- -- | Build directory for cabal /new-build/ aka. /v2-build/, as of the time
- -- of this writing it is usually called @dist-newstyle/@ but this will
- -- presumably change once it becomes the default /build/ command.
- --
- -- You can tell a builddir is a /v2/ builddir by trying to access the path
- -- @cache/plan.json@ directly underneath it.
- DistDirV2 :: FilePath -> DistDir 'V2
-
--- | Environment for running a 'Query' value. The real constructor is
--- not exposed, use the 'mkQueryEnv' smart constructor instead. The field
--- accessors are exported and may be used to override the defaults, see below.
-type QueryEnv (proj_type :: ProjType)
- = QueryEnvI (QueryCache proj_type) proj_type
-
-data QueryEnvI cache (proj_type :: ProjType) = QueryEnv
- { qeReadProcess
- :: Maybe FilePath -> FilePath -> [String] -> String -> IO String
- -- ^ Field accessor for 'QueryEnv'. Function used to to start
- -- processes. Useful if you need to, for example, redirect standard error
- -- output away from the user\'s terminal.
-
- , qePrograms :: Programs
- -- ^ Field accessor for 'QueryEnv'.
-
- , qeProjectDir :: ProjDir proj_type
- -- ^ Field accessor for 'QueryEnv'. Defines path to the project directory,
- -- i.e. a directory containing a @cabal.project@ file
-
- , qeDistDir :: DistDir proj_type
- -- ^ Field accessor for 'QueryEnv'. Defines path to the @dist/@ or
- -- @dist-newstyle/@ directory, aka. /builddir/ in Cabal terminology.
-
- , qeCacheRef :: IORef cache
- -- ^ Cache for query results, only accessible when type parameter @cache@ is
- -- instantiated and not forall quantified.
- }
-
-data QueryCache pt = QueryCache
- { qcProjInfo :: !(Maybe (ProjInfo pt))
- , qcUnitInfos :: !(Map DistDirLib UnitInfo)
- }
-
-newtype DistDirLib = DistDirLib FilePath
- deriving (Eq, Ord, Read, Show)
-
--- | Abstractly speaking a Unit consists of a set of components (exes, libs,
--- tests etc.) which are managed by an instance of the Cabal build system. The
--- distinction between a Unit and a set of components is somewhat hard to
--- explain if you're not already familliar with the concept from
--- cabal-install. Luckily for most purposes the details may be ignored.
---
--- We merely use the concept of a Unit for caching purposes. It is necessary to
--- extract the information on all components in a Unit at the same time as we
--- must load all of it into memory before extracting any of it.
---
--- As opposed to components, different 'Unit's can be queried independently
--- since their on-disk information is stored separately.
-data Unit = Unit
- { uUnitId :: !UnitId
- , uPackageDir :: !FilePath
- , uDistDir :: !DistDirLib
- }
-
-newtype UnitId = UnitId String
- deriving (Eq, Ord, Read, Show)
-
--- | The information extracted from a 'Unit's on-disk configuration.
-data UnitInfo = UnitInfo
- { uiUnitId :: !UnitId
- -- ^ A unique identifier of this init within the project.
-
- , uiComponents :: !(Map ChComponentName ChComponentInfo)
- -- ^ The components of the unit: libraries, executables, test-suites,
- -- benchmarks and so on.
-
- , uiCompilerVersion :: !(String, Version)
- -- ^ The version of GHC the unit is configured to use
-
- , uiPackageDbStack :: !([ChPkgDb])
- -- ^ List of package databases to use.
-
- , uiPackageFlags :: !([(String, Bool)])
- -- ^ Flag definitions from cabal file
-
- , uiConfigFlags :: ![(String, Bool)]
- -- ^ Flag assignments from active configuration
-
- , uiNonDefaultConfigFlags :: ![(String, Bool)]
- -- ^ Flag assignments from setup-config which differ from the default
- -- setting. This can also include flags which cabal decided to modify,
- -- i.e. don't rely on these being the flags set by the user directly.
-
- , uiModTimes :: !UnitModTimes
- } deriving (Eq, Ord, Read, Show)
-
-data ProjInfo pt where
- ProjInfoV1 ::
- { piV1ProjConfModTimes :: !(ProjConfModTimes 'V1)
- } -> ProjInfo 'V1
-
- ProjInfoV2 ::
- { piV2ProjConfModTimes :: !(ProjConfModTimes 'V2)
- , piV2Plan :: !PlanJson
- , piV2PlanModTime :: !EpochTime
- } -> ProjInfo 'V2
-
-data ProjConfModTimes pt where
- ProjConfModTimesV1
- :: !(FilePath, EpochTime) -> ProjConfModTimes 'V1
- ProjConfModTimesV2
- :: !([(FilePath, EpochTime)]) -> ProjConfModTimes 'V2
-
-deriving instance Eq (ProjConfModTimes pt)
-
-piProjConfModTimes :: ProjInfo pt -> ProjConfModTimes pt
-piProjConfModTimes ProjInfoV1 {piV1ProjConfModTimes} =
- piV1ProjConfModTimes
-piProjConfModTimes ProjInfoV2 {piV2ProjConfModTimes} =
- piV2ProjConfModTimes
-
-data UnitModTimes = UnitModTimes
- { umtCabalFile :: !(FilePath, EpochTime)
- , umtSetupConfig :: !(FilePath, EpochTime)
- } deriving (Eq, Ord, Read, Show)
-
-- | A lazy, cached, query against a package's Cabal configuration. Use
-- 'runQuery' to execute it.
newtype Query pt a = Query
@@ -332,6 +181,14 @@ mkQueryEnv projdir distdir = do
, qeCacheRef = cr
}
+piProjConfModTimes :: ProjInfo pt -> ProjConfModTimes pt
+piProjConfModTimes ProjInfoV1 {piV1ProjConfModTimes} =
+ piV1ProjConfModTimes
+piProjConfModTimes ProjInfoV2 {piV2ProjConfModTimes} =
+ piV2ProjConfModTimes
+piProjConfModTimes ProjInfoStack {piStackProjConfModTimes} =
+ piStackProjConfModTimes
+
piUnits :: DistDir pt -> ProjInfo pt -> [Unit]
piUnits (DistDirV1 distdir) (ProjInfoV1 (ProjConfModTimesV1 (cabal_file, _))) =
(:[]) $ Unit
@@ -361,6 +218,7 @@ piUnits _ ProjInfoV2{..} =
Just $ Left u
takeunit _ =
Nothing
+piUnits DistDirStack{} ProjInfoStack{..} = piStackUnits
-- | Find files relevant to the project-scope configuration. Depending on the
@@ -380,6 +238,8 @@ projConfModTimes (ProjDirV2 projdir) = do
[ "cabal.project.local"
, "cabal.project.freeze"
]
+projConfModTimes (ProjDirStack projdir) = do
+ ProjConfModTimesStack <$> getFileModTime (projdir </> "stack.yml")
getUnitModTimes :: Unit -> IO UnitModTimes
getUnitModTimes Unit { uDistDir=DistDirLib distdirv1, uPackageDir=pkgdir } = do
@@ -518,12 +378,21 @@ shallowReconfigureProject QueryEnv
_ <- liftIO $ qeReadProcess (Just projdir) (cabalProgram qePrograms)
["v2-build", "--dry-run", "all"] ""
return ()
+shallowReconfigureProject QueryEnv
+ { qeProjectDir = ProjDirStack _projdir, .. } =
+ -- TODO: do we need to do anything here? Maybe package.yaml support needs to
+ -- do stuff here?
+ return ()
reconfigureUnit :: QueryEnvI c pt -> Unit -> IO ()
reconfigureUnit QueryEnv{qeDistDir=DistDirV1{}, ..} Unit{uPackageDir=_} = do
return ()
reconfigureUnit QueryEnv{qeDistDir=DistDirV2{}, ..} Unit{uPackageDir=_} = do
return ()
+reconfigureUnit QueryEnv{qeDistDir=DistDirStack{}, ..} Unit{uPackageDir} = do
+ _ <- liftIO $ qeReadProcess (Just uPackageDir) (stackProgram qePrograms)
+ ["stack", "build", "--only-configure", "."] ""
+ return ()
findCabalFile :: ProjDir 'V1 -> IO FilePath
findCabalFile (ProjDirV1 pkgdir) = do
@@ -549,6 +418,15 @@ readProjInfo qe conf_files = do
, piV2Plan = plan
, piV2PlanModTime = plan_mtime
}
+ (ProjDirStack{} , DistDirStack{}) -> do
+ cabal_files <- Stack.listPackageCabalFiles qe
+ units <- mapM (Stack.getUnit qe) cabal_files
+ proj_paths <- Stack.projPaths qe
+ return $ ProjInfoStack
+ { piStackProjConfModTimes = conf_files
+ , piStackUnits = units
+ , piStackProjPaths = proj_paths
+ }
readUnitInfo :: QueryEnvI c pt -> FilePath -> Unit -> IO UnitInfo
readUnitInfo
@@ -720,6 +598,20 @@ wrapper'
projdir
(Just (plan, distdir))
(distdir </> "cache")
+wrapper'
+ (ProjDirStack projdir)
+ (DistDirStack mworkdir)
+ ProjInfoStack{piStackProjPaths=StackProjPaths{sppGlobalPkgDb}}
+ = do
+ -- Stack also just picks whatever version ghc-pkg spits out, see
+ -- Stack.GhcPkg.getCabalPkgVer.
+ Just (cabalVer:_) <- runMaybeT $ listCabalVersions' (Just sppGlobalPkgDb)
+ let workdir = fromMaybe ".stack-work" $ unRelativePath <$> mworkdir
+ compileHelper' cabalVer
+ (Just sppGlobalPkgDb)
+ projdir
+ Nothing
+ (projdir </> workdir)
compileHelper'
:: Env
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
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 843a886..58e90b1 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -34,8 +34,182 @@ import Data.Typeable
import Data.Map.Strict (Map)
import GHC.Generics
import System.Posix.Types
+import CabalHelper.Compiletime.Types.RelativePath
import CabalHelper.Shared.InterfaceTypes
+
+-- | The kind of project being managed by a 'QueryEnv' (pun intended).
+data ProjType
+ = V1 -- ^ @cabal v1-build@ project, see 'DistDirV1'
+ | V2 -- ^ @cabal v2-build@ project, see 'DistDirV2'
+ | Stack -- ^ @stack@ project.
+
+-- | A project directory. The project type of a given directory can be
+-- determined by trying to access a set of marker files. See below.
+data ProjDir (pt :: ProjType) where
+ -- | A @cabal v1-build@ project directory can be identified by one file
+ -- ending in @.cabal@ existing in the directory. More than one such files
+ -- existing is a user error. Note: For this project type the concepts of
+ -- project and package coincide.
+ ProjDirV1 :: FilePath -> ProjDir 'V1
+
+ -- | A @cabal v2-build@ project\'s marker file is called
+ -- @cabal.project@. This configuration file points to the packages that make
+ -- up this project.
+ ProjDirV2 :: FilePath -> ProjDir 'V2
+
+ -- | A @stack@ project\'s marker file is called @stack.yaml@. This
+ -- configuration file points to the packages that make up this project.
+ ProjDirStack :: FilePath -> ProjDir 'Stack
+
+data DistDir (pt :: ProjType) where
+ -- | Build directory for cabal /old-build/ aka. /v1-build/ aka. just
+ -- /build/. Planned to be superceeded by /v2-build/, see 'DistDirV2' for
+ -- that.
+ --
+ -- You can tell a builddir is a /v1/ builddir by looking for a file
+ -- called @setup-config@ directly underneath it.
+ DistDirV1 :: FilePath -> DistDir 'V1
+
+ -- | Build directory for cabal /new-build/ aka. /v2-build/, as of the time
+ -- of this writing it is usually called @dist-newstyle/@ but this will
+ -- presumably change once it becomes the default /build/ command.
+ --
+ -- You can tell a builddir is a /v2/ builddir by trying to access the path
+ -- @cache/plan.json@ directly underneath it.
+ DistDirV2 :: FilePath -> DistDir 'V2
+
+ -- | Build directory for stack, aka. /work-dir/. Optionally override Stack's
+ -- /work-dir/. If you just want to use Stack's default set to @Nothing@
+ DistDirStack :: Maybe RelativePath -> DistDir 'Stack
+
+-- | Environment for running a 'Query' value. The real constructor is
+-- not exposed, use the 'mkQueryEnv' smart constructor instead. The field
+-- accessors are exported and may be used to override the defaults, see below.
+type QueryEnv (proj_type :: ProjType)
+ = QueryEnvI (QueryCache proj_type) proj_type
+
+data QueryEnvI cache (proj_type :: ProjType) = QueryEnv
+ { qeReadProcess
+ :: Maybe FilePath -> FilePath -> [String] -> String -> IO String
+ -- ^ Field accessor for 'QueryEnv'. Function used to to start
+ -- processes. Useful if you need to, for example, redirect standard error
+ -- output away from the user\'s terminal.
+
+ , qePrograms :: Programs
+ -- ^ Field accessor for 'QueryEnv'.
+
+ , qeProjectDir :: ProjDir proj_type
+ -- ^ Field accessor for 'QueryEnv'. Defines path to the project directory,
+ -- i.e. a directory containing a @cabal.project@ file
+
+ , qeDistDir :: DistDir proj_type
+ -- ^ Field accessor for 'QueryEnv'. Defines path to the @dist/@ or
+ -- @dist-newstyle/@ directory, aka. /builddir/ in Cabal terminology.
+
+ , qeCacheRef :: IORef cache
+ -- ^ Cache for query results, only accessible when type parameter @cache@ is
+ -- instantiated and not forall quantified.
+ }
+
+data QueryCache pt = QueryCache
+ { qcProjInfo :: !(Maybe (ProjInfo pt))
+ , qcUnitInfos :: !(Map DistDirLib UnitInfo)
+ }
+
+newtype DistDirLib = DistDirLib FilePath
+ deriving (Eq, Ord, Read, Show)
+
+-- | Abstractly speaking a Unit consists of a set of components (exes, libs,
+-- tests etc.) which are managed by an instance of the Cabal build system. The
+-- distinction between a Unit and a set of components is somewhat hard to
+-- explain if you're not already familliar with the concept from
+-- cabal-install. Luckily for most purposes the details may be ignored.
+--
+-- We merely use the concept of a Unit for caching purposes. It is necessary to
+-- extract the information on all components in a Unit at the same time as we
+-- must load all of it into memory before extracting any of it.
+--
+-- As opposed to components, different 'Unit's can be queried independently
+-- since their on-disk information is stored separately.
+data Unit = Unit
+ { uUnitId :: !UnitId
+ , uPackageDir :: !FilePath
+ , uDistDir :: !DistDirLib
+ }
+
+newtype UnitId = UnitId String
+ deriving (Eq, Ord, Read, Show)
+
+-- | The information extracted from a 'Unit's on-disk configuration.
+data UnitInfo = UnitInfo
+ { uiUnitId :: !UnitId
+ -- ^ A unique identifier of this init within the project.
+
+ , uiComponents :: !(Map ChComponentName ChComponentInfo)
+ -- ^ The components of the unit: libraries, executables, test-suites,
+ -- benchmarks and so on.
+
+ , uiCompilerVersion :: !(String, Version)
+ -- ^ The version of GHC the unit is configured to use
+
+ , uiPackageDbStack :: !([ChPkgDb])
+ -- ^ List of package databases to use.
+
+ , uiPackageFlags :: !([(String, Bool)])
+ -- ^ Flag definitions from cabal file
+
+ , uiConfigFlags :: ![(String, Bool)]
+ -- ^ Flag assignments from active configuration
+
+ , uiNonDefaultConfigFlags :: ![(String, Bool)]
+ -- ^ Flag assignments from setup-config which differ from the default
+ -- setting. This can also include flags which cabal decided to modify,
+ -- i.e. don't rely on these being the flags set by the user directly.
+
+ , uiModTimes :: !UnitModTimes
+ } deriving (Eq, Ord, Read, Show)
+
+data ProjInfo pt where
+ ProjInfoV1 ::
+ { piV1ProjConfModTimes :: !(ProjConfModTimes 'V1)
+ } -> ProjInfo 'V1
+
+ ProjInfoV2 ::
+ { piV2ProjConfModTimes :: !(ProjConfModTimes 'V2)
+ , piV2Plan :: !PlanJson
+ , piV2PlanModTime :: !EpochTime
+ } -> ProjInfo 'V2
+
+ ProjInfoStack ::
+ { piStackProjConfModTimes :: !(ProjConfModTimes 'Stack)
+ , piStackUnits :: ![Unit]
+ , piStackProjPaths :: !StackProjPaths
+ } -> ProjInfo 'Stack
+
+data ProjConfModTimes pt where
+ ProjConfModTimesV1
+ :: !(FilePath, EpochTime) -> ProjConfModTimes 'V1
+ ProjConfModTimesV2
+ :: !([(FilePath, EpochTime)]) -> ProjConfModTimes 'V2
+ ProjConfModTimesStack
+ :: !(FilePath, EpochTime) -> ProjConfModTimes 'Stack
+
+deriving instance Eq (ProjConfModTimes pt)
+
+data UnitModTimes = UnitModTimes
+ { umtCabalFile :: !(FilePath, EpochTime)
+ , umtSetupConfig :: !(FilePath, EpochTime)
+ } deriving (Eq, Ord, Read, Show)
+
+newtype CabalFile = CabalFile FilePath
+
+data StackProjPaths = StackProjPaths
+ { sppGlobalPkgDb :: !PackageDbDir
+ , sppSnapPkgDb :: !PackageDbDir
+ , sppLocalPkgDb :: !PackageDbDir
+ }
+
type Verbose = (?verbose :: Bool)
type Progs = (?progs :: Programs)
-- TODO: rname to `CompEnv` or something
@@ -49,6 +223,9 @@ data Programs = Programs {
-- | The path to the @cabal@ program.
cabalProgram :: FilePath,
+ -- | The path to the @stack@ program.
+ stackProgram :: FilePath,
+
-- | The path to the @ghc@ program.
ghcProgram :: FilePath,
@@ -60,7 +237,8 @@ data Programs = Programs {
-- | By default all programs use their unqualified names, i.e. they will be
-- searched for on @PATH@.
defaultPrograms :: Programs
-defaultPrograms = Programs "cabal" "ghc" "ghc-pkg"
+defaultPrograms = Programs "cabal" "stack" "ghc" "ghc-pkg"
+
data CompileOptions = CompileOptions
{ oVerbose :: Bool
diff --git a/src/CabalHelper/Compiletime/Types/RelativePath.hs b/src/CabalHelper/Compiletime/Types/RelativePath.hs
new file mode 100644
index 0000000..bfc29bf
--- /dev/null
+++ b/src/CabalHelper/Compiletime/Types/RelativePath.hs
@@ -0,0 +1,39 @@
+-- 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.Types.RelativePath
+License : GPL-3
+-}
+
+module CabalHelper.Compiletime.Types.RelativePath
+ ( RelativePath
+ , mkRelativePath
+ , unRelativePath
+ ) where
+
+import System.FilePath
+
+-- | A path guaranteed to be relative. The constructor is not exposed, use the
+-- 'mkRelativePath' smart constructor.
+newtype RelativePath = RelativePath { unRelativePath :: FilePath }
+
+-- | Smart constructor for 'RelativePath'. Checks if the given path is absolute
+-- and throws 'UserError' if not.
+mkRelativePath :: FilePath -> RelativePath
+mkRelativePath dir
+ | isAbsolute dir = RelativePath dir
+ | otherwise = error "mkRelativePath: the path given was absolute!"
--
cgit v1.2.3