Complete snapshot layer

foo.yaml

resolver: lts-15.5

packages:
- pantry-0.4.0.1
- casa-client-0.0.1
- casa-types-0.0.1
- hackage-security-0.6.0.0
- hpack-0.33.0
- lukko-0.1.1.1

Main.hs

#!/usr/bin/env stack
-- stack --resolver foo.yaml script
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import Pantry
import RIO
import Path
import Path.IO
import Data.Yaml (encodeFile)

complete
  :: FilePath -- ^ input
  -> FilePath -- ^ output
  -> RIO PantryApp ()
complete inputFP outputFP = do
  -- This make-a-resolved-path logic can move into Pantry itself
  inputRel <- parseRelFile inputFP
  inputAbs <- canonicalizePath inputRel
  let inputRP = ResolvedPath
        { resolvedRelative = RelFilePath $ fromString inputFP
        , resolvedAbsolute = inputAbs
        }
  ersl <- loadSnapshotLayer $ SLFilePath inputRP
  rsl <-
    case ersl of
      Left _ -> throwString "We don't complete compiler-only layers"
      Right rsl -> pure rsl
  sl <- completeSnapshotLayer rsl
  liftIO $ encodeFile outputFP sl

completeSnapshotLayer
  :: RawSnapshotLayer
  -> RIO PantryApp SnapshotLayer
completeSnapshotLayer RawSnapshotLayer {..} = do
  slParent <- completeSnapshotLocation rslParent
  slLocations <- for rslLocations $ \rawLoc -> do
    cpl <- completePackageLocation rawLoc
    if cplHasCabalFile cpl
      then pure $ cplComplete cpl
      else throwString $ "We're no longer supporting packages without cabal files: " ++ show rawLoc
  let slCompiler = rslCompiler
      slDropPackages = rslDropPackages
      slFlags = rslFlags
      slHidden = rslHidden
      slGhcOptions = rslGhcOptions
      slPublishTime = rslPublishTime
  pure SnapshotLayer {..}

main :: IO ()
main = runPantryApp $ complete "foo.yaml" "bar.yaml"