aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSebastian Wild <wildsebastian@users.noreply.github.com>2018-11-17 13:48:58 +0100
committerDaniel Gröber <dxld@darkboxed.org>2019-01-22 03:03:25 +0100
commit95f5dffb70a06d84a6c05b4df2e17b29bd93942a (patch)
treec53eb4c1be5a8c56e98e2ed22e21fcd79a283966 /src
parentce1843e26aa439cacf5483cf9ea1e37e6b99b35e (diff)
Implement behaviour for cabal new-* (#61)
Add list of components to Unit data type to handle v2 based builds per cabal unit.
Diffstat (limited to 'src')
-rw-r--r--src/CabalHelper/Compiletime/Program/CabalInstall.hs7
-rw-r--r--src/CabalHelper/Compiletime/Program/Stack.hs3
-rw-r--r--src/CabalHelper/Compiletime/Types.hs17
3 files changed, 22 insertions, 5 deletions
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index a4df188..637d577 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
-- cabal-helper: Simple interface to Cabal's configuration state
-- Copyright (C) 2018 Daniel Gröber <cabal-helper@dxld.at>
--
@@ -181,7 +183,7 @@ cabalWithGHCProgOpts = concat
else []
]
-planUnits :: CP.PlanJson -> IO [Unit]
+planUnits :: CP.PlanJson -> IO [Unit 'V2]
planUnits plan = do
units <- fmap catMaybes $ mapM takeunit $ Map.elems $ CP.pjUnits plan
case lefts units of
@@ -195,13 +197,16 @@ planUnits plan = do
{ uType=CP.UnitTypeLocal
, uDistDir=Just distdirv1
, uPkgSrc=Just (CP.LocalUnpackedPackage pkgdir)
+ , uComps=comps
} = do
cabal_file <- Cabal.findCabalFile pkgdir
+ let uiV2Components = map (Text.unpack . CP.dispCompName) $ Map.keys comps
return $ Just $ Right $ Unit
{ uUnitId = UnitId $ Text.unpack (coerce (CP.uId u))
, uPackageDir = pkgdir
, uCabalFile = CabalFile cabal_file
, uDistDir = DistDirLib distdirv1
+ , uImpl = UnitImplV2 {..}
}
takeunit u@CP.Unit {uType=CP.UnitTypeLocal} =
return $ Just $ Left u
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
index 4f3680f..f4ada8f 100644
--- a/src/CabalHelper/Compiletime/Program/Stack.hs
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -36,7 +36,7 @@ import Prelude
import CabalHelper.Compiletime.Types
import CabalHelper.Compiletime.Types.RelativePath
-getUnit :: QueryEnvI c 'Stack -> CabalFile -> IO Unit
+getUnit :: QueryEnvI c 'Stack -> CabalFile -> IO (Unit 'Stack)
getUnit qe cabal_file@(CabalFile cabal_file_path) = do
let pkgdir = takeDirectory cabal_file_path
let pkg_name = dropExtension $ takeFileName cabal_file_path
@@ -47,6 +47,7 @@ getUnit qe cabal_file@(CabalFile cabal_file_path) = do
, uPackageDir = pkgdir
, uCabalFile = cabal_file
, uDistDir = DistDirLib distdirv1
+ , uImpl = UnitImplStack
}
-- TODO: patch ghc/ghc-pkg program paths like in ghc-mod when using stack so
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index cb2fbda..e432c6d 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -139,13 +139,24 @@ newtype DistDirLib = DistDirLib FilePath
--
-- As opposed to components, different 'Unit's can be queried independently
-- since their on-disk information is stored separately.
-data Unit = Unit
+data Unit pt = Unit
{ uUnitId :: !UnitId
, uPackageDir :: !FilePath
, uCabalFile :: !CabalFile
, uDistDir :: !DistDirLib
+ , uImpl :: !(UnitImpl pt)
}
+data UnitImpl pt where
+ UnitImplV1 :: UnitImpl 'V1
+
+ UnitImplV2 ::
+ { uiV2Components :: ![String]
+ } -> UnitImpl 'V2
+
+ UnitImplStack :: UnitImpl 'Stack
+
+
newtype UnitId = UnitId String
deriving (Eq, Ord, Read, Show)
@@ -206,7 +217,7 @@ newtype ProjConfModTimes = ProjConfModTimes [(FilePath, EpochTime)]
data ProjInfo pt = ProjInfo
{ piCabalVersion :: !Version
, piProjConfModTimes :: !ProjConfModTimes
- , piUnits :: ![Unit]
+ , piUnits :: ![Unit pt]
, piImpl :: !(ProjInfoImpl pt)
}
@@ -225,7 +236,7 @@ data ProjInfoImpl pt where
data UnitModTimes = UnitModTimes
{ umtCabalFile :: !(FilePath, EpochTime)
- , umtSetupConfig :: !(FilePath, EpochTime)
+ , umtSetupConfig :: !(Maybe (FilePath, EpochTime))
} deriving (Eq, Ord, Read, Show)
newtype CabalFile = CabalFile FilePath