Skip to content

Commit

Permalink
Move psc-package commands from IO to Spago context (#337)
Browse files Browse the repository at this point in the history
So we can use global options and fix #240
  • Loading branch information
f-f authored Jul 26, 2019
1 parent f36d369 commit 47756d7
Show file tree
Hide file tree
Showing 4 changed files with 36 additions and 37 deletions.
6 changes: 3 additions & 3 deletions app/Spago.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
2 changes: 1 addition & 1 deletion src/Spago/PackageSet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/Spago/Packages.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
63 changes: 31 additions & 32 deletions src/Spago/PscPackage.hs
Original file line number Diff line number Diff line change
@@ -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

Expand Down Expand Up @@ -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."

0 comments on commit 47756d7

Please sign in to comment.