Merge pull request #299 from haskell-nix/test-json

Follow up to #296

Author: Ericson2314

hnix-store-core/CHANGELOG.md

@@ -1,3 +1,18 @@
+# Unreleased
+
+* Additions:
+   * `System.Nix.Placeholder` module with `DownstreamPlaceholder`, `createPlaceholder`, and `renderPlaceholder`
+   * `System.Nix.StorePath.ContentAddressed` module, for creating content-addressed store paths
+   * `textToMethod`, `methodToText` in `System.Nix.ContentAddress`
+   * `parseBasePath`, `parseBasePathFromText` in `System.Nix.StorePath`
+   * `textToBaseEncoding`, `baseEncodingToText` in `System.Nix.Base`
+   * `outputStoreObjectName` in `System.Nix.OutputName`
+   * `SingleDerivedPath` type with `parseSingleDerivedPath`, `singleDerivedPathToText`
+
+* Changes:
+   * `OutputName.unOutputName` now returns `StorePathName` instead of `Text`
+   * `DerivedPath_Built` constructor now takes `SingleDerivedPath` instead of `StorePath`
+
 # [0.8.0.0](https://github.com/haskell-nix/hnix-store/compare/core-0.7.0.0...core-0.8.0.0) 2024-07-31
 
 * Changes:

hnix-store-core/src/System/Nix/StorePath.hs

@@ -27,6 +27,8 @@ module System.Nix.StorePath
     storePathToFilePath
   , storePathToRawFilePath
   , storePathToText
+  , storePathBaseToText
+  , storePathBaseToRawFilePath
   , storePathToNarInfo
   , storePathHashPartToText
   , -- * Parsing 'StorePath's
@@ -184,14 +186,25 @@ instance Default StoreDir where
 class HasStoreDir r where
   hasStoreDir :: r -> StoreDir
 
--- | Render a 'StorePath' as a 'RawFilePath'.
-storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
-storePathToRawFilePath storeDir StorePath{..} =
-  unStoreDir storeDir <> "/" <> hashPart <> "-" <> name
+-- | Render a 'StorePath' as a base path (without store directory).
+-- This is the relative path format: @hashPart-name@
+storePathBaseToRawFilePath :: StorePath -> RawFilePath
+storePathBaseToRawFilePath StorePath{..} =
+  hashPart <> "-" <> name
  where
   hashPart = Data.Text.Encoding.encodeUtf8 $ storePathHashPartToText storePathHash
   name     = Data.Text.Encoding.encodeUtf8 $ unStorePathName storePathName
 
+-- | Render a 'StorePath' as a base path 'Text' (without store directory).
+-- This is the relative path format: @hashPart-name@
+storePathBaseToText :: StorePath -> Text
+storePathBaseToText = Data.Text.Encoding.decodeUtf8 . storePathBaseToRawFilePath
+
+-- | Render a 'StorePath' as a 'RawFilePath'.
+storePathToRawFilePath :: StoreDir -> StorePath -> RawFilePath
+storePathToRawFilePath storeDir sp =
+  unStoreDir storeDir <> "/" <> storePathBaseToRawFilePath sp
+
 -- | Render a 'StorePath' as a 'FilePath'.
 storePathToFilePath :: StoreDir -> StorePath -> FilePath
 storePathToFilePath storeDir = Data.ByteString.Char8.unpack . storePathToRawFilePath storeDir

hnix-store-json/CHANGELOG.md

@@ -1,3 +1,17 @@
+# Unreleased
+
+The test suite is now much more comprenesive, uses test data from upstream Nix to make sure the JSON formats match.
+
+* JSON instance for `StorePath` now doesn't include the store dir, matching upstream.
+  (This keeps it canonical.)
+
+* New JSON instances for:
+  * `Hash`,
+  * `ContentAddress`
+  * `OutputsSpec`
+  * `SingleDerivedPath`
+  * `DerivedPath`
+
 # 0.1.0.0 2024-07-31
 
 * Initial release

hnix-store-json/hnix-store-json.cabal

@@ -100,5 +100,4 @@ test-suite json
     , aeson
     , bytestring
     , containers
-    , data-default-class
     , hspec

hnix-store-json/src/System/Nix/JSON.hs

@@ -25,7 +25,6 @@ import Data.Foldable (toList)
 import Data.Set qualified
 import Data.Some
 import Data.Text (Text)
-import Data.Text qualified
 import Data.Text.Lazy qualified
 import Data.Text.Lazy.Builder qualified
 import Deriving.Aeson
@@ -41,7 +40,7 @@ import System.Nix.Realisation (DerivationOutput(..), Realisation, RealisationWit
 import System.Nix.Realisation qualified
 import System.Nix.Signature (Signature)
 import System.Nix.Signature qualified
-import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart, storePathHash, storePathName, mkStorePathName, unStorePathName, parseBasePathFromText)
+import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart, mkStorePathName, unStorePathName, parseBasePathFromText)
 import System.Nix.StorePath qualified
 
 instance ToJSON StorePathName where
@@ -68,19 +67,8 @@ instance FromJSON StorePathHashPart where
     )
 
 instance ToJSON StorePath where
-  toJSON sp =
-    toJSON $ Data.Text.concat
-      [ System.Nix.StorePath.storePathHashPartToText (storePathHash sp)
-      , "-"
-      , System.Nix.StorePath.unStorePathName (storePathName sp)
-      ]
-
-  toEncoding sp =
-    toEncoding $ Data.Text.concat
-      [ System.Nix.StorePath.storePathHashPartToText (storePathHash sp)
-      , "-"
-      , System.Nix.StorePath.unStorePathName (storePathName sp)
-      ]
+  toJSON = toJSON . System.Nix.StorePath.storePathBaseToText
+  toEncoding = toEncoding . System.Nix.StorePath.storePathBaseToText
 
 instance FromJSON StorePath where
   parseJSON =
@@ -92,12 +80,7 @@ instance FromJSON StorePath where
     )
 
 instance ToJSONKey StorePath where
-  toJSONKey = Data.Aeson.Types.toJSONKeyText $ \sp ->
-    Data.Text.concat
-      [ System.Nix.StorePath.storePathHashPartToText (storePathHash sp)
-      , "-"
-      , System.Nix.StorePath.unStorePathName (storePathName sp)
-      ]
+  toJSONKey = Data.Aeson.Types.toJSONKeyText System.Nix.StorePath.storePathBaseToText
 
 instance FromJSONKey StorePath where
   fromJSONKey = FromJSONKeyTextParser $
@@ -243,33 +226,19 @@ instance FromJSON SingleDerivedPath where
 instance ToJSON DerivedPath where
   toJSON (DerivedPath_Opaque path) = toJSON path
   toJSON (DerivedPath_Built drvPath outputs) =
-    case outputs of
-      OutputsSpec_Names names | Data.Set.size names == 1 ->
-        object
-          [ "drvPath" .= toJSON drvPath
-          , "output" .= Data.Set.elemAt 0 names
-          ]
-      _ ->
-        object
-          [ "drvPath" .= toJSON drvPath
-          , "outputs" .= outputs
-          ]
+    object
+      [ "drvPath" .= toJSON drvPath
+      , "outputs" .= outputs
+      ]
 
 instance FromJSON DerivedPath where
   parseJSON v = parseOpaque v <|> parseBuilt v
     where
       parseOpaque = fmap DerivedPath_Opaque . parseJSON
-      parseBuilt = withObject "DerivedPath_Built" $ \obj -> do
-        drvPath <- obj .: "drvPath"
-        -- Try single output first, then multiple outputs
-        mOutput <- obj .:? "output"
-        mOutputs <- obj .:? "outputs"
-        case (mOutput, mOutputs) of
-          (Just output, Nothing) ->
-            pure $ DerivedPath_Built drvPath (OutputsSpec_Names (Data.Set.singleton output))
-          (Nothing, Just outputs) ->
-            pure $ DerivedPath_Built drvPath outputs
-          _ -> fail "Expected either 'output' or 'outputs' field"
+      parseBuilt = withObject "DerivedPath_Built" $ \obj ->
+        DerivedPath_Built
+          <$> obj .: "drvPath"
+          <*> obj .: "outputs"
 
 data LowerLeading
 instance StringModifier LowerLeading where

hnix-store-json/tests/RealisationSpec.hs

@@ -4,7 +4,6 @@ module RealisationSpec where
 
 import Data.Aeson (eitherDecode, encode)
 import Data.ByteString.Lazy qualified as BSL
-import Data.Default.Class (Default(def))
 import Data.List (isInfixOf)
 import Data.Map qualified
 import Data.Set qualified
@@ -35,9 +34,8 @@ sampleRealisation0 :: Realisation
 sampleRealisation0 = Realisation
   { realisationOutPath =
       forceRight
-      $ System.Nix.StorePath.parsePath
-          def
-          "/nix/store/cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"
+      $ System.Nix.StorePath.parseBasePath
+          "cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"
   , realisationSignatures = mempty
   , realisationDependencies = mempty
   }
@@ -46,9 +44,8 @@ sampleRealisation1 :: Realisation
 sampleRealisation1 = Realisation
   { realisationOutPath =
       forceRight
-      $ System.Nix.StorePath.parsePath
-          def
-          "/nix/store/5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv"
+      $ System.Nix.StorePath.parseBasePath
+          "5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv"
   , realisationSignatures =
       Data.Set.fromList
       $ forceRight
@@ -60,9 +57,8 @@ sampleRealisation1 = Realisation
       Data.Map.fromList
       [ ( sampleDerivationOutput
         , forceRight
-          $ System.Nix.StorePath.parsePathFromText
-              def
-              "/nix/store/9472ijanf79nlkb5n1yh57s7867p1930-testFixed"
+          $ System.Nix.StorePath.parseBasePathFromText
+              "9472ijanf79nlkb5n1yh57s7867p1930-testFixed"
         )
       ]
   }

hnix-store-tests/CHANGELOG.md

@@ -1,3 +1,8 @@
+# Unreleased
+
+* Additions:
+   * `Arbitrary` instance for `SingleDerivedPath`
+
 # 0.1.0.0 2024-07-31
 
 * Initial release

hnix-store-tests/tests/StorePathSpec.hs

@@ -29,3 +29,13 @@ spec = do
         roundtrips
           (storePathToText storeDir)
           (Data.Attoparsec.Text.parseOnly $ pathParser storeDir)
+
+    prop "roundtrips using parseBasePath . storePathBaseToRawFilePath" $
+      roundtrips
+        storePathBaseToRawFilePath
+        parseBasePath
+
+    prop "roundtrips using parseBasePathFromText . storePathBaseToText" $
+      roundtrips
+        storePathBaseToText
+        parseBasePathFromText