{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | @futhark pkg@
module Futhark.CLI.Pkg (main) where

import qualified Codec.Archive.Zip as Zip
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.State
import qualified Data.ByteString.Lazy as LBS
import Data.List (intercalate, isPrefixOf)
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Futhark.Pkg.Info
import Futhark.Pkg.Solve
import Futhark.Pkg.Types
import Futhark.Util (directoryContents, maxinum)
import Futhark.Util.Log
import Futhark.Util.Options
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import qualified System.FilePath.Posix as Posix
import System.IO
import Prelude

--- Installing packages

installInDir :: BuildList -> FilePath -> PkgM ()
installInDir :: BuildList -> FilePath -> PkgM ()
installInDir (BuildList Map PkgPath SemVer
bl) FilePath
dir = do
  let putEntry :: FilePath -> FilePath -> Entry -> IO (Maybe FilePath)
putEntry FilePath
from_dir FilePath
pdir Entry
entry
        -- The archive may contain all kinds of other stuff that we don't want.
        | Bool -> Bool
not (FilePath -> FilePath -> Bool
isInPkgDir FilePath
from_dir (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ Entry -> FilePath
Zip.eRelativePath Entry
entry)
            Bool -> Bool -> Bool
|| FilePath -> Bool
hasTrailingPathSeparator (Entry -> FilePath
Zip.eRelativePath Entry
entry) =
          Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
        | Bool
otherwise = do
          -- Since we are writing to paths indicated in a zipfile we
          -- downloaded from the wild Internet, we are going to be a
          -- little bit paranoid.  Specifically, we want to avoid
          -- writing outside of the 'lib/' directory.  We do this by
          -- bailing out if the path contains any '..' components.  We
          -- have to use System.FilePath.Posix, because the zip library
          -- claims to encode filepaths with '/' directory seperators no
          -- matter the host OS.
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
".." FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath -> [FilePath]
Posix.splitPath (Entry -> FilePath
Zip.eRelativePath Entry
entry)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
              FilePath
"Zip archive for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
pdir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" contains suspicious path: "
                FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Entry -> FilePath
Zip.eRelativePath Entry
entry
          let f :: FilePath
f = FilePath
pdir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
from_dir (Entry -> FilePath
Zip.eRelativePath Entry
entry)
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
f
          FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
f (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry Entry
entry
          Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f

      isInPkgDir :: FilePath -> FilePath -> Bool
isInPkgDir FilePath
from_dir FilePath
f =
        FilePath -> [FilePath]
Posix.splitPath FilePath
from_dir [FilePath] -> [FilePath] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath -> [FilePath]
Posix.splitPath FilePath
f

  [(PkgPath, SemVer)] -> ((PkgPath, SemVer) -> PkgM ()) -> PkgM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PkgPath SemVer -> [(PkgPath, SemVer)]
forall k a. Map k a -> [(k, a)]
M.toList Map PkgPath SemVer
bl) (((PkgPath, SemVer) -> PkgM ()) -> PkgM ())
-> ((PkgPath, SemVer) -> PkgM ()) -> PkgM ()
forall a b. (a -> b) -> a -> b
$ \(PkgPath
p, SemVer
v) -> do
    PkgRevInfo PkgM
info <- PkgPath -> SemVer -> PkgM (PkgRevInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgPath -> SemVer -> m (PkgRevInfo m)
lookupPackageRev PkgPath
p SemVer
v
    Archive
a <- PkgRevInfo PkgM -> PkgM Archive
forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadFail m) =>
PkgRevInfo m -> m Archive
downloadZipball PkgRevInfo PkgM
info
    PkgManifest
m <- GetManifest PkgM -> PkgM PkgManifest
forall (m :: * -> *). GetManifest m -> m PkgManifest
getManifest (GetManifest PkgM -> PkgM PkgManifest)
-> GetManifest PkgM -> PkgM PkgManifest
forall a b. (a -> b) -> a -> b
$ PkgRevInfo PkgM -> GetManifest PkgM
forall (m :: * -> *). PkgRevInfo m -> GetManifest m
pkgRevGetManifest PkgRevInfo PkgM
info

    -- Compute the directory in the zipball that should contain the
    -- package files.
    let noPkgDir :: PkgM a
noPkgDir =
          FilePath -> PkgM a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> PkgM a) -> FilePath -> PkgM a
forall a b. (a -> b) -> a -> b
$
            FilePath
"futhark.pkg for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PkgPath -> FilePath
T.unpack PkgPath
p FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-"
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PkgPath -> FilePath
T.unpack (SemVer -> PkgPath
prettySemVer SemVer
v)
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not define a package path."
    FilePath
from_dir <- PkgM FilePath
-> (FilePath -> PkgM FilePath) -> Maybe FilePath -> PkgM FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PkgM FilePath
forall a. PkgM a
noPkgDir (FilePath -> PkgM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> PkgM FilePath)
-> (FilePath -> FilePath) -> FilePath -> PkgM FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PkgRevInfo PkgM -> FilePath
forall (m :: * -> *). PkgRevInfo m -> FilePath
pkgRevZipballDir PkgRevInfo PkgM
info FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>)) (Maybe FilePath -> PkgM FilePath)
-> Maybe FilePath -> PkgM FilePath
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Maybe FilePath
pkgDir PkgManifest
m

    -- The directory in the local file system that will contain the
    -- package files.
    let pdir :: FilePath
pdir = FilePath
dir FilePath -> FilePath -> FilePath
</> PkgPath -> FilePath
T.unpack PkgPath
p
    -- Remove any existing directory for this package.  This is a bit
    -- inefficient, as the likelihood that the old ``lib`` directory
    -- already contains the correct version is rather high.  We should
    -- have a way to recognise this situation, and not download the
    -- zipball in that case.
    IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removePathForcibly FilePath
pdir
    IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
pdir

    [FilePath]
written <-
      [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FilePath] -> [FilePath])
-> PkgM [Maybe FilePath] -> PkgM [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Maybe FilePath] -> PkgM [Maybe FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Entry -> IO (Maybe FilePath)) -> [Entry] -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> FilePath -> Entry -> IO (Maybe FilePath)
putEntry FilePath
from_dir FilePath
pdir) ([Entry] -> IO [Maybe FilePath]) -> [Entry] -> IO [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
Zip.zEntries Archive
a)

    Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
written) (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> PkgM ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> PkgM ()) -> FilePath -> PkgM ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"Zip archive for package " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PkgPath -> FilePath
T.unpack PkgPath
p
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not contain any files in "
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
from_dir

libDir, libNewDir, libOldDir :: FilePath
(FilePath
libDir, FilePath
libNewDir, FilePath
libOldDir) = (FilePath
"lib", FilePath
"lib~new", FilePath
"lib~old")

-- | Install the packages listed in the build list in the @lib@
-- directory of the current working directory.  Since we are touching
-- the file system, we are going to be very paranoid.  In particular,
-- we want to avoid corrupting the @lib@ directory if something fails
-- along the way.
--
-- The procedure is as follows:
--
-- 1) Create a directory @lib~new@.  Delete an existing @lib~new@ if
-- necessary.
--
-- 2) Populate @lib~new@ based on the build list.
--
-- 3) Rename @lib@ to @lib~old@.  Delete an existing @lib~old@ if
-- necessary.
--
-- 4) Rename @lib~new@ to @lib@
--
-- 5) If the current package has package path @p@, move @lib~old/p@ to
-- @lib~new/p@.
--
-- 6) Delete @lib~old@.
--
-- Since POSIX at least guarantees atomic renames, the only place this
-- can fail is between steps 3, 4, and 5.  In that case, at least the
-- @lib~old@ will still exist and can be put back by the user.
installBuildList :: Maybe PkgPath -> BuildList -> PkgM ()
installBuildList :: Maybe PkgPath -> BuildList -> PkgM ()
installBuildList Maybe PkgPath
p BuildList
bl = do
  Bool
libdir_exists <- IO Bool -> PkgM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
libDir

  -- 1
  IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
removePathForcibly FilePath
libNewDir
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
libNewDir

  -- 2
  BuildList -> FilePath -> PkgM ()
installInDir BuildList
bl FilePath
libNewDir

  -- 3
  Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
libdir_exists (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
    IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> IO ()
removePathForcibly FilePath
libOldDir
      FilePath -> FilePath -> IO ()
renameDirectory FilePath
libDir FilePath
libOldDir

  -- 4
  IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameDirectory FilePath
libNewDir FilePath
libDir

  -- 5
  case PkgPath -> FilePath
pkgPathFilePath (PkgPath -> FilePath) -> Maybe PkgPath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PkgPath
p of
    Just FilePath
pfp | Bool
libdir_exists -> IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
      Bool
pkgdir_exists <- FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
libOldDir FilePath -> FilePath -> FilePath
</> FilePath
pfp
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pkgdir_exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- Ensure the parent directories exist so that we can move the
        -- package directory directly.
        Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
libDir FilePath -> FilePath -> FilePath
</> FilePath
pfp
        FilePath -> FilePath -> IO ()
renameDirectory (FilePath
libOldDir FilePath -> FilePath -> FilePath
</> FilePath
pfp) (FilePath
libDir FilePath -> FilePath -> FilePath
</> FilePath
pfp)
    Maybe FilePath
_ -> () -> PkgM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- 6
  Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
libdir_exists (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removePathForcibly FilePath
libOldDir

getPkgManifest :: PkgM PkgManifest
getPkgManifest :: PkgM PkgManifest
getPkgManifest = do
  Bool
file_exists <- IO Bool -> PkgM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
futharkPkg
  Bool
dir_exists <- IO Bool -> PkgM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
futharkPkg

  case (Bool
file_exists, Bool
dir_exists) of
    (Bool
True, Bool
_) -> IO PkgManifest -> PkgM PkgManifest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PkgManifest -> PkgM PkgManifest)
-> IO PkgManifest -> PkgM PkgManifest
forall a b. (a -> b) -> a -> b
$ FilePath -> IO PkgManifest
parsePkgManifestFromFile FilePath
futharkPkg
    (Bool
_, Bool
True) ->
      FilePath -> PkgM PkgManifest
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> PkgM PkgManifest) -> FilePath -> PkgM PkgManifest
forall a b. (a -> b) -> a -> b
$
        FilePath
futharkPkg
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" exists, but it is a directory!  What in Odin's beard..."
    (Bool, Bool)
_ -> IO PkgManifest -> PkgM PkgManifest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PkgManifest -> PkgM PkgManifest)
-> IO PkgManifest -> PkgM PkgManifest
forall a b. (a -> b) -> a -> b
$ do
      PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> PkgPath
T.pack FilePath
futharkPkg PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" not found - pretending it's empty."
      PkgManifest -> IO PkgManifest
forall (m :: * -> *) a. Monad m => a -> m a
return (PkgManifest -> IO PkgManifest) -> PkgManifest -> IO PkgManifest
forall a b. (a -> b) -> a -> b
$ Maybe PkgPath -> PkgManifest
newPkgManifest Maybe PkgPath
forall a. Maybe a
Nothing

putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest = IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ())
-> (PkgManifest -> IO ()) -> PkgManifest -> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PkgPath -> IO ()
T.writeFile FilePath
futharkPkg (PkgPath -> IO ())
-> (PkgManifest -> PkgPath) -> PkgManifest -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> PkgPath
prettyPkgManifest

--- The CLI

newtype PkgConfig = PkgConfig {PkgConfig -> Bool
pkgVerbose :: Bool}

-- | The monad in which futhark-pkg runs.
newtype PkgM a = PkgM {PkgM a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
unPkgM :: ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a}
  deriving (a -> PkgM b -> PkgM a
(a -> b) -> PkgM a -> PkgM b
(forall a b. (a -> b) -> PkgM a -> PkgM b)
-> (forall a b. a -> PkgM b -> PkgM a) -> Functor PkgM
forall a b. a -> PkgM b -> PkgM a
forall a b. (a -> b) -> PkgM a -> PkgM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PkgM b -> PkgM a
$c<$ :: forall a b. a -> PkgM b -> PkgM a
fmap :: (a -> b) -> PkgM a -> PkgM b
$cfmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
Functor, Functor PkgM
a -> PkgM a
Functor PkgM
-> (forall a. a -> PkgM a)
-> (forall a b. PkgM (a -> b) -> PkgM a -> PkgM b)
-> (forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c)
-> (forall a b. PkgM a -> PkgM b -> PkgM b)
-> (forall a b. PkgM a -> PkgM b -> PkgM a)
-> Applicative PkgM
PkgM a -> PkgM b -> PkgM b
PkgM a -> PkgM b -> PkgM a
PkgM (a -> b) -> PkgM a -> PkgM b
(a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
forall a. a -> PkgM a
forall a b. PkgM a -> PkgM b -> PkgM a
forall a b. PkgM a -> PkgM b -> PkgM b
forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: PkgM a -> PkgM b -> PkgM a
$c<* :: forall a b. PkgM a -> PkgM b -> PkgM a
*> :: PkgM a -> PkgM b -> PkgM b
$c*> :: forall a b. PkgM a -> PkgM b -> PkgM b
liftA2 :: (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
$cliftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
<*> :: PkgM (a -> b) -> PkgM a -> PkgM b
$c<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
pure :: a -> PkgM a
$cpure :: forall a. a -> PkgM a
$cp1Applicative :: Functor PkgM
Applicative, Monad PkgM
Monad PkgM -> (forall a. IO a -> PkgM a) -> MonadIO PkgM
IO a -> PkgM a
forall a. IO a -> PkgM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> PkgM a
$cliftIO :: forall a. IO a -> PkgM a
$cp1MonadIO :: Monad PkgM
MonadIO, MonadReader PkgConfig)

instance Monad PkgM where
  PkgM ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m >>= :: PkgM a -> (a -> PkgM b) -> PkgM b
>>= a -> PkgM b
f = ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b -> PkgM b
forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM (ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b -> PkgM b)
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b -> PkgM b
forall a b. (a -> b) -> a -> b
$ ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
-> (a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b)
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PkgM b -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
forall a.
PkgM a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
unPkgM (PkgM b -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b)
-> (a -> PkgM b)
-> a
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PkgM b
f
  return :: a -> PkgM a
return = ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM (ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a)
-> (a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a)
-> a
-> PkgM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance MonadFail PkgM where
  fail :: FilePath -> PkgM a
fail FilePath
s = IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> PkgM a) -> IO a -> PkgM a
forall a b. (a -> b) -> a -> b
$ do
    FilePath
prog <- IO FilePath
getProgName
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
prog FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
s
    IO a
forall a. IO a
exitFailure

instance MonadPkgRegistry PkgM where
  putPkgRegistry :: PkgRegistry PkgM -> PkgM ()
putPkgRegistry = ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) () -> PkgM ()
forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM (ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) () -> PkgM ())
-> (PkgRegistry PkgM
    -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) ())
-> PkgRegistry PkgM
-> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgRegistry PkgM
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  getPkgRegistry :: PkgM (PkgRegistry PkgM)
getPkgRegistry = ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) (PkgRegistry PkgM)
-> PkgM (PkgRegistry PkgM)
forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) (PkgRegistry PkgM)
forall s (m :: * -> *). MonadState s m => m s
get

instance MonadLogger PkgM where
  addLog :: Log -> PkgM ()
addLog Log
l = do
    Bool
verbose <- (PkgConfig -> Bool) -> PkgM Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PkgConfig -> Bool
pkgVerbose
    Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Handle -> PkgPath -> IO ()
T.hPutStrLn Handle
stderr (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ Log -> PkgPath
toText Log
l

runPkgM :: PkgConfig -> PkgM a -> IO a
runPkgM :: PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m) = StateT (PkgRegistry PkgM) IO a -> PkgRegistry PkgM -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
-> PkgConfig -> StateT (PkgRegistry PkgM) IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m PkgConfig
cfg) PkgRegistry PkgM
forall a. Monoid a => a
mempty

cmdMain ::
  String ->
  ([String] -> PkgConfig -> Maybe (IO ())) ->
  String ->
  [String] ->
  IO ()
cmdMain :: FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain = PkgConfig
-> [FunOptDescr PkgConfig]
-> FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> FilePath
-> ([FilePath] -> cfg -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
mainWithOptions (Bool -> PkgConfig
PkgConfig Bool
False) [FunOptDescr PkgConfig]
forall a. [OptDescr (Either a (PkgConfig -> PkgConfig))]
options
  where
    options :: [OptDescr (Either a (PkgConfig -> PkgConfig))]
options =
      [ FilePath
-> [FilePath]
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
-> FilePath
-> OptDescr (Either a (PkgConfig -> PkgConfig))
forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option
          FilePath
"v"
          [FilePath
"verbose"]
          (Either a (PkgConfig -> PkgConfig)
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
forall a. a -> ArgDescr a
NoArg (Either a (PkgConfig -> PkgConfig)
 -> ArgDescr (Either a (PkgConfig -> PkgConfig)))
-> Either a (PkgConfig -> PkgConfig)
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
forall a b. (a -> b) -> a -> b
$ (PkgConfig -> PkgConfig) -> Either a (PkgConfig -> PkgConfig)
forall a b. b -> Either a b
Right ((PkgConfig -> PkgConfig) -> Either a (PkgConfig -> PkgConfig))
-> (PkgConfig -> PkgConfig) -> Either a (PkgConfig -> PkgConfig)
forall a b. (a -> b) -> a -> b
$ \PkgConfig
cfg -> PkgConfig
cfg {pkgVerbose :: Bool
pkgVerbose = Bool
True})
          FilePath
"Write running diagnostics to stderr."
      ]

doFmt :: String -> [String] -> IO ()
doFmt :: FilePath -> [FilePath] -> IO ()
doFmt = ()
-> [FunOptDescr ()]
-> FilePath
-> ([FilePath] -> () -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> FilePath
-> ([FilePath] -> cfg -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
mainWithOptions () [] FilePath
"" (([FilePath] -> () -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> () -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args () ->
  case [FilePath]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
      PkgManifest
m <- FilePath -> IO PkgManifest
parsePkgManifestFromFile FilePath
futharkPkg
      FilePath -> PkgPath -> IO ()
T.writeFile FilePath
futharkPkg (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgPath
prettyPkgManifest PkgManifest
m
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing

doCheck :: String -> [String] -> IO ()
doCheck :: FilePath -> [FilePath] -> IO ()
doCheck = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"check" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$
      PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        PkgManifest
m <- PkgM PkgManifest
getPkgManifest
        BuildList
bl <- PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgRevDeps -> m BuildList
solveDeps (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m

        IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn PkgPath
"Dependencies chosen:"
        IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStr (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ BuildList -> PkgPath
prettyBuildList BuildList
bl

        case Commented (Maybe PkgPath) -> Maybe PkgPath
forall a. Commented a -> a
commented (Commented (Maybe PkgPath) -> Maybe PkgPath)
-> Commented (Maybe PkgPath) -> Maybe PkgPath
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe PkgPath)
manifestPkgPath PkgManifest
m of
          Maybe PkgPath
Nothing -> () -> PkgM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just PkgPath
p -> do
            let pdir :: FilePath
pdir = FilePath
"lib" FilePath -> FilePath -> FilePath
</> PkgPath -> FilePath
T.unpack PkgPath
p

            Bool
pdir_exists <- IO Bool -> PkgM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
pdir

            Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pdir_exists (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
              IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
                PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Problem: the directory " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack FilePath
pdir PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" does not exist."
                IO ()
forall a. IO a
exitFailure

            Bool
anything <-
              IO Bool -> PkgM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$
                (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".fut") (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension)
                  ([FilePath] -> Bool) -> IO [FilePath] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
directoryContents (FilePath
"lib" FilePath -> FilePath -> FilePath
</> PkgPath -> FilePath
T.unpack PkgPath
p)
            Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
anything (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
              IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
                PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Problem: the directory " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack FilePath
pdir PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" does not contain any .fut files."
                IO ()
forall a. IO a
exitFailure
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing

doSync :: String -> [String] -> IO ()
doSync :: FilePath -> [FilePath] -> IO ()
doSync = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$
      PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        PkgManifest
m <- PkgM PkgManifest
getPkgManifest
        BuildList
bl <- PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgRevDeps -> m BuildList
solveDeps (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
        Maybe PkgPath -> BuildList -> PkgM ()
installBuildList (Commented (Maybe PkgPath) -> Maybe PkgPath
forall a. Commented a -> a
commented (Commented (Maybe PkgPath) -> Maybe PkgPath)
-> Commented (Maybe PkgPath) -> Maybe PkgPath
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe PkgPath)
manifestPkgPath PkgManifest
m) BuildList
bl
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing

doAdd :: String -> [String] -> IO ()
doAdd :: FilePath -> [FilePath] -> IO ()
doAdd = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"PKGPATH" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [FilePath
p, FilePath
v] | Right SemVer
v' <- PkgPath -> Either (ParseErrorBundle PkgPath Void) SemVer
parseVersion (PkgPath -> Either (ParseErrorBundle PkgPath Void) SemVer)
-> PkgPath -> Either (ParseErrorBundle PkgPath Void) SemVer
forall a b. (a -> b) -> a -> b
$ FilePath -> PkgPath
T.pack FilePath
v -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> SemVer -> PkgM ()
doAdd' (FilePath -> PkgPath
T.pack FilePath
p) SemVer
v'
    [FilePath
p] ->
      IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$
        PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$
          -- Look up the newest revision of the package.
          PkgPath -> SemVer -> PkgM ()
doAdd' (FilePath -> PkgPath
T.pack FilePath
p) (SemVer -> PkgM ()) -> PkgM SemVer -> PkgM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PkgPath -> PkgM SemVer
forall (m :: * -> *). MonadPkgRegistry m => PkgPath -> m SemVer
lookupNewestRev (FilePath -> PkgPath
T.pack FilePath
p)
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    doAdd' :: PkgPath -> SemVer -> PkgM ()
doAdd' PkgPath
p SemVer
v = do
      PkgManifest
m <- PkgM PkgManifest
getPkgManifest

      -- See if this package (and its dependencies) even exists.  We
      -- do this by running the solver with the dependencies already
      -- in the manifest, plus this new one.  The Monoid instance for
      -- PkgRevDeps is left-biased, so we are careful to use the new
      -- version for this package.
      BuildList
_ <- PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgRevDeps -> m BuildList
solveDeps (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ Map PkgPath (SemVer, Maybe PkgPath) -> PkgRevDeps
PkgRevDeps (PkgPath
-> (SemVer, Maybe PkgPath) -> Map PkgPath (SemVer, Maybe PkgPath)
forall k a. k -> a -> Map k a
M.singleton PkgPath
p (SemVer
v, Maybe PkgPath
forall a. Maybe a
Nothing)) PkgRevDeps -> PkgRevDeps -> PkgRevDeps
forall a. Semigroup a => a -> a -> a
<> PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m

      -- We either replace any existing occurence of package 'p', or
      -- we add a new one.
      PkgRevInfo PkgM
p_info <- PkgPath -> SemVer -> PkgM (PkgRevInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgPath -> SemVer -> m (PkgRevInfo m)
lookupPackageRev PkgPath
p SemVer
v
      let hash :: Maybe PkgPath
hash = case (SemVer -> Word
_svMajor SemVer
v, SemVer -> Word
_svMinor SemVer
v, SemVer -> Word
_svPatch SemVer
v) of
            -- We do not perform hash-pinning for
            -- (0,0,0)-versions, because these already embed a
            -- specific revision ID into their version number.
            (Word
0, Word
0, Word
0) -> Maybe PkgPath
forall a. Maybe a
Nothing
            (Word, Word, Word)
_ -> PkgPath -> Maybe PkgPath
forall a. a -> Maybe a
Just (PkgPath -> Maybe PkgPath) -> PkgPath -> Maybe PkgPath
forall a b. (a -> b) -> a -> b
$ PkgRevInfo PkgM -> PkgPath
forall (m :: * -> *). PkgRevInfo m -> PkgPath
pkgRevCommit PkgRevInfo PkgM
p_info
          req :: Required
req = PkgPath -> SemVer -> Maybe PkgPath -> Required
Required PkgPath
p SemVer
v Maybe PkgPath
hash
          (PkgManifest
m', Maybe Required
prev_r) = Required -> PkgManifest -> (PkgManifest, Maybe Required)
addRequiredToManifest Required
req PkgManifest
m

      case Maybe Required
prev_r of
        Just Required
prev_r'
          | Required -> SemVer
requiredPkgRev Required
prev_r' SemVer -> SemVer -> Bool
forall a. Eq a => a -> a -> Bool
== SemVer
v ->
            IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Package already at version " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer SemVer
v PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"; nothing to do."
          | Bool
otherwise ->
            IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
              PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$
                PkgPath
"Replaced " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
p PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" "
                  PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer (Required -> SemVer
requiredPkgRev Required
prev_r')
                  PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" => "
                  PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer SemVer
v
                  PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."
        Maybe Required
Nothing ->
          IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Added new required package " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
p PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer SemVer
v PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."
      PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
      IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn PkgPath
"Remember to run 'futhark pkg sync'."

doRemove :: String -> [String] -> IO ()
doRemove :: FilePath -> [FilePath] -> IO ()
doRemove = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"PKGPATH" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [FilePath
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> PkgM ()
doRemove' (PkgPath -> PkgM ()) -> PkgPath -> PkgM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> PkgPath
T.pack FilePath
p
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    doRemove' :: PkgPath -> PkgM ()
doRemove' PkgPath
p = do
      PkgManifest
m <- PkgM PkgManifest
getPkgManifest
      case PkgPath -> PkgManifest -> Maybe (PkgManifest, Required)
removeRequiredFromManifest PkgPath
p PkgManifest
m of
        Maybe (PkgManifest, Required)
Nothing -> IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
          PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"No package " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
p PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" found in " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack FilePath
futharkPkg PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."
          IO ()
forall a. IO a
exitFailure
        Just (PkgManifest
m', Required
r) -> do
          PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
          IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Removed " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
p PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer (Required -> SemVer
requiredPkgRev Required
r) PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."

doInit :: String -> [String] -> IO ()
doInit :: FilePath -> [FilePath] -> IO ()
doInit = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"PKGPATH" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [FilePath
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> PkgM ()
doCreate' (PkgPath -> PkgM ()) -> PkgPath -> PkgM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> PkgPath
T.pack FilePath
p
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    doCreate' :: PkgPath -> PkgM ()
doCreate' PkgPath
p = do
      Bool
exists <- IO Bool -> PkgM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesFileExist FilePath
futharkPkg IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO Bool
doesDirectoryExist FilePath
futharkPkg
      Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
        IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
          PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> PkgPath
T.pack FilePath
futharkPkg PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" already exists."
          IO ()
forall a. IO a
exitFailure

      IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"lib" FilePath -> FilePath -> FilePath
</> PkgPath -> FilePath
T.unpack PkgPath
p
      IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Created directory " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack (FilePath
"lib" FilePath -> FilePath -> FilePath
</> PkgPath -> FilePath
T.unpack PkgPath
p) PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."

      PkgManifest -> PkgM ()
putPkgManifest (PkgManifest -> PkgM ()) -> PkgManifest -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Maybe PkgPath -> PkgManifest
newPkgManifest (Maybe PkgPath -> PkgManifest) -> Maybe PkgPath -> PkgManifest
forall a b. (a -> b) -> a -> b
$ PkgPath -> Maybe PkgPath
forall a. a -> Maybe a
Just PkgPath
p
      IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Wrote " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack FilePath
futharkPkg PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."

doUpgrade :: String -> [String] -> IO ()
doUpgrade :: FilePath -> [FilePath] -> IO ()
doUpgrade = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$
      PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        PkgManifest
m <- PkgM PkgManifest
getPkgManifest
        Commented [Either PkgPath Required]
rs <- ([Either PkgPath Required] -> PkgM [Either PkgPath Required])
-> Commented [Either PkgPath Required]
-> PkgM (Commented [Either PkgPath Required])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Either PkgPath Required -> PkgM (Either PkgPath Required))
-> [Either PkgPath Required] -> PkgM [Either PkgPath Required]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Required -> PkgM Required)
-> Either PkgPath Required -> PkgM (Either PkgPath Required)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Required -> PkgM Required
forall (m :: * -> *). MonadPkgRegistry m => Required -> m Required
upgrade)) (Commented [Either PkgPath Required]
 -> PkgM (Commented [Either PkgPath Required]))
-> Commented [Either PkgPath Required]
-> PkgM (Commented [Either PkgPath Required])
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented [Either PkgPath Required]
manifestRequire PkgManifest
m
        PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m {manifestRequire :: Commented [Either PkgPath Required]
manifestRequire = Commented [Either PkgPath Required]
rs}
        if Commented [Either PkgPath Required]
rs Commented [Either PkgPath Required]
-> Commented [Either PkgPath Required] -> Bool
forall a. Eq a => a -> a -> Bool
== PkgManifest -> Commented [Either PkgPath Required]
manifestRequire PkgManifest
m
          then IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn PkgPath
"Nothing to upgrade."
          else IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> IO ()
T.putStrLn PkgPath
"Remember to run 'futhark pkg sync'."
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    upgrade :: Required -> m Required
upgrade Required
req = do
      SemVer
v <- PkgPath -> m SemVer
forall (m :: * -> *). MonadPkgRegistry m => PkgPath -> m SemVer
lookupNewestRev (PkgPath -> m SemVer) -> PkgPath -> m SemVer
forall a b. (a -> b) -> a -> b
$ Required -> PkgPath
requiredPkg Required
req
      PkgPath
h <- PkgRevInfo m -> PkgPath
forall (m :: * -> *). PkgRevInfo m -> PkgPath
pkgRevCommit (PkgRevInfo m -> PkgPath) -> m (PkgRevInfo m) -> m PkgPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgPath -> SemVer -> m (PkgRevInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgPath -> SemVer -> m (PkgRevInfo m)
lookupPackageRev (Required -> PkgPath
requiredPkg Required
req) SemVer
v

      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SemVer
v SemVer -> SemVer -> Bool
forall a. Eq a => a -> a -> Bool
/= Required -> SemVer
requiredPkgRev Required
req) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
          PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$
            PkgPath
"Upgraded " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> Required -> PkgPath
requiredPkg Required
req PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" "
              PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer (Required -> SemVer
requiredPkgRev Required
req)
              PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" => "
              PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> SemVer -> PkgPath
prettySemVer SemVer
v
              PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
"."

      Required -> m Required
forall (m :: * -> *) a. Monad m => a -> m a
return
        Required
req
          { requiredPkgRev :: SemVer
requiredPkgRev = SemVer
v,
            requiredHash :: Maybe PkgPath
requiredHash = PkgPath -> Maybe PkgPath
forall a. a -> Maybe a
Just PkgPath
h
          }

doVersions :: String -> [String] -> IO ()
doVersions :: FilePath -> [FilePath] -> IO ()
doVersions = FilePath
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
cmdMain FilePath
"PKGPATH" (([FilePath] -> PkgConfig -> Maybe (IO ()))
 -> FilePath -> [FilePath] -> IO ())
-> ([FilePath] -> PkgConfig -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[FilePath]
args PkgConfig
cfg ->
  case [FilePath]
args of
    [FilePath
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath -> PkgM ()
doVersions' (PkgPath -> PkgM ()) -> PkgPath -> PkgM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> PkgPath
T.pack FilePath
p
    [FilePath]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    doVersions' :: PkgPath -> PkgM ()
doVersions' =
      (SemVer -> PkgM ()) -> [SemVer] -> PkgM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> PkgM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> (SemVer -> IO ()) -> SemVer -> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> (SemVer -> PkgPath) -> SemVer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> PkgPath
prettySemVer) ([SemVer] -> PkgM ())
-> (PkgInfo PkgM -> [SemVer]) -> PkgInfo PkgM -> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SemVer (PkgRevInfo PkgM) -> [SemVer]
forall k a. Map k a -> [k]
M.keys (Map SemVer (PkgRevInfo PkgM) -> [SemVer])
-> (PkgInfo PkgM -> Map SemVer (PkgRevInfo PkgM))
-> PkgInfo PkgM
-> [SemVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo PkgM -> Map SemVer (PkgRevInfo PkgM)
forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions
        (PkgInfo PkgM -> PkgM ())
-> (PkgPath -> PkgM (PkgInfo PkgM)) -> PkgPath -> PkgM ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PkgPath -> PkgM (PkgInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
PkgPath -> m (PkgInfo m)
lookupPackage

-- | Run @futhark pkg@.
main :: String -> [String] -> IO ()
main :: FilePath -> [FilePath] -> IO ()
main FilePath
prog [FilePath]
args = do
  -- Avoid Git asking for credentials.  We prefer failure.
  IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
setEnv FilePath
"GIT_TERMINAL_PROMPT" FilePath
"0"

  let commands :: [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
commands =
        [ ( FilePath
"add",
            (FilePath -> [FilePath] -> IO ()
doAdd, PkgPath
"Add another required package to futhark.pkg.")
          ),
          ( FilePath
"check",
            (FilePath -> [FilePath] -> IO ()
doCheck, PkgPath
"Check that futhark.pkg is satisfiable.")
          ),
          ( FilePath
"init",
            (FilePath -> [FilePath] -> IO ()
doInit, PkgPath
"Create a new futhark.pkg and a lib/ skeleton.")
          ),
          ( FilePath
"fmt",
            (FilePath -> [FilePath] -> IO ()
doFmt, PkgPath
"Reformat futhark.pkg.")
          ),
          ( FilePath
"sync",
            (FilePath -> [FilePath] -> IO ()
doSync, PkgPath
"Populate lib/ as specified by futhark.pkg.")
          ),
          ( FilePath
"remove",
            (FilePath -> [FilePath] -> IO ()
doRemove, PkgPath
"Remove a required package from futhark.pkg.")
          ),
          ( FilePath
"upgrade",
            (FilePath -> [FilePath] -> IO ()
doUpgrade, PkgPath
"Upgrade all packages to newest versions.")
          ),
          ( FilePath
"versions",
            (FilePath -> [FilePath] -> IO ()
doVersions, PkgPath
"List available versions for a package.")
          )
        ]
      usage :: FilePath
usage = FilePath
"options... <" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"|" (((FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))
 -> FilePath)
-> [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
-> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, (FilePath -> [FilePath] -> IO (), PkgPath)) -> FilePath
forall a b. (a, b) -> a
fst [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
commands) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
">"
  case [FilePath]
args of
    FilePath
cmd : [FilePath]
args'
      | Just (FilePath -> [FilePath] -> IO ()
m, PkgPath
_) <- FilePath
-> [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
-> Maybe (FilePath -> [FilePath] -> IO (), PkgPath)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
cmd [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
commands ->
        FilePath -> [FilePath] -> IO ()
m ([FilePath] -> FilePath
unwords [FilePath
prog, FilePath
cmd]) [FilePath]
args'
    [FilePath]
_ -> do
      let bad :: p -> () -> Maybe (IO b)
bad p
_ () = IO b -> Maybe (IO b)
forall a. a -> Maybe a
Just (IO b -> Maybe (IO b)) -> IO b -> Maybe (IO b)
forall a b. (a -> b) -> a -> b
$ do
            let k :: Int
k = [Int] -> Int
forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum (((FilePath, (FilePath -> [FilePath] -> IO (), PkgPath)) -> Int)
-> [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
-> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int)
-> ((FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))
    -> FilePath)
-> (FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, (FilePath -> [FilePath] -> IO (), PkgPath)) -> FilePath
forall a b. (a, b) -> a
fst) [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
commands) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
            PkgPath -> IO b
forall b. PkgPath -> IO b
usageMsg (PkgPath -> IO b) -> PkgPath -> IO b
forall a b. (a -> b) -> a -> b
$
              [PkgPath] -> PkgPath
T.unlines ([PkgPath] -> PkgPath) -> [PkgPath] -> PkgPath
forall a b. (a -> b) -> a -> b
$
                [PkgPath
"<command> ...:", PkgPath
"", PkgPath
"Commands:"]
                  [PkgPath] -> [PkgPath] -> [PkgPath]
forall a. [a] -> [a] -> [a]
++ [ PkgPath
"   " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack FilePath
cmd PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack (Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
cmd) Char
' ') PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
desc
                       | (FilePath
cmd, (FilePath -> [FilePath] -> IO ()
_, PkgPath
desc)) <- [(FilePath, (FilePath -> [FilePath] -> IO (), PkgPath))]
commands
                     ]

      ()
-> [FunOptDescr ()]
-> FilePath
-> ([FilePath] -> () -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> FilePath
-> ([FilePath] -> cfg -> Maybe (IO ()))
-> FilePath
-> [FilePath]
-> IO ()
mainWithOptions () [] FilePath
usage [FilePath] -> () -> Maybe (IO ())
forall p b. p -> () -> Maybe (IO b)
bad FilePath
prog [FilePath]
args
  where
    usageMsg :: PkgPath -> IO b
usageMsg PkgPath
s = do
      PkgPath -> IO ()
T.putStrLn (PkgPath -> IO ()) -> PkgPath -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgPath
"Usage: " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> FilePath -> PkgPath
T.pack FilePath
prog PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
" [--version] [--help] " PkgPath -> PkgPath -> PkgPath
forall a. Semigroup a => a -> a -> a
<> PkgPath
s
      IO b
forall a. IO a
exitFailure