Switch over to using Cabal types internally

src/Data/Store/VersionTagged.hs

@@ -96,6 +96,7 @@ storeVersionConfig name hash = (namedVersionConfig name hash)
     { vcIgnore = S.fromList
         [ "Data.Vector.Unboxed.Base.Vector GHC.Types.Word"
         , "Data.ByteString.Internal.ByteString"
+        , "Data.ByteString.Short.Internal.ShortByteString"
         ]
     , vcRenames = M.fromList
         [ ( "Data.Maybe.Maybe", "GHC.Base.Maybe")

src/Stack/PackageIndex.hs

@@ -371,7 +371,7 @@ getPackageCaches = do
             result <- liftM mconcat $ forM (configPackageIndices config) $ \index -> do
                 fp <- configPackageIndexCache (indexName index)
                 PackageCache pis <-
-                    $(versionedDecodeOrLoad (storeVersionConfig "pkg-v5" "PIEH62CpuuOl_fyE25-ncPVZgMU="
+                    $(versionedDecodeOrLoad (storeVersionConfig "pkg-v6" "XlfP1Sf2cxC0AxuzNyeaP6BqYo4="
                                              :: VersionConfig (PackageCache ())))
                     fp
                     (populateCache index)

src/Stack/Prelude.hs

@@ -57,7 +57,7 @@ import           Data.Function        as X (const, fix, flip, id, on, ($), (&),
                                             (.))
 import           Data.Functor         as X (Functor (..), void, ($>), (<$),
                                             (<$>))
-import           Data.Hashable        as X (Hashable)
+import           Data.Hashable        as X (Hashable (hashWithSalt))
 import           Data.HashMap.Strict  as X (HashMap)
 import           Data.HashSet         as X (HashSet)
 import           Data.Int             as X

src/Stack/Types/BuildPlan.hs

@@ -283,7 +283,7 @@ instance Store LoadedSnapshot
 instance NFData LoadedSnapshot
 
 loadedSnapshotVC :: VersionConfig LoadedSnapshot
-loadedSnapshotVC = storeVersionConfig "ls-v4" "UQQmEqSZneE0IrDjeIy_uvDkhvM="
+loadedSnapshotVC = storeVersionConfig "ls-v5" "1sKfCC3azJist4Wb_Gy_X0Z6y48="
 
 -- | Information on a single package for the 'LoadedSnapshot' which
 -- can be installed.

src/Stack/Types/FlagName.hs

@@ -27,6 +27,7 @@ import           Data.Aeson.Extended
 import           Data.Attoparsec.Combinators
 import           Data.Attoparsec.Text
 import           Data.Char (isLetter, isDigit, toLower)
+import           Data.Store (Store (..), Size (..))
 import qualified Data.Text as T
 import qualified Distribution.PackageDescription as Cabal
 import           Language.Haskell.TH
@@ -41,22 +42,36 @@ instance Show FlagNameParseFail where
     show (FlagNameParseFail bs) = "Invalid flag name: " ++ show bs
 
 -- | A flag name.
-newtype FlagName =
-  FlagName Text
-  deriving (Typeable,Data,Generic,Hashable,Store,NFData,ToJSONKey)
+newtype FlagName = FlagName Cabal.FlagName
+  deriving (Typeable,Data,Generic)
 instance Eq FlagName where
     x == y = compare x y == EQ
 instance Ord FlagName where
-    compare (FlagName x) (FlagName y) =
-        compare (T.map toLower x) (T.map toLower y)
+    compare x y = compare
+      (map toLower (flagNameString x))
+      (map toLower (flagNameString y))
+instance Hashable FlagName where
+  hashWithSalt x y = hashWithSalt x (flagNameString y)
+instance Store FlagName where
+  size = -- could use contramap instead...
+    case size of
+      VarSize f -> VarSize (f . flagNameString)
+      ConstSize x -> assert False (ConstSize x)
+  poke = poke . flagNameString
+  peek = (FlagName . Cabal.mkFlagName) <$> peek
+instance NFData FlagName where
+  rnf = rnf . flagNameString
+instance ToJSON FlagName where
+  toJSON = toJSON . flagNameString
+instance ToJSONKey FlagName
 
 instance Lift FlagName where
-  lift (FlagName n) =
+  lift n =
     appE (conE 'FlagName)
-         (stringE (T.unpack n))
+         (stringE (flagNameString n))
 
 instance Show FlagName where
-  show (FlagName n) = T.unpack n
+  show = flagNameString
 
 instance FromJSON FlagName where
   parseJSON j =
@@ -73,7 +88,7 @@ instance FromJSONKey FlagName where
 -- | Attoparsec parser for a flag name
 flagNameParser :: Parser FlagName
 flagNameParser =
-  fmap (FlagName . T.pack)
+  fmap (FlagName . Cabal.mkFlagName)
        (appending (many1 (satisfy isLetter))
                   (concating (many (alternating
                                       (pured (satisfy isAlphaNum))
@@ -103,20 +118,16 @@ parseFlagNameFromString =
 
 -- | Produce a string representation of a flag name.
 flagNameString :: FlagName -> String
-flagNameString (FlagName n) = T.unpack n
+flagNameString (FlagName n) = Cabal.unFlagName n
 
 -- | Produce a string representation of a flag name.
 flagNameText :: FlagName -> Text
-flagNameText (FlagName n) = n
+flagNameText = T.pack . flagNameString
 
 -- | Convert from a Cabal flag name.
 fromCabalFlagName :: Cabal.FlagName -> FlagName
-fromCabalFlagName name =
-  let !x = T.pack $ Cabal.unFlagName name
-  in FlagName x
+fromCabalFlagName = FlagName
 
 -- | Convert to a Cabal flag name.
 toCabalFlagName :: FlagName -> Cabal.FlagName
-toCabalFlagName (FlagName name) =
-  let !x = T.unpack name
-  in Cabal.mkFlagName x
+toCabalFlagName (FlagName name) = name

src/Stack/Types/GhcPkgId.hs

@@ -27,7 +27,7 @@ instance Show GhcPkgIdParseFail where
 instance Exception GhcPkgIdParseFail
 
 -- | A ghc-pkg package identifier.
-newtype GhcPkgId = GhcPkgId Text
+newtype GhcPkgId = GhcPkgId Text -- TODO consider using ShortText or ShortByteString here
   deriving (Eq,Ord,Data,Typeable,Generic)
 
 instance Hashable GhcPkgId

src/Stack/Types/PackageDump.hs

@@ -31,4 +31,6 @@ data InstalledCacheEntry = InstalledCacheEntry
 instance Store InstalledCacheEntry
 
 installedCacheVC :: VersionConfig InstalledCacheInner
-installedCacheVC = storeVersionConfig "installed-v1" "GGyaE6qY9FOqeWtozuadKqS7_QM="
+-- FIXME would be really nice to avoid changing this hash...
+--installedCacheVC = storeVersionConfig "installed-v1" "GGyaE6qY9FOqeWtozuadKqS7_QM="
+installedCacheVC = storeVersionConfig "installed-v2" "SOd6CFM7HnrOCwfIBdh-iHNypH4="

src/Stack/Types/PackageIdentifier.hs

@@ -43,7 +43,6 @@ import           Data.Aeson.Extended
 import           Data.Attoparsec.Text as A
 import qualified Data.ByteArray.Encoding as Mem (convertToBase, Base(Base16))
 import qualified Data.ByteString.Lazy as L
-import           Data.Hashable
 import           Data.Store.Internal (Size (..), StaticSize (..), size,
                                       toStaticSize, toStaticSizeEx, unStaticSize)
 import qualified Data.Text as T

src/Stack/Types/PackageName.hs

@@ -29,6 +29,7 @@ import           Data.Aeson.Extended
 import           Data.Attoparsec.Combinators
 import           Data.Attoparsec.Text
 import           Data.List (intercalate)
+import           Data.Store (Store (..), Size (..))
 import qualified Data.Text as T
 import qualified Distribution.Package as Cabal
 import           Language.Haskell.TH
@@ -49,17 +50,29 @@ instance Show PackageNameParseFail where
     show (CabalFileNameInvalidPackageName fp) = "cabal file names must use valid package names followed by a .cabal extension, the following is invalid: " ++ fp
 
 -- | A package name.
-newtype PackageName =
-  PackageName Text
-  deriving (Eq,Ord,Typeable,Data,Generic,Hashable,NFData,Store,ToJSON,ToJSONKey)
+newtype PackageName = PackageName Cabal.PackageName
+  deriving (Eq,Ord,Typeable,Data,Generic,NFData)
+
+instance Hashable PackageName where
+  hashWithSalt x y = hashWithSalt x (packageNameString y)
+instance Store PackageName where
+  size =
+    case size of
+      VarSize f -> VarSize (f . packageNameString)
+      ConstSize x -> assert False (ConstSize x)
+  poke = poke . packageNameString
+  peek = (PackageName . Cabal.mkPackageName) <$> peek
+instance ToJSON PackageName where
+  toJSON = toJSON . packageNameString
+instance ToJSONKey PackageName
 
 instance Lift PackageName where
   lift (PackageName n) =
     appE (conE 'PackageName)
-         (stringE (T.unpack n))
+         (stringE (Cabal.unPackageName n))
 
 instance Show PackageName where
-  show (PackageName n) = T.unpack n
+  show (PackageName n) = Cabal.unPackageName n
 
 instance FromJSON PackageName where
   parseJSON j =
@@ -76,7 +89,7 @@ instance FromJSONKey PackageName where
 -- | Attoparsec parser for a package name
 packageNameParser :: Parser PackageName
 packageNameParser =
-  fmap (PackageName . T.pack . intercalate "-")
+  fmap (PackageName . Cabal.mkPackageName . intercalate "-")
        (sepBy1 word (char '-'))
   where
     word = concat <$> sequence [many digit,
@@ -104,23 +117,19 @@ parsePackageNameFromString =
 
 -- | Produce a string representation of a package name.
 packageNameString :: PackageName -> String
-packageNameString (PackageName n) = T.unpack n
+packageNameString (PackageName n) = Cabal.unPackageName n
 
 -- | Produce a string representation of a package name.
 packageNameText :: PackageName -> Text
-packageNameText (PackageName n) = n
+packageNameText = T.pack . packageNameString
 
 -- | Convert from a Cabal package name.
 fromCabalPackageName :: Cabal.PackageName -> PackageName
-fromCabalPackageName name =
-  let !x = T.pack $ Cabal.unPackageName name
-  in PackageName x
+fromCabalPackageName = PackageName
 
 -- | Convert to a Cabal package name.
 toCabalPackageName :: PackageName -> Cabal.PackageName
-toCabalPackageName (PackageName name) =
-  let !x = T.unpack name
-  in Cabal.mkPackageName x
+toCabalPackageName (PackageName name) = name
 
 -- | Parse a package name from a file path.
 parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName

src/Stack/Types/Version.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- | Versions for packages.
 
@@ -34,13 +35,12 @@ module Stack.Types.Version
 
 import           Stack.Prelude hiding (Vector)
 import           Data.Aeson.Extended
-import           Data.Attoparsec.Text
+import           Data.Attoparsec.Text hiding (take)
 import           Data.Hashable (Hashable (..))
 import           Data.List
 import qualified Data.Set as Set
+import           Data.Store (Store (..), Size (..))
 import qualified Data.Text as T
-import           Data.Vector.Unboxed (Vector)
-import qualified Data.Vector.Unboxed as V
 import           Distribution.Text (disp)
 import qualified Distribution.Version as Cabal
 import           Language.Haskell.TH
@@ -59,24 +59,31 @@ instance Show VersionParseFail where
 data UpgradeTo = Specific Version | Latest deriving (Show)
 
 -- | A package version.
-newtype Version =
-  Version {unVersion :: Vector Word}
-  deriving (Eq,Ord,Typeable,Data,Generic,Store,NFData)
+newtype Version = Version Cabal.Version
+  deriving (Eq,Ord,Typeable,Data,Generic,NFData)
 
 instance Hashable Version where
-  hashWithSalt i = hashWithSalt i . V.toList . unVersion
+  hashWithSalt i (Version v) = hashWithSalt i $ Cabal.versionNumbers v
+
+instance Store Version where
+  size =
+    case size of
+      VarSize f -> VarSize (f . Cabal.versionNumbers . toCabalVersion)
+      ConstSize x -> assert False (ConstSize x)
+  poke = poke . Cabal.versionNumbers . toCabalVersion
+  peek = (fromCabalVersion . Cabal.mkVersion) <$> peek
 
 instance Lift Version where
   lift (Version n) =
     appE (conE 'Version)
-         (appE (varE 'V.fromList)
+         (appE (varE 'Cabal.mkVersion)
                (listE (map (litE . IntegerL . fromIntegral)
-                           (V.toList n))))
+                           (Cabal.versionNumbers n))))
 
 instance Show Version where
   show (Version v) =
     intercalate "."
-                (map show (V.toList v))
+                (map show (Cabal.versionNumbers v))
 
 instance ToJSON Version where
   toJSON = toJSON . versionText
@@ -104,7 +111,7 @@ instance Monoid IntersectingVersionRange where
 versionParser :: Parser Version
 versionParser =
   do ls <- (:) <$> num <*> many num'
-     let !v = V.fromList ls
+     let !v = Cabal.mkVersion ls
      return (Version v)
   where num = decimal
         num' = point *> num
@@ -126,26 +133,23 @@ parseVersionFromString =
 versionString :: Version -> String
 versionString (Version v) =
   intercalate "."
-              (map show (V.toList v))
+              (map show (Cabal.versionNumbers v))
 
 -- | Get a string representation of a package version.
 versionText :: Version -> Text
 versionText (Version v) =
   T.intercalate
     "."
     (map (T.pack . show)
-         (V.toList v))
+         (Cabal.versionNumbers v))
 
 -- | Convert to a Cabal version.
 toCabalVersion :: Version -> Cabal.Version
-toCabalVersion (Version v) =
-  Cabal.mkVersion (map fromIntegral (V.toList v))
+toCabalVersion (Version v) = v
 
 -- | Convert from a Cabal version.
 fromCabalVersion :: Cabal.Version -> Version
-fromCabalVersion vs =
-  let !v = V.fromList (map fromIntegral (Cabal.versionNumbers vs))
-  in Version v
+fromCabalVersion = Version
 
 -- | Make a package version.
 mkVersion :: String -> Q Exp
@@ -169,10 +173,11 @@ intersectVersionRanges x y = Cabal.simplifyVersionRange $ Cabal.intersectVersion
 -- | Returns the first two components, defaulting to 0 if not present
 toMajorVersion :: Version -> Version
 toMajorVersion  (Version v) =
-    case V.length v of
-        0 -> Version (V.fromList [0,        0])
-        1 -> Version (V.fromList [V.head v, 0])
-        _ -> Version (V.fromList [V.head v, v V.! 1])
+  Version . Cabal.mkVersion $
+  case Cabal.versionNumbers v of
+    [] -> [0, 0]
+    [x] -> [x, 0]
+    x:y:_ -> [x, y]
 
 -- | Given a version range and a set of versions, find the latest version from
 -- the set that is within the range.
@@ -182,10 +187,11 @@ latestApplicableVersion r = listToMaybe . filter (`withinRange` r) . Set.toDescL
 -- | Get the next major version number for the given version
 nextMajorVersion :: Version -> Version
 nextMajorVersion (Version v) =
-  case  V.length v of
-    0 -> Version (V.fromList [0,        1])
-    1 -> Version (V.fromList [V.head v, 1])
-    _ -> Version (V.fromList [V.head v, (v V.! 1) + 1])
+  Version . Cabal.mkVersion $
+  case Cabal.versionNumbers v of
+    [] -> [0, 1]
+    [x] -> [x, 1]
+    x:y:_ -> [x, y + 1]
 
 data VersionCheck
     = MatchMinor
@@ -207,15 +213,20 @@ instance FromJSON VersionCheck where
         expected = "VersionCheck value (match-minor, match-exact, or newer-minor)"
 
 checkVersion :: VersionCheck -> Version -> Version -> Bool
-checkVersion check (Version wanted) (Version actual) =
+checkVersion check (Version (Cabal.versionNumbers -> wanted)) (Version (Cabal.versionNumbers -> actual)) =
     case check of
-        MatchMinor -> V.and (V.take 3 matching)
-        MatchExact -> V.length wanted == V.length actual && V.and matching
-        NewerMinor -> V.and (V.take 2 matching) && newerMinor
+        MatchMinor -> and (take 3 matching)
+        MatchExact -> length wanted == length actual && and matching
+        NewerMinor -> and (take 2 matching) && newerMinor
   where
-    matching = V.zipWith (==) wanted actual
+    matching = zipWith (==) wanted actual
     newerMinor =
-        case (wanted V.!? 2, actual V.!? 2) of
+        case (wanted !? 2, actual !? 2) of
             (Nothing, _) -> True
             (Just _, Nothing) -> False
             (Just w, Just a) -> a >= w
+
+    (!?) :: [a] -> Int -> Maybe a
+    [] !? _ = Nothing
+    (x:_) !? 0 = Just x
+    (_:xs) !? i = xs !? (i - 1)