module Futhark.CLI.Pkg (main) where
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.State
import Data.List (intercalate)
import Data.Map qualified as M
import Data.Maybe
import Data.Monoid
import Data.Text qualified as T
import Data.Text.IO qualified 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 System.IO
import System.IO.Temp (withSystemTempDirectory)
import Prelude
installInDir :: CacheDir -> BuildList -> FilePath -> PkgM ()
installInDir :: CacheDir -> BuildList -> String -> PkgM ()
installInDir CacheDir
cachedir (BuildList Map Text SemVer
bl) String
dir =
[(Text, SemVer)] -> ((Text, SemVer) -> PkgM ()) -> PkgM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Text SemVer -> [(Text, SemVer)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text SemVer
bl) (((Text, SemVer) -> PkgM ()) -> PkgM ())
-> ((Text, SemVer) -> PkgM ()) -> PkgM ()
forall a b. (a -> b) -> a -> b
$ \(Text
p, SemVer
v) -> do
PkgRevInfo PkgM
info <- CacheDir -> Text -> SemVer -> PkgM (PkgRevInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir Text
p SemVer
v
(String
filedir, [String]
files) <- GetFiles PkgM -> PkgM (String, [String])
forall (m :: * -> *). GetFiles m -> m (String, [String])
getFiles (GetFiles PkgM -> PkgM (String, [String]))
-> GetFiles PkgM -> PkgM (String, [String])
forall a b. (a -> b) -> a -> b
$ PkgRevInfo PkgM -> GetFiles PkgM
forall (m :: * -> *). PkgRevInfo m -> GetFiles m
pkgGetFiles PkgRevInfo PkgM
info
let pdir :: String
pdir = String
dir String -> String -> String
</> Text -> String
T.unpack Text
p
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removePathForcibly String
pdir
[String] -> (String -> PkgM ()) -> PkgM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files ((String -> PkgM ()) -> PkgM ()) -> (String -> PkgM ()) -> PkgM ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
let from :: String
from = String
filedir String -> String -> String
</> String
file
to :: String
to = String
pdir String -> String -> String
</> String
file
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
to
String -> PkgM ()
forall a. ToLog a => a -> PkgM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (String -> PkgM ()) -> String -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String
"Copying " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
from String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
to
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
copyFile String
from String
to
libDir, libNewDir, libOldDir :: FilePath
(String
libDir, String
libNewDir, String
libOldDir) = (String
"lib", String
"lib~new", String
"lib~old")
installBuildList :: CacheDir -> Maybe PkgPath -> BuildList -> PkgM ()
installBuildList :: CacheDir -> Maybe Text -> BuildList -> PkgM ()
installBuildList CacheDir
cachedir Maybe Text
p BuildList
bl = do
Bool
libdir_exists <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
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
$ String -> IO Bool
doesDirectoryExist String
libDir
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
removePathForcibly String
libNewDir
Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
libNewDir
CacheDir -> BuildList -> String -> PkgM ()
installInDir CacheDir
cachedir BuildList
bl String
libNewDir
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
removePathForcibly String
libOldDir
String -> String -> IO ()
renameDirectory String
libDir String
libOldDir
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameDirectory String
libNewDir String
libDir
case Text -> String
pkgPathFilePath (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
p of
Just String
pfp | Bool
libdir_exists -> IO () -> PkgM ()
forall a. IO a -> PkgM a
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 <- String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
libOldDir String -> String -> String
</> String
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
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
libDir String -> String -> String
</> String
pfp
String -> String -> IO ()
renameDirectory (String
libOldDir String -> String -> String
</> String
pfp) (String
libDir String -> String -> String
</> String
pfp)
Maybe String
_ -> () -> PkgM ()
forall a. a -> PkgM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removePathForcibly String
libOldDir
getPkgManifest :: PkgM PkgManifest
getPkgManifest :: PkgM PkgManifest
getPkgManifest = do
Bool
file_exists <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
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
$ String -> IO Bool
doesFileExist String
futharkPkg
Bool
dir_exists <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
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
$ String -> IO Bool
doesDirectoryExist String
futharkPkg
case (Bool
file_exists, Bool
dir_exists) of
(Bool
True, Bool
_) -> IO PkgManifest -> PkgM PkgManifest
forall a. IO a -> PkgM a
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
$ String -> IO PkgManifest
parsePkgManifestFromFile String
futharkPkg
(Bool
_, Bool
True) ->
String -> PkgM PkgManifest
forall a. String -> PkgM a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> PkgM PkgManifest) -> String -> PkgM PkgManifest
forall a b. (a -> b) -> a -> b
$
String
futharkPkg
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" exists, but it is a directory! What in Odin's beard..."
(Bool, Bool)
_ -> IO PkgManifest -> PkgM PkgManifest
forall a. IO a -> PkgM a
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
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
futharkPkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found - pretending it's empty."
PkgManifest -> IO PkgManifest
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgManifest -> IO PkgManifest) -> PkgManifest -> IO PkgManifest
forall a b. (a -> b) -> a -> b
$ Maybe Text -> PkgManifest
newPkgManifest Maybe Text
forall a. Maybe a
Nothing
putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest = IO () -> PkgM ()
forall a. IO a -> PkgM a
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
. String -> Text -> IO ()
T.writeFile String
futharkPkg (Text -> IO ()) -> (PkgManifest -> Text) -> PkgManifest -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Text
prettyPkgManifest
newtype PkgConfig = PkgConfig {PkgConfig -> Bool
pkgVerbose :: Bool}
newtype PkgM a = PkgM {forall a.
PkgM a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
unPkgM :: ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a}
deriving ((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
$cfmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
fmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
$c<$ :: forall a b. a -> PkgM b -> PkgM a
<$ :: forall a b. a -> PkgM b -> PkgM a
Functor, Functor PkgM
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
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
$cpure :: forall a. a -> PkgM a
pure :: forall a. a -> PkgM a
$c<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
$cliftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
liftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
$c*> :: forall a b. PkgM a -> PkgM b -> PkgM b
*> :: forall a b. PkgM a -> PkgM b -> PkgM b
$c<* :: forall a b. PkgM a -> PkgM b -> PkgM a
<* :: forall a b. PkgM a -> PkgM b -> PkgM a
Applicative, Monad PkgM
Monad PkgM => (forall a. IO a -> PkgM a) -> MonadIO PkgM
forall a. IO a -> PkgM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> PkgM a
liftIO :: forall a. IO a -> PkgM a
MonadIO, MonadReader PkgConfig)
instance Monad PkgM where
PkgM ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m >>= :: forall a b. 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 a b.
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
instance MonadFail PkgM where
fail :: forall a. String -> PkgM a
fail String
s = IO a -> PkgM a
forall a. 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
String
prog <- IO String
getProgName
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Log -> Text
toText Log
l
runPkgM :: PkgConfig -> PkgM a -> IO a
runPkgM :: forall a. 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 :: String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain = PkgConfig
-> [FunOptDescr PkgConfig]
-> String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> 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 =
[ String
-> [String]
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
-> String
-> OptDescr (Either a (PkgConfig -> PkgConfig))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"v"
[String
"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 = True})
String
"Write running diagnostics to stderr."
]
doFmt :: String -> [String] -> IO ()
doFmt :: String -> [String] -> IO ()
doFmt = ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
-> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
case [String]
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 <- String -> IO PkgManifest
parsePkgManifestFromFile String
futharkPkg
String -> Text -> IO ()
T.writeFile String
futharkPkg (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Text
prettyPkgManifest PkgManifest
m
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
withCacheDir :: (CacheDir -> IO a) -> IO a
withCacheDir :: forall a. (CacheDir -> IO a) -> IO a
withCacheDir CacheDir -> IO a
f = String -> (String -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"futhark-pkg" ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ CacheDir -> IO a
f (CacheDir -> IO a) -> (String -> CacheDir) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CacheDir
CacheDir
doCheck :: String -> [String] -> IO ()
doCheck :: String -> [String] -> IO ()
doCheck = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"check" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ()))
-> ((CacheDir -> IO ()) -> IO ())
-> (CacheDir -> IO ())
-> Maybe (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> Maybe (IO ()))
-> (CacheDir -> IO ()) -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> 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 <- CacheDir -> PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Dependencies chosen:"
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ BuildList -> Text
prettyBuildList BuildList
bl
case Commented (Maybe Text) -> Maybe Text
forall a. Commented a -> a
commented (Commented (Maybe Text) -> Maybe Text)
-> Commented (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe Text)
manifestPkgPath PkgManifest
m of
Maybe Text
Nothing -> () -> PkgM ()
forall a. a -> PkgM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Text
p -> do
let pdir :: String
pdir = String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p
Bool
pdir_exists <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
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
$ String -> IO Bool
doesDirectoryExist String
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Problem: the directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
pdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist."
IO ()
forall a. IO a
exitFailure
Bool
anything <-
IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
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
$
(String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".fut") (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension)
([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
directoryContents (String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Problem: the directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
pdir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not contain any .fut files."
IO ()
forall a. IO a
exitFailure
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
doSync :: String -> [String] -> IO ()
doSync :: String -> [String] -> IO ()
doSync = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ()))
-> ((CacheDir -> IO ()) -> IO ())
-> (CacheDir -> IO ())
-> Maybe (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> Maybe (IO ()))
-> (CacheDir -> IO ()) -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> 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 <- CacheDir -> PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
CacheDir -> Maybe Text -> BuildList -> PkgM ()
installBuildList CacheDir
cachedir (Commented (Maybe Text) -> Maybe Text
forall a. Commented a -> a
commented (Commented (Maybe Text) -> Maybe Text)
-> Commented (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe Text)
manifestPkgPath PkgManifest
m) BuildList
bl
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
doAdd :: String -> [String] -> IO ()
doAdd :: String -> [String] -> IO ()
doAdd = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[String
p, String
v]
| Right SemVer
v' <- Text -> Either (ParseErrorBundle Text Void) SemVer
parseVersion (Text -> Either (ParseErrorBundle Text Void) SemVer)
-> Text -> Either (ParseErrorBundle Text Void) SemVer
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v ->
IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> IO ()) -> (CacheDir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir (String -> Text
T.pack String
p) SemVer
v'
[String
p] ->
IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> IO ()) -> (CacheDir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$
CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir (String -> Text
T.pack String
p) (SemVer -> PkgM ()) -> PkgM SemVer -> PkgM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CacheDir -> Text -> PkgM SemVer
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m SemVer
lookupNewestRev CacheDir
cachedir (String -> Text
T.pack String
p)
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
where
doAdd' :: CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir Text
p SemVer
v = do
PkgManifest
m <- PkgM PkgManifest
getPkgManifest
BuildList
_ <- CacheDir -> PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ Map Text (SemVer, Maybe Text) -> PkgRevDeps
PkgRevDeps (Text -> (SemVer, Maybe Text) -> Map Text (SemVer, Maybe Text)
forall k a. k -> a -> Map k a
M.singleton Text
p (SemVer
v, Maybe Text
forall a. Maybe a
Nothing)) PkgRevDeps -> PkgRevDeps -> PkgRevDeps
forall a. Semigroup a => a -> a -> a
<> PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
PkgRevInfo PkgM
p_info <- CacheDir -> Text -> SemVer -> PkgM (PkgRevInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir Text
p SemVer
v
let hash :: Maybe Text
hash = case (SemVer -> Word
_svMajor SemVer
v, SemVer -> Word
_svMinor SemVer
v, SemVer -> Word
_svPatch SemVer
v) of
(Word
0, Word
0, Word
0) -> Maybe Text
forall a. Maybe a
Nothing
(Word, Word, Word)
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PkgRevInfo PkgM -> Text
forall (m :: * -> *). PkgRevInfo m -> Text
pkgRevCommit PkgRevInfo PkgM
p_info
req :: Required
req = Text -> SemVer -> Maybe Text -> Required
Required Text
p SemVer
v Maybe Text
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Package already at version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; nothing to do."
| Bool
otherwise ->
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Replaced "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
prev_r')
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Maybe Required
Nothing ->
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Added new required package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Remember to run 'futhark pkg sync'."
doRemove :: String -> [String] -> IO ()
doRemove :: String -> [String] -> IO ()
doRemove = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[String
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
$ Text -> PkgM ()
doRemove' (Text -> PkgM ()) -> Text -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
where
doRemove' :: Text -> PkgM ()
doRemove' Text
p = do
PkgManifest
m <- PkgM PkgManifest
getPkgManifest
case Text -> PkgManifest -> Maybe (PkgManifest, Required)
removeRequiredFromManifest Text
p PkgManifest
m of
Maybe (PkgManifest, Required)
Nothing -> IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"No package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" found in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
futharkPkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
IO ()
forall a. IO a
exitFailure
Just (PkgManifest
m', Required
r) -> do
PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Removed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
r) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
doInit :: String -> [String] -> IO ()
doInit :: String -> [String] -> IO ()
doInit = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[String
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
$ Text -> PkgM ()
doCreate' (Text -> PkgM ()) -> Text -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
where
validPkgPath :: Text -> Bool
validPkgPath Text
p =
Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".", String
".."]) ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
p
doCreate' :: Text -> PkgM ()
doCreate' Text
p = do
Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
validPkgPath Text
p) (PkgM () -> PkgM ()) -> (IO () -> PkgM ()) -> IO () -> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Not a valid package path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
Text -> IO ()
T.putStrLn Text
"Note: package paths are usually URIs."
Text -> IO ()
T.putStrLn Text
"Note: 'futhark init' is only needed when creating a package, not to use packages."
IO ()
forall a. IO a
exitFailure
Bool
exists <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
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
<$> String -> IO Bool
doesFileExist String
futharkPkg IO (Bool -> Bool) -> IO Bool -> IO Bool
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
doesDirectoryExist String
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 a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
futharkPkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" already exists."
IO ()
forall a. IO a
exitFailure
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Created directory " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
PkgManifest -> PkgM ()
putPkgManifest (PkgManifest -> PkgM ()) -> PkgManifest -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> PkgManifest
newPkgManifest (Maybe Text -> PkgManifest) -> Maybe Text -> PkgManifest
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p
IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Wrote " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
futharkPkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
doUpgrade :: String -> [String] -> IO ()
doUpgrade :: String -> [String] -> IO ()
doUpgrade = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ()))
-> ((CacheDir -> IO ()) -> IO ())
-> (CacheDir -> IO ())
-> Maybe (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> Maybe (IO ()))
-> (CacheDir -> IO ()) -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> 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 Text Required]
rs <- ([Either Text Required] -> PkgM [Either Text Required])
-> Commented [Either Text Required]
-> PkgM (Commented [Either Text Required])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Commented a -> f (Commented b)
traverse ((Either Text Required -> PkgM (Either Text Required))
-> [Either Text Required] -> PkgM [Either Text Required]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Required -> PkgM Required)
-> Either Text Required -> PkgM (Either Text Required)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either Text a -> f (Either Text b)
traverse (CacheDir -> Required -> PkgM Required
forall {m :: * -> *}.
MonadPkgRegistry m =>
CacheDir -> Required -> m Required
upgrade CacheDir
cachedir))) (Commented [Either Text Required]
-> PkgM (Commented [Either Text Required]))
-> Commented [Either Text Required]
-> PkgM (Commented [Either Text Required])
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
m
PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m {manifestRequire = rs}
if Commented [Either Text Required]
rs Commented [Either Text Required]
-> Commented [Either Text Required] -> Bool
forall a. Eq a => a -> a -> Bool
== PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
m
then IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Nothing to upgrade."
else IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Remember to run 'futhark pkg sync'."
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
where
upgrade :: CacheDir -> Required -> m Required
upgrade CacheDir
cachedir Required
req = do
SemVer
v <- CacheDir -> Text -> m SemVer
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m SemVer
lookupNewestRev CacheDir
cachedir (Text -> m SemVer) -> Text -> m SemVer
forall a b. (a -> b) -> a -> b
$ Required -> Text
requiredPkg Required
req
Text
h <- PkgRevInfo m -> Text
forall (m :: * -> *). PkgRevInfo m -> Text
pkgRevCommit (PkgRevInfo m -> Text) -> m (PkgRevInfo m) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir (Required -> Text
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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
"Upgraded "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Required -> Text
requiredPkg Required
req
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
req)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Required -> m Required
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Required
req
{ requiredPkgRev = v,
requiredHash = Just h
}
doVersions :: String -> [String] -> IO ()
doVersions :: String -> [String] -> IO ()
doVersions = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" (([String] -> PkgConfig -> Maybe (IO ()))
-> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[String
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> IO ()) -> (CacheDir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ CacheDir -> Text -> PkgM ()
forall {m :: * -> *}.
MonadPkgRegistry m =>
CacheDir -> Text -> m ()
doVersions' CacheDir
cachedir (Text -> PkgM ()) -> Text -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
[String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
where
doVersions' :: CacheDir -> Text -> m ()
doVersions' CacheDir
cachedir =
(SemVer -> m ()) -> [SemVer] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SemVer -> IO ()) -> SemVer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStrLn (Text -> IO ()) -> (SemVer -> Text) -> SemVer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> Text
prettySemVer) ([SemVer] -> m ()) -> (PkgInfo m -> [SemVer]) -> PkgInfo m -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SemVer (PkgRevInfo m) -> [SemVer]
forall k a. Map k a -> [k]
M.keys (Map SemVer (PkgRevInfo m) -> [SemVer])
-> (PkgInfo m -> Map SemVer (PkgRevInfo m))
-> PkgInfo m
-> [SemVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo m -> Map SemVer (PkgRevInfo m)
forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions
(PkgInfo m -> m ()) -> (Text -> m (PkgInfo m)) -> Text -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CacheDir -> Text -> m (PkgInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main String
prog [String]
args = do
IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
"GIT_TERMINAL_PROMPT" String
"0"
let commands :: [(String, (String -> [String] -> IO (), Text))]
commands =
[ ( String
"add",
(String -> [String] -> IO ()
doAdd, Text
"Add another required package to futhark.pkg.")
),
( String
"check",
(String -> [String] -> IO ()
doCheck, Text
"Check that futhark.pkg is satisfiable.")
),
( String
"init",
(String -> [String] -> IO ()
doInit, Text
"Create a new futhark.pkg and a lib/ skeleton.")
),
( String
"fmt",
(String -> [String] -> IO ()
doFmt, Text
"Reformat futhark.pkg.")
),
( String
"sync",
(String -> [String] -> IO ()
doSync, Text
"Populate lib/ as specified by futhark.pkg.")
),
( String
"remove",
(String -> [String] -> IO ()
doRemove, Text
"Remove a required package from futhark.pkg.")
),
( String
"upgrade",
(String -> [String] -> IO ()
doUpgrade, Text
"Upgrade all packages to newest versions.")
),
( String
"versions",
(String -> [String] -> IO ()
doVersions, Text
"List available versions for a package.")
)
]
usage :: String
usage = String
"options... <" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (((String, (String -> [String] -> IO (), Text)) -> String)
-> [(String, (String -> [String] -> IO (), Text))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (String -> [String] -> IO (), Text)) -> String
forall a b. (a, b) -> a
fst [(String, (String -> [String] -> IO (), Text))]
commands) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
case [String]
args of
String
cmd : [String]
args'
| Just (String -> [String] -> IO ()
m, Text
_) <- String
-> [(String, (String -> [String] -> IO (), Text))]
-> Maybe (String -> [String] -> IO (), Text)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
cmd [(String, (String -> [String] -> IO (), Text))]
commands ->
String -> [String] -> IO ()
m ([String] -> String
unwords [String
prog, String
cmd]) [String]
args'
[String]
_ -> 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 (((String, (String -> [String] -> IO (), Text)) -> Int)
-> [(String, (String -> [String] -> IO (), Text))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, (String -> [String] -> IO (), Text)) -> String)
-> (String, (String -> [String] -> IO (), Text))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String -> [String] -> IO (), Text)) -> String
forall a b. (a, b) -> a
fst) [(String, (String -> [String] -> IO (), Text))]
commands) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
Text -> IO b
forall {b}. Text -> IO b
usageMsg (Text -> IO b) -> ([Text] -> Text) -> [Text] -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> IO b) -> [Text] -> IO b
forall a b. (a -> b) -> a -> b
$
[Text
"<command> ...:", Text
"", Text
"Commands:"]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) Char
' ') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc
| (String
cmd, (String -> [String] -> IO ()
_, Text
desc)) <- [(String, (String -> [String] -> IO (), Text))]
commands
]
()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
usage [String] -> () -> Maybe (IO ())
forall {p} {b}. p -> () -> Maybe (IO b)
bad String
prog [String]
args
where
usageMsg :: Text -> IO b
usageMsg Text
s = do
Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Usage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
prog Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [--version] [--help] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
IO b
forall a. IO a
exitFailure