Make the main derivation representation better typed

Author: Ericson2314

hnix-store-aterm/bench/Main.hs

@@ -22,10 +22,7 @@ benchmarks =
     bench0 example =
         Criterion.bench "example" (Criterion.nf parseExample example)
 
-    name = either (error . show) id $ mkStorePathName "ghc-8.0.2-with-packages"
-
     parseExample =
         Data.Attoparsec.Text.Lazy.parse $
-            System.Nix.Derivation.ATerm.parseDerivation
+            System.Nix.Derivation.ATerm.parseTraditionalDerivation
                (StoreDir "/nix/store")
-               name

hnix-store-aterm/hnix-store-aterm.cabal

@@ -96,6 +96,7 @@ Test-Suite property
         hnix-store-core                      ,
         hnix-store-aterm                     ,
         hnix-store-tests                     ,
+        containers                           ,
         generic-arbitrary              < 1.1 ,
         QuickCheck                     < 2.16,
         text                                 ,

hnix-store-aterm/pretty-derivation/Main.hs

@@ -14,9 +14,8 @@ main = do
     text <- Data.Text.Lazy.IO.getContents
     case
       Data.Attoparsec.Text.Lazy.parse
-        (System.Nix.Derivation.ATerm.parseDerivation
-          (StoreDir "/nix/store")
-          (error "todo get name from outputs if needed"))
+        (System.Nix.Derivation.ATerm.parseTraditionalDerivation
+          (StoreDir "/nix/store"))
         text
       of
         Fail _ _ err      -> fail err

hnix-store-aterm/src/System/Nix/Derivation/ATerm.hs

@@ -78,26 +78,27 @@
 
 module System.Nix.Derivation.ATerm
     ( -- * Types
-      Derivation
-    , Derivation'(..)
-    , DerivationOutput(..)
-    , DerivationInputs(..)
+      TraditionalDerivation'(..)
+    , FreeformDerivationOutput(..)
+    , FreeformDerivationOutputs
+    , TraditionalDerivationInputs(..)
     , DerivedPathMap(..)
 
       -- * Parse derivations
-    , parseDerivation
-    , parseDerivationWith
-    , parseDerivationOutput
-    , parseDerivationInputs
+    , parseTraditionalDerivation
+    , parseTraditionalDerivationWith
+    , parseFreeformDerivationOutput
+    , parseTraditionalDerivationInputs
     , textParser
 
       -- * Render derivations
-    , buildDerivation
-    , buildDerivationWith
-    , buildDerivationOutput
-    , buildDerivationInputs
+    , buildTraditionalDerivation
+    , buildTraditionalDerivationWith
+    , buildFreeformDerivationOutput
+    , buildTraditionalDerivationInputs
     ) where
 
 import System.Nix.Derivation
+import System.Nix.Derivation.Traditional
 import System.Nix.Derivation.ATerm.Builder
 import System.Nix.Derivation.ATerm.Parser

hnix-store-aterm/src/System/Nix/Derivation/ATerm/Builder.hs

@@ -6,10 +6,10 @@
 
 module System.Nix.Derivation.ATerm.Builder
     ( -- * Builder
-      buildDerivation
-    , buildDerivationWith
-    , buildDerivationOutput
-    , buildDerivationInputs
+      buildTraditionalDerivation
+    , buildTraditionalDerivationWith
+    , buildFreeformDerivationOutput
+    , buildTraditionalDerivationInputs
     ) where
 
 import Data.Map (Map)
@@ -18,8 +18,8 @@ import Data.Text (Text)
 import Data.Text.Lazy.Builder (Builder)
 import Data.Vector (Vector)
 import System.Nix.Derivation
-    ( Derivation'(..)
-    , DerivationOutput(..)
+    ( FreeformDerivationOutput(..)
+    , FreeformDerivationOutputs
     )
 import System.Nix.Derivation.Traditional
 import System.Nix.StorePath
@@ -32,42 +32,42 @@ import Data.Text.Lazy.Builder qualified
 import Data.Vector qualified
 
 -- | Render a derivation as a `Builder`
-buildDerivation
+buildTraditionalDerivation
     :: StoreDir
-    -> Derivation' TraditionalDerivationInputs DerivationOutput
+    -> TraditionalDerivation' TraditionalDerivationInputs FreeformDerivationOutputs
     -> Builder
-buildDerivation sd =
-    buildDerivationWith
-        (buildDerivationInputs sd)
-        (buildDerivationOutput sd)
+buildTraditionalDerivation sd =
+    buildTraditionalDerivationWith
+        (buildTraditionalDerivationInputs sd)
+        (\_ -> buildFreeformDerivationOutput sd)
 
 -- | Render a derivation as a `Builder` using custom
 -- renderer for storePaths, texts, outputNames and derivation inputs/outputs
-buildDerivationWith
+buildTraditionalDerivationWith
     :: (drvInputs -> Builder)
-    -> (StorePathName -> OutputName -> drvOutput -> Builder)
-    -> Derivation' drvInputs drvOutput
+    -> (OutputName -> drvOutput -> Builder)
+    -> TraditionalDerivation' drvInputs (Map OutputName drvOutput)
     -> Builder
-buildDerivationWith drvInputs drvOutput (Derivation {..}) =
+buildTraditionalDerivationWith drvInputs drvOutput (TraditionalDerivation {..}) =
         "Derive("
-    <>  mapOf keyValue0 outputs
+    <>  mapOf keyValue0 anonOutputs
     <>  ","
-    <>  drvInputs inputs
+    <>  drvInputs anonInputs
     <>  ","
-    <>  string platform
+    <>  string anonPlatform
     <>  ","
-    <>  string builder
+    <>  string anonBuilder
     <>  ","
-    <>  vectorOf string args
+    <>  vectorOf string anonArgs
     <>  ","
-    <>  mapOf keyValue1 env
+    <>  mapOf keyValue1 anonEnv
     <>  ")"
   where
     keyValue0 (key, output) =
             "("
         <>  buildOutputName key
         <>  ","
-        <>  drvOutput name key output
+        <>  drvOutput key output
         <>  ")"
 
     keyValue1 (key, value) =
@@ -77,31 +77,29 @@ buildDerivationWith drvInputs drvOutput (Derivation {..}) =
         <>  string value
         <>  ")"
 
--- | Render a @DerivationOutput@ as a `Builder` using custom
+-- | Render a @FreeformDerivationOutput@ as a `Builder` using custom
 -- renderer for storePaths
-buildDerivationOutput
+buildFreeformDerivationOutput
     :: StoreDir
-    -> StorePathName
-    -> OutputName
-    -> DerivationOutput
+    -> FreeformDerivationOutput
     -> Builder
-buildDerivationOutput storeDir drvName outputName =
+buildFreeformDerivationOutput storeDir =
   ( \RawDerivationOutput {..} ->
         string rawPath
     <>  ","
     <>  string rawMethodHashAlgo
     <>  ","
     <>  string rawHash
   )
-  . renderRawDerivationOutput storeDir drvName outputName
+  . renderRawDerivationOutput storeDir
 
--- | Render a @DerivationInputs@ as a `Builder` using custom
+-- | Render a @TraditionalDerivationInputs@ as a `Builder` using custom
 -- renderer for storePaths and output names
-buildDerivationInputs
+buildTraditionalDerivationInputs
     :: StoreDir
     -> TraditionalDerivationInputs
     -> Builder
-buildDerivationInputs storeDir (TraditionalDerivationInputs {..}) =
+buildTraditionalDerivationInputs storeDir (TraditionalDerivationInputs {..}) =
         mapOf keyValue traditionalDrvs
     <>  ","
     <>  setOf (storePath storeDir) traditionalSrcs

hnix-store-aterm/src/System/Nix/Derivation/ATerm/Parser.hs

@@ -9,10 +9,10 @@
 
 module System.Nix.Derivation.ATerm.Parser
     ( -- * Parser
-      parseDerivation
-    , parseDerivationWith
-    , parseDerivationOutput
-    , parseDerivationInputs
+      parseTraditionalDerivation
+    , parseTraditionalDerivationWith
+    , parseFreeformDerivationOutput
+    , parseTraditionalDerivationInputs
     , textParser
     ) where
 
@@ -28,11 +28,11 @@ import Data.Text qualified
 import Data.Vector (Vector)
 import Data.Vector qualified
 
-import System.Nix.Derivation.Traditional
 import System.Nix.Derivation
-    ( Derivation'(..)
-    , DerivationOutput(..)
+    ( FreeformDerivationOutput(..)
+    , FreeformDerivationOutputs
     )
+import System.Nix.Derivation.Traditional
 import System.Nix.StorePath
 import System.Nix.OutputName
 
@@ -44,46 +44,47 @@ listOf element = do
     pure es
 
 -- | Parse a derivation
-parseDerivation :: StoreDir -> StorePathName -> Parser (Derivation' TraditionalDerivationInputs DerivationOutput)
-parseDerivation sd =
-    parseDerivationWith
-        (parseDerivationInputs sd)
-        (parseDerivationOutput sd)
+parseTraditionalDerivation
+  :: StoreDir
+  -> Parser (TraditionalDerivation' TraditionalDerivationInputs FreeformDerivationOutputs)
+parseTraditionalDerivation sd =
+    parseTraditionalDerivationWith
+        (parseTraditionalDerivationInputs sd)
+        (\_ -> parseFreeformDerivationOutput sd)
 
 -- | Parse a derivation using custom
 -- parsers for filepaths, texts, outputNames and derivation inputs/outputs
-parseDerivationWith
+parseTraditionalDerivationWith
     :: Parser drvInputs
-    -> (StorePathName -> OutputName -> Parser drvOutput)
-    -> StorePathName
-    -> Parser (Derivation' drvInputs drvOutput)
-parseDerivationWith parseInputs parseOutput name = do
+    -> (OutputName -> Parser drvOutput)
+    -> Parser (TraditionalDerivation' drvInputs (Map OutputName drvOutput))
+parseTraditionalDerivationWith parseInputs parseOutput = do
     "Derive("
 
     let keyValue0 = do
             "("
             key <- outputNameParser
             ","
-            drvOutput <- parseOutput name key
+            drvOutput <- parseOutput key
             ")"
             return (key, drvOutput)
-    outputs <- mapOf keyValue0
+    anonOutputs <- mapOf keyValue0
 
     ","
 
-    inputs <- parseInputs
+    anonInputs <- parseInputs
 
     ","
 
-    platform <- textParser
+    anonPlatform <- textParser
 
     ","
 
-    builder <- textParser
+    anonBuilder <- textParser
 
     ","
 
-    args <- vectorOf textParser
+    anonArgs <- vectorOf textParser
 
     ","
 
@@ -94,25 +95,25 @@ parseDerivationWith parseInputs parseOutput name = do
             value <- textParser
             ")"
             pure (key, value)
-    env <- mapOf keyValue1
+    anonEnv <- mapOf keyValue1
 
     ")"
 
-    pure Derivation {..}
+    pure TraditionalDerivation {..}
 
 -- | Parse a derivation output
-parseDerivationOutput :: StoreDir -> StorePathName -> OutputName -> Parser DerivationOutput
-parseDerivationOutput sd drvName outputName = do
+parseFreeformDerivationOutput :: StoreDir -> Parser FreeformDerivationOutput
+parseFreeformDerivationOutput sd = do
     rawPath <- textParser
     ","
     rawMethodHashAlgo <- textParser
     ","
     rawHash <- textParser
-    parseRawDerivationOutput sd drvName outputName $ RawDerivationOutput {..}
+    parseRawDerivationOutput sd $ RawDerivationOutput {..}
 
 -- | Parse a derivation inputs
-parseDerivationInputs :: StoreDir -> Parser TraditionalDerivationInputs
-parseDerivationInputs sd = do
+parseTraditionalDerivationInputs :: StoreDir -> Parser TraditionalDerivationInputs
+parseTraditionalDerivationInputs sd = do
     traditionalDrvs <- mapOf $ do
          "("
          key <- storePathParser sd