-- | Obtaining information about packages over THE INTERNET!
module Futhark.Pkg.Info
  ( -- * Package info
    PkgInfo (..),
    lookupPkgRev,
    pkgInfo,
    PkgRevInfo (..),
    GetManifest (getManifest),
    GetFiles (getFiles),
    CacheDir (..),

    -- * Package registry
    PkgRegistry,
    MonadPkgRegistry (..),
    lookupPackage,
    lookupPackageRev,
    lookupNewestRev,
  )
where

import Control.Monad (unless, void)
import Control.Monad.IO.Class
import Data.ByteString qualified as BS
import Data.IORef
import Data.List qualified as L
import Data.Map qualified as M
import Data.Maybe
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.IO qualified as T
import Data.Time (UTCTime, defaultTimeLocale, formatTime)
import Data.Time.Format.ISO8601 (iso8601ParseM)
import Data.Time.LocalTime (zonedTimeToUTC)
import Futhark.Pkg.Types
import Futhark.Util (directoryContents, showText, zEncodeText)
import Futhark.Util.Log
import System.Directory (doesDirectoryExist)
import System.Exit
import System.FilePath (makeRelative, (</>))
import System.Process.ByteString (readProcessWithExitCode)

-- | The manifest is stored as a monadic action, because we want to
-- fetch them on-demand.  It would be a waste to fetch it information
-- for every version of every package if we only actually need a small
-- subset of them.
newtype GetManifest m = GetManifest {forall (m :: * -> *). GetManifest m -> m PkgManifest
getManifest :: m PkgManifest}

instance Show (GetManifest m) where
  show :: GetManifest m -> String
show GetManifest m
_ = String
"#<GetManifest>"

instance Eq (GetManifest m) where
  GetManifest m
_ == :: GetManifest m -> GetManifest m -> Bool
== GetManifest m
_ = Bool
True

-- | Get the absolute path to a package directory on disk, as well as
-- /relative/ paths to files that should be installed from this
-- package.  Composing the package directory and one of these paths
-- refers to a local file (pointing into the cache) and is valid at
-- least until the next cache operation.
newtype GetFiles m = GetFiles {forall (m :: * -> *). GetFiles m -> m (String, [String])
getFiles :: m (FilePath, [FilePath])}

instance Show (GetFiles m) where
  show :: GetFiles m -> String
show GetFiles m
_ = String
"#<GetFiles>"

instance Eq (GetFiles m) where
  GetFiles m
_ == :: GetFiles m -> GetFiles m -> Bool
== GetFiles m
_ = Bool
True

-- | Information about a version of a single package.  The version
-- number is stored separately.
data PkgRevInfo m = PkgRevInfo
  { forall (m :: * -> *). PkgRevInfo m -> GetFiles m
pkgGetFiles :: GetFiles m,
    -- | The commit ID can be used for verification ("freezing"), by
    -- storing what it was at the time this version was last selected.
    forall (m :: * -> *). PkgRevInfo m -> Text
pkgRevCommit :: T.Text,
    forall (m :: * -> *). PkgRevInfo m -> GetManifest m
pkgRevGetManifest :: GetManifest m,
    -- | Timestamp for when the revision was made (rarely used).
    forall (m :: * -> *). PkgRevInfo m -> UTCTime
pkgRevTime :: UTCTime
  }
  deriving (PkgRevInfo m -> PkgRevInfo m -> Bool
(PkgRevInfo m -> PkgRevInfo m -> Bool)
-> (PkgRevInfo m -> PkgRevInfo m -> Bool) -> Eq (PkgRevInfo m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). PkgRevInfo m -> PkgRevInfo m -> Bool
$c== :: forall (m :: * -> *). PkgRevInfo m -> PkgRevInfo m -> Bool
== :: PkgRevInfo m -> PkgRevInfo m -> Bool
$c/= :: forall (m :: * -> *). PkgRevInfo m -> PkgRevInfo m -> Bool
/= :: PkgRevInfo m -> PkgRevInfo m -> Bool
Eq, Int -> PkgRevInfo m -> ShowS
[PkgRevInfo m] -> ShowS
PkgRevInfo m -> String
(Int -> PkgRevInfo m -> ShowS)
-> (PkgRevInfo m -> String)
-> ([PkgRevInfo m] -> ShowS)
-> Show (PkgRevInfo m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *). Int -> PkgRevInfo m -> ShowS
forall (m :: * -> *). [PkgRevInfo m] -> ShowS
forall (m :: * -> *). PkgRevInfo m -> String
$cshowsPrec :: forall (m :: * -> *). Int -> PkgRevInfo m -> ShowS
showsPrec :: Int -> PkgRevInfo m -> ShowS
$cshow :: forall (m :: * -> *). PkgRevInfo m -> String
show :: PkgRevInfo m -> String
$cshowList :: forall (m :: * -> *). [PkgRevInfo m] -> ShowS
showList :: [PkgRevInfo m] -> ShowS
Show)

-- | Create memoisation around a 'GetManifest' action to ensure that
-- multiple inspections of the same revisions will not result in
-- potentially expensive IO operations.
memoiseGetManifest :: (MonadIO m) => GetManifest m -> m (GetManifest m)
memoiseGetManifest :: forall (m :: * -> *).
MonadIO m =>
GetManifest m -> m (GetManifest m)
memoiseGetManifest (GetManifest m PkgManifest
m) = do
  IORef (Maybe PkgManifest)
ref <- IO (IORef (Maybe PkgManifest)) -> m (IORef (Maybe PkgManifest))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe PkgManifest)) -> m (IORef (Maybe PkgManifest)))
-> IO (IORef (Maybe PkgManifest)) -> m (IORef (Maybe PkgManifest))
forall a b. (a -> b) -> a -> b
$ Maybe PkgManifest -> IO (IORef (Maybe PkgManifest))
forall a. a -> IO (IORef a)
newIORef Maybe PkgManifest
forall a. Maybe a
Nothing
  GetManifest m -> m (GetManifest m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetManifest m -> m (GetManifest m))
-> GetManifest m -> m (GetManifest m)
forall a b. (a -> b) -> a -> b
$
    m PkgManifest -> GetManifest m
forall (m :: * -> *). m PkgManifest -> GetManifest m
GetManifest (m PkgManifest -> GetManifest m) -> m PkgManifest -> GetManifest m
forall a b. (a -> b) -> a -> b
$ do
      Maybe PkgManifest
v <- IO (Maybe PkgManifest) -> m (Maybe PkgManifest)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PkgManifest) -> m (Maybe PkgManifest))
-> IO (Maybe PkgManifest) -> m (Maybe PkgManifest)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe PkgManifest) -> IO (Maybe PkgManifest)
forall a. IORef a -> IO a
readIORef IORef (Maybe PkgManifest)
ref
      case Maybe PkgManifest
v of
        Just PkgManifest
v' -> PkgManifest -> m PkgManifest
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgManifest
v'
        Maybe PkgManifest
Nothing -> do
          PkgManifest
v' <- m PkgManifest
m
          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
$ IORef (Maybe PkgManifest) -> Maybe PkgManifest -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe PkgManifest)
ref (Maybe PkgManifest -> IO ()) -> Maybe PkgManifest -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Maybe PkgManifest
forall a. a -> Maybe a
Just PkgManifest
v'
          PkgManifest -> m PkgManifest
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgManifest
v'

-- | Information about a package.  The name of the package is stored
-- separately.
data PkgInfo m = PkgInfo
  { forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions :: M.Map SemVer (PkgRevInfo m),
    -- | Look up information about a specific
    -- commit, or HEAD in case of Nothing.
    forall (m :: * -> *). PkgInfo m -> Maybe Text -> m (PkgRevInfo m)
pkgLookupCommit :: Maybe T.Text -> m (PkgRevInfo m)
  }

-- | Lookup information about a given version of a package.
lookupPkgRev :: SemVer -> PkgInfo m -> Maybe (PkgRevInfo m)
lookupPkgRev :: forall (m :: * -> *). SemVer -> PkgInfo m -> Maybe (PkgRevInfo m)
lookupPkgRev SemVer
v = SemVer -> Map SemVer (PkgRevInfo m) -> Maybe (PkgRevInfo m)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SemVer
v (Map SemVer (PkgRevInfo m) -> Maybe (PkgRevInfo m))
-> (PkgInfo m -> Map SemVer (PkgRevInfo m))
-> PkgInfo m
-> Maybe (PkgRevInfo m)
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

majorRevOfPkg :: PkgPath -> (T.Text, [Word])
majorRevOfPkg :: Text -> (Text, [Word])
majorRevOfPkg Text
p =
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"@" Text
p of
    [Text
p', Text
v] | [(Word
v', String
"")] <- ReadS Word
forall a. Read a => ReadS a
reads ReadS Word -> ReadS Word
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
v -> (Text
p', [Word
v'])
    [Text]
_ -> (Text
p, [Word
0, Word
1])

gitCmd :: (MonadIO m, MonadLogger m, MonadFail m) => [String] -> m BS.ByteString
gitCmd :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ByteString
gitCmd [String]
opts = do
  Text -> m ()
forall a. ToLog a => a -> m ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Running command: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (Text
"git" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
opts)
  (ExitCode
code, ByteString
out, ByteString
err) <- IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString, ByteString)
 -> m (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode String
"git" [String]
opts ByteString
forall a. Monoid a => a
mempty
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
err ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall a. ToLog a => a -> m ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
err
  case ExitCode
code of
    ExitFailure Int
127 -> String -> m ByteString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords (String
"git" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
opts) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' failed (program not found?)."
    ExitFailure Int
_ -> String -> m ByteString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords (String
"git" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
opts) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"' failed."
    ExitCode
ExitSuccess -> ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
out

gitCmd_ :: (MonadIO m, MonadLogger m, MonadFail m) => [String] -> m ()
gitCmd_ :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ()
gitCmd_ = m ByteString -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ByteString -> m ())
-> ([String] -> m ByteString) -> [String] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> m ByteString
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ByteString
gitCmd

gitCmdLines :: (MonadIO m, MonadLogger m, MonadFail m) => [String] -> m [T.Text]
gitCmdLines :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m [Text]
gitCmdLines = (ByteString -> [Text]) -> m ByteString -> m [Text]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Text]
T.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8) (m ByteString -> m [Text])
-> ([String] -> m ByteString) -> [String] -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> m ByteString
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ByteString
gitCmd

-- | A temporary directory in which we store Git checkouts while
-- running.  This is to avoid constantly re-cloning.  Will be deleted
-- when @futhark pkg@ terminates.  In principle we could keep this
-- around for longer, but then we would have to 'git pull' now and
-- then also.  Note that the cache is stateful - we are going to use
-- @git checkout@ to move around the history.  It is generally not
-- safe to have multiple operations running concurrently.
newtype CacheDir = CacheDir FilePath

ensureGit ::
  (MonadIO m, MonadLogger m, MonadFail m) =>
  CacheDir ->
  T.Text ->
  m FilePath
ensureGit :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
CacheDir -> Text -> m String
ensureGit (CacheDir String
cachedir) Text
url = do
  Bool
exists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
gitdir
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    [String] -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ()
gitCmd_ [String
"-C", String
cachedir, String
"clone", String
"https://" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
url, String
url']
  String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
gitdir
  where
    url' :: String
url' = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
zEncodeText Text
url
    gitdir :: String
gitdir = String
cachedir String -> ShowS
</> String
url'

-- A git reference (tag, commit, HEAD, etc).
type Ref = String

versionRef :: SemVer -> Ref
versionRef :: SemVer -> String
versionRef SemVer
v = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v

revInfo ::
  (MonadIO m, MonadLogger m, MonadFail m) =>
  FilePath ->
  PkgPath ->
  Ref ->
  m (PkgRevInfo m)
revInfo :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
String -> Text -> String -> m (PkgRevInfo m)
revInfo String
gitdir Text
path String
ref = do
  [String] -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ()
gitCmd_ [String
"-C", String
gitdir, String
"rev-parse", String
ref, String
"--"]
  [Text
sha] <- [String] -> m [Text]
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m [Text]
gitCmdLines [String
"-C", String
gitdir, String
"rev-list", String
"-n1", String
ref]
  [Text
time] <- [String] -> m [Text]
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m [Text]
gitCmdLines [String
"-C", String
gitdir, String
"show", String
"-s", String
"--format=%cI", String
ref]
  UTCTime
utc <-
    -- Git sometimes produces timestamps with Z time zone, which are
    -- not valid ZonedTimes.
    if Char
'Z' Char -> Text -> Bool
`T.elem` Text
time
      then String -> m UTCTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (Text -> String
T.unpack Text
time)
      else ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> m ZonedTime -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m ZonedTime
forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM (Text -> String
T.unpack Text
time)
  GetManifest m
gm <- GetManifest m -> m (GetManifest m)
forall (m :: * -> *).
MonadIO m =>
GetManifest m -> m (GetManifest m)
memoiseGetManifest GetManifest m
getManifest'
  PkgRevInfo m -> m (PkgRevInfo m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgRevInfo m -> m (PkgRevInfo m))
-> PkgRevInfo m -> m (PkgRevInfo m)
forall a b. (a -> b) -> a -> b
$
    PkgRevInfo
      { pkgGetFiles :: GetFiles m
pkgGetFiles = GetManifest m -> GetFiles m
getFiles GetManifest m
gm,
        pkgRevCommit :: Text
pkgRevCommit = Text
sha,
        pkgRevGetManifest :: GetManifest m
pkgRevGetManifest = GetManifest m
gm,
        pkgRevTime :: UTCTime
pkgRevTime = UTCTime
utc
      }
  where
    noPkgDir :: String -> m a
noPkgDir String
pdir =
      String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
        Text -> String
T.unpack Text
path
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ref
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not contain a directory "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
pdir

    noPkgPath :: m a
noPkgPath =
      String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
        String
"futhark.pkg for "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
path
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-"
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ref
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not define a package path."

    getFiles :: GetManifest m -> GetFiles m
getFiles GetManifest m
gm = m (String, [String]) -> GetFiles m
forall (m :: * -> *). m (String, [String]) -> GetFiles m
GetFiles (m (String, [String]) -> GetFiles m)
-> m (String, [String]) -> GetFiles m
forall a b. (a -> b) -> a -> b
$ do
      [String] -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ()
gitCmd_ [String
"-C", String
gitdir, String
"checkout", String
ref, String
"--"]
      String
pdir <- m String -> (String -> m String) -> Maybe String -> m String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m String
forall {a}. m a
noPkgPath String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> m String)
-> (PkgManifest -> Maybe String) -> PkgManifest -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Maybe String
pkgDir (PkgManifest -> m String) -> m PkgManifest -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GetManifest m -> m PkgManifest
forall (m :: * -> *). GetManifest m -> m PkgManifest
getManifest GetManifest m
gm
      let pdir_abs :: String
pdir_abs = String
gitdir String -> ShowS
</> String
pdir
      Bool
exists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
pdir_abs
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall {m :: * -> *} {a}. MonadFail m => String -> m a
noPkgDir String
pdir
      [String]
fs <- IO [String] -> m [String]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
directoryContents String
pdir_abs
      (String, [String]) -> m (String, [String])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
pdir_abs, ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
makeRelative String
pdir_abs) [String]
fs)

    getManifest' :: GetManifest m
getManifest' = m PkgManifest -> GetManifest m
forall (m :: * -> *). m PkgManifest -> GetManifest m
GetManifest (m PkgManifest -> GetManifest m) -> m PkgManifest -> GetManifest m
forall a b. (a -> b) -> a -> b
$ do
      [String] -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m ()
gitCmd_ [String
"-C", String
gitdir, String
"checkout", String
ref, String
"--"]
      let f :: String
f = String
gitdir String -> ShowS
</> String
futharkPkg
      Text
s <- IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
f
      let msg :: String
msg =
            String
"When reading package manifest for "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
path
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ref
              String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":\n"
      case String -> Text -> Either (ParseErrorBundle Text Void) PkgManifest
parsePkgManifest String
f Text
s of
        Left ParseErrorBundle Text Void
e -> String -> m PkgManifest
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m PkgManifest) -> String -> m PkgManifest
forall a b. (a -> b) -> a -> b
$ String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
e
        Right PkgManifest
pm -> PkgManifest -> m PkgManifest
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgManifest
pm

-- | Retrieve information about a package based on its package path.
-- This uses Semantic Import Versioning when interacting with
-- repositories.  For example, a package @github.com/user/repo@ will
-- match version 0.* or 1.* tags only, a package
-- @github.com/user/repo/v2@ will match 2.* tags, and so forth..
pkgInfo ::
  (MonadIO m, MonadLogger m, MonadFail m) =>
  CacheDir ->
  PkgPath ->
  m (PkgInfo m)
pkgInfo :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
CacheDir -> Text -> m (PkgInfo m)
pkgInfo CacheDir
cachedir Text
path = do
  String
gitdir <- CacheDir -> Text -> m String
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
CacheDir -> Text -> m String
ensureGit CacheDir
cachedir Text
url
  [SemVer]
versions <- (Text -> Maybe SemVer) -> [Text] -> [SemVer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe SemVer
isVersionRef ([Text] -> [SemVer]) -> m [Text] -> m [SemVer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> m [Text]
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
[String] -> m [Text]
gitCmdLines [String
"-C", String
gitdir, String
"tag"]
  Map SemVer (PkgRevInfo m)
versions' <-
    [(SemVer, PkgRevInfo m)] -> Map SemVer (PkgRevInfo m)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SemVer, PkgRevInfo m)] -> Map SemVer (PkgRevInfo m))
-> ([PkgRevInfo m] -> [(SemVer, PkgRevInfo m)])
-> [PkgRevInfo m]
-> Map SemVer (PkgRevInfo m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SemVer] -> [PkgRevInfo m] -> [(SemVer, PkgRevInfo m)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SemVer]
versions
      ([PkgRevInfo m] -> Map SemVer (PkgRevInfo m))
-> m [PkgRevInfo m] -> m (Map SemVer (PkgRevInfo m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SemVer -> m (PkgRevInfo m)) -> [SemVer] -> m [PkgRevInfo m]
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 (String -> Text -> String -> m (PkgRevInfo m)
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
String -> Text -> String -> m (PkgRevInfo m)
revInfo String
gitdir Text
path (String -> m (PkgRevInfo m))
-> (SemVer -> String) -> SemVer -> m (PkgRevInfo m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> String
versionRef) [SemVer]
versions
  PkgInfo m -> m (PkgInfo m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PkgInfo m -> m (PkgInfo m)) -> PkgInfo m -> m (PkgInfo m)
forall a b. (a -> b) -> a -> b
$ Map SemVer (PkgRevInfo m)
-> (Maybe Text -> m (PkgRevInfo m)) -> PkgInfo m
forall (m :: * -> *).
Map SemVer (PkgRevInfo m)
-> (Maybe Text -> m (PkgRevInfo m)) -> PkgInfo m
PkgInfo Map SemVer (PkgRevInfo m)
versions' ((Maybe Text -> m (PkgRevInfo m)) -> PkgInfo m)
-> (Maybe Text -> m (PkgRevInfo m)) -> PkgInfo m
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> m (PkgRevInfo m)
forall {m :: * -> *}.
(MonadIO m, MonadLogger m, MonadFail m) =>
String -> Maybe Text -> m (PkgRevInfo m)
lookupCommit String
gitdir
  where
    (Text
url, [Word]
path_versions) = Text -> (Text, [Word])
majorRevOfPkg Text
path
    isVersionRef :: Text -> Maybe SemVer
isVersionRef Text
l
      | Text
"v" Text -> Text -> Bool
`T.isPrefixOf` Text
l,
        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
$ Int -> Text -> Text
T.drop Int
1 Text
l,
        SemVer -> Word
_svMajor SemVer
v Word -> [Word] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word]
path_versions =
          SemVer -> Maybe SemVer
forall a. a -> Maybe a
Just SemVer
v
      | Bool
otherwise = Maybe SemVer
forall a. Maybe a
Nothing

    lookupCommit :: String -> Maybe Text -> m (PkgRevInfo m)
lookupCommit String
gitdir = String -> Text -> String -> m (PkgRevInfo m)
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
String -> Text -> String -> m (PkgRevInfo m)
revInfo String
gitdir Text
path (String -> m (PkgRevInfo m))
-> (Maybe Text -> String) -> Maybe Text -> m (PkgRevInfo m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"HEAD" Text -> String
T.unpack

-- | A package registry is a mapping from package paths to information
-- about the package.  It is unlikely that any given registry is
-- global; rather small registries are constructed on-demand based on
-- the package paths referenced by the user, and may also be combined
-- monoidically.  In essence, the PkgRegistry is just a cache.
newtype PkgRegistry m = PkgRegistry (M.Map PkgPath (PkgInfo m))

instance Semigroup (PkgRegistry m) where
  PkgRegistry Map Text (PkgInfo m)
x <> :: PkgRegistry m -> PkgRegistry m -> PkgRegistry m
<> PkgRegistry Map Text (PkgInfo m)
y = Map Text (PkgInfo m) -> PkgRegistry m
forall (m :: * -> *). Map Text (PkgInfo m) -> PkgRegistry m
PkgRegistry (Map Text (PkgInfo m) -> PkgRegistry m)
-> Map Text (PkgInfo m) -> PkgRegistry m
forall a b. (a -> b) -> a -> b
$ Map Text (PkgInfo m)
x Map Text (PkgInfo m)
-> Map Text (PkgInfo m) -> Map Text (PkgInfo m)
forall a. Semigroup a => a -> a -> a
<> Map Text (PkgInfo m)
y

instance Monoid (PkgRegistry m) where
  mempty :: PkgRegistry m
mempty = Map Text (PkgInfo m) -> PkgRegistry m
forall (m :: * -> *). Map Text (PkgInfo m) -> PkgRegistry m
PkgRegistry Map Text (PkgInfo m)
forall a. Monoid a => a
mempty

lookupKnownPackage :: PkgPath -> PkgRegistry m -> Maybe (PkgInfo m)
lookupKnownPackage :: forall (m :: * -> *). Text -> PkgRegistry m -> Maybe (PkgInfo m)
lookupKnownPackage Text
p (PkgRegistry Map Text (PkgInfo m)
m) = Text -> Map Text (PkgInfo m) -> Maybe (PkgInfo m)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
p Map Text (PkgInfo m)
m

-- | Monads that support a stateful package registry.  These are also
-- required to be instances of 'MonadIO' because most package registry
-- operations involve network operations.
class (MonadIO m, MonadLogger m, MonadFail m) => MonadPkgRegistry m where
  getPkgRegistry :: m (PkgRegistry m)
  putPkgRegistry :: PkgRegistry m -> m ()
  modifyPkgRegistry :: (PkgRegistry m -> PkgRegistry m) -> m ()
  modifyPkgRegistry PkgRegistry m -> PkgRegistry m
f = PkgRegistry m -> m ()
forall (m :: * -> *). MonadPkgRegistry m => PkgRegistry m -> m ()
putPkgRegistry (PkgRegistry m -> m ())
-> (PkgRegistry m -> PkgRegistry m) -> PkgRegistry m -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgRegistry m -> PkgRegistry m
f (PkgRegistry m -> m ()) -> m (PkgRegistry m) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (PkgRegistry m)
forall (m :: * -> *). MonadPkgRegistry m => m (PkgRegistry m)
getPkgRegistry

-- | Given a package path, look up information about that package.
lookupPackage ::
  (MonadPkgRegistry m) =>
  CacheDir ->
  PkgPath ->
  m (PkgInfo m)
lookupPackage :: forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir Text
p = do
  r :: PkgRegistry m
r@(PkgRegistry Map Text (PkgInfo m)
m) <- m (PkgRegistry m)
forall (m :: * -> *). MonadPkgRegistry m => m (PkgRegistry m)
getPkgRegistry
  case Text -> PkgRegistry m -> Maybe (PkgInfo m)
forall (m :: * -> *). Text -> PkgRegistry m -> Maybe (PkgInfo m)
lookupKnownPackage Text
p PkgRegistry m
r of
    Just PkgInfo m
info ->
      PkgInfo m -> m (PkgInfo m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgInfo m
info
    Maybe (PkgInfo m)
Nothing -> do
      PkgInfo m
pinfo <- CacheDir -> Text -> m (PkgInfo m)
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadFail m) =>
CacheDir -> Text -> m (PkgInfo m)
pkgInfo CacheDir
cachedir Text
p
      PkgRegistry m -> m ()
forall (m :: * -> *). MonadPkgRegistry m => PkgRegistry m -> m ()
putPkgRegistry (PkgRegistry m -> m ()) -> PkgRegistry m -> m ()
forall a b. (a -> b) -> a -> b
$ Map Text (PkgInfo m) -> PkgRegistry m
forall (m :: * -> *). Map Text (PkgInfo m) -> PkgRegistry m
PkgRegistry (Map Text (PkgInfo m) -> PkgRegistry m)
-> Map Text (PkgInfo m) -> PkgRegistry m
forall a b. (a -> b) -> a -> b
$ Text -> PkgInfo m -> Map Text (PkgInfo m) -> Map Text (PkgInfo m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
p PkgInfo m
pinfo Map Text (PkgInfo m)
m
      PkgInfo m -> m (PkgInfo m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgInfo m
pinfo

lookupPackageCommit ::
  (MonadPkgRegistry m) =>
  CacheDir ->
  PkgPath ->
  Maybe T.Text ->
  m (SemVer, PkgRevInfo m)
lookupPackageCommit :: forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> Maybe Text -> m (SemVer, PkgRevInfo m)
lookupPackageCommit CacheDir
cachedir Text
p Maybe Text
ref = do
  PkgInfo m
pinfo <- CacheDir -> Text -> m (PkgInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir Text
p
  PkgRevInfo m
rev_info <- PkgInfo m -> Maybe Text -> m (PkgRevInfo m)
forall (m :: * -> *). PkgInfo m -> Maybe Text -> m (PkgRevInfo m)
pkgLookupCommit PkgInfo m
pinfo Maybe Text
ref
  let timestamp :: Text
timestamp =
        String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
          TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d%H%M%S" (UTCTime -> String) -> UTCTime -> String
forall a b. (a -> b) -> a -> b
$
            PkgRevInfo m -> UTCTime
forall (m :: * -> *). PkgRevInfo m -> UTCTime
pkgRevTime PkgRevInfo m
rev_info
      v :: SemVer
v = Text -> Text -> SemVer
commitVersion Text
timestamp (Text -> SemVer) -> Text -> SemVer
forall a b. (a -> b) -> a -> b
$ PkgRevInfo m -> Text
forall (m :: * -> *). PkgRevInfo m -> Text
pkgRevCommit PkgRevInfo m
rev_info
      pinfo' :: PkgInfo m
pinfo' = PkgInfo m
pinfo {pkgVersions = M.insert v rev_info $ pkgVersions pinfo}
  (PkgRegistry m -> PkgRegistry m) -> m ()
forall (m :: * -> *).
MonadPkgRegistry m =>
(PkgRegistry m -> PkgRegistry m) -> m ()
modifyPkgRegistry ((PkgRegistry m -> PkgRegistry m) -> m ())
-> (PkgRegistry m -> PkgRegistry m) -> m ()
forall a b. (a -> b) -> a -> b
$ \(PkgRegistry Map Text (PkgInfo m)
m) ->
    Map Text (PkgInfo m) -> PkgRegistry m
forall (m :: * -> *). Map Text (PkgInfo m) -> PkgRegistry m
PkgRegistry (Map Text (PkgInfo m) -> PkgRegistry m)
-> Map Text (PkgInfo m) -> PkgRegistry m
forall a b. (a -> b) -> a -> b
$ Text -> PkgInfo m -> Map Text (PkgInfo m) -> Map Text (PkgInfo m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
p PkgInfo m
pinfo' Map Text (PkgInfo m)
m
  (SemVer, PkgRevInfo m) -> m (SemVer, PkgRevInfo m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SemVer
v, PkgRevInfo m
rev_info)

-- | Look up information about a specific version of a package.
lookupPackageRev ::
  (MonadPkgRegistry m) =>
  CacheDir ->
  PkgPath ->
  SemVer ->
  m (PkgRevInfo m)
lookupPackageRev :: forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir Text
p SemVer
v
  | Just Text
commit <- SemVer -> Maybe Text
isCommitVersion SemVer
v =
      (SemVer, PkgRevInfo m) -> PkgRevInfo m
forall a b. (a, b) -> b
snd ((SemVer, PkgRevInfo m) -> PkgRevInfo m)
-> m (SemVer, PkgRevInfo m) -> m (PkgRevInfo m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheDir -> Text -> Maybe Text -> m (SemVer, PkgRevInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> Maybe Text -> m (SemVer, PkgRevInfo m)
lookupPackageCommit CacheDir
cachedir Text
p (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
commit)
  | Bool
otherwise = do
      PkgInfo m
pinfo <- CacheDir -> Text -> m (PkgInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir Text
p
      case SemVer -> PkgInfo m -> Maybe (PkgRevInfo m)
forall (m :: * -> *). SemVer -> PkgInfo m -> Maybe (PkgRevInfo m)
lookupPkgRev SemVer
v PkgInfo m
pinfo of
        Maybe (PkgRevInfo m)
Nothing ->
          let versions :: Text
versions = case Map SemVer (PkgRevInfo m) -> [SemVer]
forall k a. Map k a -> [k]
M.keys (Map SemVer (PkgRevInfo m) -> [SemVer])
-> Map SemVer (PkgRevInfo m) -> [SemVer]
forall a b. (a -> b) -> a -> b
$ PkgInfo m -> Map SemVer (PkgRevInfo m)
forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions PkgInfo m
pinfo of
                [] -> Text
"Package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no versions.  Invalid package path?"
                [SemVer]
ks ->
                  Text
"Known versions: "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
L.intersperse Text
", " ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (SemVer -> Text) -> [SemVer] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SemVer -> Text
prettySemVer [SemVer]
ks)
              major :: Text
major
                | (Text
_, [Word]
vs) <- Text -> (Text, [Word])
majorRevOfPkg Text
p,
                  SemVer -> Word
_svMajor SemVer
v Word -> [Word] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Word]
vs =
                    Text
"\nFor major version "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word -> Text
forall a. Show a => a -> Text
showText (SemVer -> Word
_svMajor SemVer
v)
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", use package path "
                      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
<> Word -> Text
forall a. Show a => a -> Text
showText (SemVer -> Word
_svMajor SemVer
v)
                | Bool
otherwise = Text
forall a. Monoid a => a
mempty
           in String -> m (PkgRevInfo m)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (PkgRevInfo m)) -> String -> m (PkgRevInfo m)
forall a b. (a -> b) -> a -> b
$
                Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
                  Text
"package "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not have a 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
".\n"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
versions
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
major
        Just PkgRevInfo m
v' -> PkgRevInfo m -> m (PkgRevInfo m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PkgRevInfo m
v'

-- | Find the newest version of a package.
lookupNewestRev ::
  (MonadPkgRegistry m) =>
  CacheDir ->
  PkgPath ->
  m SemVer
lookupNewestRev :: forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m SemVer
lookupNewestRev CacheDir
cachedir Text
p = do
  PkgInfo m
pinfo <- CacheDir -> Text -> m (PkgInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir Text
p
  case Map SemVer (PkgRevInfo m) -> [SemVer]
forall k a. Map k a -> [k]
M.keys (Map SemVer (PkgRevInfo m) -> [SemVer])
-> Map SemVer (PkgRevInfo m) -> [SemVer]
forall a b. (a -> b) -> a -> b
$ PkgInfo m -> Map SemVer (PkgRevInfo m)
forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions PkgInfo m
pinfo of
    [] -> do
      Text -> m ()
forall a. ToLog a => a -> m ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no released versions.  Using HEAD."
      (SemVer, PkgRevInfo m) -> SemVer
forall a b. (a, b) -> a
fst ((SemVer, PkgRevInfo m) -> SemVer)
-> m (SemVer, PkgRevInfo m) -> m SemVer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CacheDir -> Text -> Maybe Text -> m (SemVer, PkgRevInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> Maybe Text -> m (SemVer, PkgRevInfo m)
lookupPackageCommit CacheDir
cachedir Text
p Maybe Text
forall a. Maybe a
Nothing
    SemVer
v : [SemVer]
vs -> SemVer -> m SemVer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SemVer -> m SemVer) -> SemVer -> m SemVer
forall a b. (a -> b) -> a -> b
$ (SemVer -> SemVer -> SemVer) -> SemVer -> [SemVer] -> SemVer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' SemVer -> SemVer -> SemVer
forall a. Ord a => a -> a -> a
max SemVer
v [SemVer]
vs