    -- | 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
      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
      pure $
        GetManifest $ do
          v <- liftIO $ readIORef ref
          case 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
              v' <- m PkgManifest
    m
              liftIO $ writeIORef ref $ Just v'
              pure 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)
      (code, out, 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
      unless (err == mempty) $ logMsg $ T.decodeUtf8 err
      case 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
      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
      unless exists $
        gitCmd_ ["-C", cachedir, "clone", "https://" <> T.unpack url, url']
      pure 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
    "--"]
      [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]
      [time] <- gitCmdLines ["-C", gitdir, "show", "-s", "--format=%cI", ref]
      utc <-
        -- Git sometimes produces timestamps with Z time zone, which are
        -- not valid ZonedTimes.
        if 'Z' `T.elem` time
          then iso8601ParseM (T.unpack time)
          else zonedTimeToUTC <$> iso8601ParseM (T.unpack time)
      gm <- memoiseGetManifest getManifest'
      pure $
        PkgRevInfo
          { pkgGetFiles = getFiles gm,
            pkgRevCommit = sha,
            pkgRevGetManifest = gm,
            pkgRevTime = 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
    "--"]
          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
    gitdir String -> ShowS
    </> String
    pdir
          exists <- liftIO $ doesDirectoryExist pdir_abs
          unless exists $ noPkgDir pdir
          fs <- liftIO $ directoryContents pdir_abs
          pure (pdir_abs, map (makeRelative pdir_abs) 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
          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
    "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 parsePkgManifest f 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
      gitdir <- CacheDir -> Text -> m String
    forall (m :: * -> *).
    (MonadIO m, MonadLogger m, MonadFail m) =>
    CacheDir -> Text -> m String
    ensureGit CacheDir
    cachedir Text
    url
      versions <- mapMaybe isVersionRef <$> gitCmdLines ["-C", gitdir, "tag"]
      versions' <-
        M.fromList . zip versions
          <$> mapM (revInfo gitdir path . versionRef) versions
      pure $ PkgInfo versions' $ lookupCommit 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) <- m (PkgRegistry m)
    forall (m :: * -> *). MonadPkgRegistry m => m (PkgRegistry m)
    getPkgRegistry
      case lookupKnownPackage p 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
          pinfo <- CacheDir -> Text -> m (PkgInfo m)
    forall (m :: * -> *).
    (MonadIO m, MonadLogger m, MonadFail m) =>
    CacheDir -> Text -> m (PkgInfo m)
    pkgInfo CacheDir
    cachedir Text
    p
          putPkgRegistry $ PkgRegistry $ M.insert p pinfo m
          pure 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
      pinfo <- CacheDir -> Text -> m (PkgInfo m)
    forall (m :: * -> *).
    MonadPkgRegistry m =>
    CacheDir -> Text -> m (PkgInfo m)
    lookupPackage CacheDir
    cachedir Text
    p
      rev_info <- pkgLookupCommit pinfo ref
      let 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 = 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 {pkgVersions = M.insert v rev_info $ pkgVersions pinfo}
      modifyPkgRegistry $ \(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
      pure (v, 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
          pinfo <- CacheDir -> Text -> m (PkgInfo m)
    forall (m :: * -> *).
    MonadPkgRegistry m =>
    CacheDir -> Text -> m (PkgInfo m)
    lookupPackage CacheDir
    cachedir Text
    p
          case lookupPkgRev v 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
      pinfo <- CacheDir -> Text -> m (PkgInfo m)
    forall (m :: * -> *).
    MonadPkgRegistry m =>
    CacheDir -> Text -> m (PkgInfo m)
    lookupPackage CacheDir
    cachedir Text
    p
      case M.keys $ pkgVersions 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