From e7ff295ff2f2ed1e7682bd1d33738e7b2b0b78fd Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Sun, 31 Mar 2019 23:31:44 +0200
Subject: Make compilerVersion accessor project-scope for V1 projects

---
 src/CabalHelper/Compiletime/Types.hs | 30 ++++++++++++++++++++++++++++--
 1 file changed, 28 insertions(+), 2 deletions(-)

(limited to 'src/CabalHelper/Compiletime/Types.hs')

diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 9911aec..95eea9f 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -27,6 +27,7 @@ module CabalHelper.Compiletime.Types where
 
 import Cabal.Plan
   ( PlanJson )
+import Data.ByteString (ByteString)
 import Data.IORef
 import Data.Version
 import Data.Typeable
@@ -229,6 +230,25 @@ uComponentName Unit { uImpl=UnitImplV2 { uiV2ComponentNames=[comp] } } =
 uComponentName _ =
     Nothing
 
+-- | The @setup-config@ header. Note that Cabal writes all the package names in
+-- the header using 'Data.ByteString.Char8' and hence all characters are
+-- truncated from Unicode codepoints to 8-bit Latin-1.
+--
+-- We can be fairly confident that 'uhSetupId' and 'uhCompilerId' won\'t have
+-- names that cause trouble here so it's ok to look at them but user packages
+-- are free to have any unicode name.
+data UnitHeader = UnitHeader
+    { uhBrokenPackageId  :: !(ByteString, Version)
+      -- ^ Name and version of the source package. Don't use this, it's broken
+      -- when the package name contains Unicode characters. See 'uiPackageId'
+      -- instead.
+    , uhSetupId    :: !(ByteString, Version)
+      -- ^ Name and version of the @Setup.hs@ implementation. We expect
+      -- @"Cabal"@ here, naturally.
+    , uhCompilerId :: !(ByteString, Version)
+      -- ^ Name and version of the compiler this Unit is configured to use.
+    } deriving (Eq, Ord, Read, Show)
+
 newtype UnitId = UnitId String
     deriving (Eq, Ord, Read, Show)
 
@@ -300,7 +320,9 @@ data ProjInfo pt = ProjInfo
   } deriving (Show)
 
 data ProjInfoImpl pt where
-  ProjInfoV1 :: ProjInfoImpl 'V1
+  ProjInfoV1 ::
+    { piV1SetupHeader :: !UnitHeader
+    } -> ProjInfoImpl 'V1
 
   ProjInfoV2 ::
     { piV2Plan        :: !PlanJson
@@ -313,7 +335,11 @@ data ProjInfoImpl pt where
     } -> ProjInfoImpl 'Stack
 
 instance Show (ProjInfoImpl pt) where
-    show ProjInfoV1 = "ProjInfoV1"
+    show ProjInfoV1 {..} = concat
+      [ "ProjInfoV1 {"
+      , "piV1SetupHeader = ", show piV1SetupHeader, ", "
+      , "}"
+      ]
     show ProjInfoV2 {..} = concat
       [ "ProjInfoV2 {"
       , "piV2Plan = ", show piV2Plan, ", "
-- 
cgit v1.2.3