Move psc-package commands from IO to Spago context

app/Spago.hs

@@ -374,8 +374,8 @@ main = do
  -> Spago.Build.bundleModule modName tPath shouldBuild buildOptions
  Docs format sourcePaths depsOnly -> Spago.Build.docs format sourcePaths depsOnly
  Version -> printVersion
- PscPackageLocalSetup force -> liftIO $ PscPackage.localSetup force
- PscPackageInsDhall -> liftIO $ PscPackage.insDhall
- PscPackageClean -> liftIO $ PscPackage.clean
+ PscPackageLocalSetup force -> PscPackage.localSetup force
+ PscPackageInsDhall -> PscPackage.insDhall
+ PscPackageClean -> PscPackage.clean
  Bundle -> die Messages.bundleCommandRenamed
  MakeModule -> die Messages.makeModuleCommandRenamed

src/Spago/PackageSet.hs

@@ -80,7 +80,7 @@ path = pathFromText pathText
 
 
 -- | Tries to create the `packages.dhall` file if needed
-makePackageSetFile :: Bool -> IO ()
+makePackageSetFile :: Spago m => Bool -> m ()
 makePackageSetFile force = do
  hasPackagesDhall <- testfile path
  if force || not hasPackagesDhall

src/Spago/Packages.hs

@@ -46,7 +46,7 @@ initProject force = do
  echo "Initializing a sample project or migrating an existing one.."
 
  -- packages.dhall and spago.dhall overwrite can be forced
- liftIO $ PackageSet.makePackageSetFile force
+ PackageSet.makePackageSetFile force
  Config.makeConfig force
 
  -- Get the latest version of the package set if possible

src/Spago/PscPackage.hs

@@ -1,19 +1,16 @@
 module Spago.PscPackage where
 
-import Prelude
+import Spago.Prelude
 
-import Control.Exception (SomeException, try)
 import qualified Data.Aeson as JSON
 import Data.Aeson.Encode.Pretty (encodePretty)
 import qualified Data.Aeson.Encode.Pretty as JSON
 import qualified Data.ByteString.Lazy as ByteString.Lazy
-import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Encoding as LT
 import qualified Dhall.JSON as Dhall.JSON
-import GHC.Generics (Generic)
 import System.Directory (removePathForcibly)
 import qualified Turtle as T
 
@@ -58,82 +55,84 @@ encodePscPackage = LT.toStrict . LT.decodeUtf8 . encodePretty
 
 -- | Given a path to a Dhall file and an output path to a JSON file,
 -- reads the Dhall, converts it, and writes it as JSON
-dhallToJSON :: T.Text -> T.FilePath -> IO ()
+dhallToJSON :: Spago m => T.Text -> T.FilePath -> m ()
 dhallToJSON inputPath outputPath = do
  let config = JSON.Config
  { JSON.confIndent = JSON.Spaces 2
  , JSON.confCompare = compare
  , JSON.confNumFormat = JSON.Generic
  , JSON.confTrailingNewline = False }
 
- dhall <- T.readTextFile $ T.fromText inputPath
+ dhall <- readTextFile $ T.fromText inputPath
 
- json <- Dhall.JSON.codeToValue Dhall.JSON.NoConversion inputPath dhall
+ jsonVal <- liftIO $ Dhall.JSON.codeToValue Dhall.JSON.NoConversion inputPath dhall
 
- T.writeTextFile outputPath
+ writeTextFile outputPath
  $ Text.decodeUtf8
  $ ByteString.Lazy.toStrict
- $ JSON.encodePretty' config json
+ $ JSON.encodePretty' config jsonVal
 
 
 -- | Generates a local `packages.json` from the current `packages.dhall`
-insDhall :: IO ()
+insDhall :: Spago m => m ()
 insDhall = do
- isProject <- T.testfile PackageSet.path
- T.unless isProject $
- T.die "Missing packages.dhall file. Run `spago psc-package-local-setup` first."
- T.mktree pscPackageBasePath
+ isProject <- testfile PackageSet.path
+ unless isProject $
+ die "Missing packages.dhall file. Run `spago psc-package-local-setup` first."
+ mktree pscPackageBasePath
  T.touch packagesJsonPath
 
+ PackageSet.ensureFrozen
+
  try (dhallToJSON PackageSet.pathText packagesJsonPath) >>= \case
  Right _ -> do
- T.echo $ T.unsafeTextToLine $ "Wrote packages.json to " <> packagesJsonText
- T.echo "Now you can run `psc-package install`."
+ echo $ "Wrote packages.json to " <> packagesJsonText
+ echo "Now you can run `psc-package install`."
  Left (err :: SomeException) ->
- T.die ("Failed to insdhall: " <> Text.pack (show err))
+ die $ "Failed to insdhall: " <> tshow err
 
 
 -- | Tries to create the `psc-package.json` file. Existing dependencies are preserved,
 -- | unless `--force` has been used.
-makePscPackage :: Bool -> IO ()
+makePscPackage :: Spago m => Bool -> m ()
 makePscPackage force = do
- hasPscPackage <- T.testfile configPath
+ hasPscPackage <- testfile configPath
  if hasPscPackage && not force
  then do
- pscPackage <- T.readTextFile configPath
+ pscPackage <- readTextFile configPath
  case JSON.eitherDecodeStrict $ Text.encodeUtf8 pscPackage of
- Left e -> T.die $ "The existing psc-package.json file is in the wrong format: " <>
+ Left e -> die $ "The existing psc-package.json file is in the wrong format: " <>
  Text.pack e
  Right p -> do
- T.writeTextFile configPath $
+ writeTextFile configPath $
  encodePscPackage $ p { set = "local", source = "" }
- T.echo "An existing psc-package.json file was found and upgraded to use local package sets."
+ echo "An existing psc-package.json file was found and upgraded to use local package sets."
 
  else do
  T.touch configPath
  pwd <- T.pwd
  let projectName = case T.toText $ T.filename pwd of
  Left _ -> "my-project"
  Right n -> n
- T.writeTextFile configPath $ pscPackageJson projectName
+ writeTextFile configPath $ pscPackageJson projectName
 
 
 -- | Create `packages.dhall` and update `psc-package.json` to use the local set
-localSetup :: Bool -> IO ()
+localSetup :: Spago m => Bool -> m ()
 localSetup force = do
  PackageSet.makePackageSetFile force
  makePscPackage force
- T.echo "Set up local Dhall packages."
- T.echo "Run `spago psc-package-insdhall` to generate the package set."
+ echo "Set up local Dhall packages."
+ echo "Run `spago psc-package-insdhall` to generate the package set."
 
 
 -- | Delete the .psc-package folder
-clean :: IO ()
+clean :: Spago m => m ()
 clean = do
  let pscDir = "./.psc-package"
- hasDir <- T.testdir pscDir
+ hasDir <- testdir pscDir
  if hasDir
  then do
- removePathForcibly $ T.encodeString pscDir
- T.echo "Packages cache was cleaned."
- else T.echo "Nothing to clean here."
+ liftIO $ removePathForcibly $ T.encodeString pscDir
+ echo "Packages cache was cleaned."
+ else echo "Nothing to clean here."