module Update.Nix.FetchGit
( updatesFromFile
) where
import Control.Concurrent.Async (mapConcurrently)
import Control.Error
import Data.Foldable (toList)
import Data.Generics.Uniplate.Data (para)
import Data.Text (pack)
import Nix.Expr
import Update.Nix.FetchGit.Prefetch
import Update.Nix.FetchGit.Types
import Update.Nix.FetchGit.Utils
import Update.Nix.FetchGit.Warning
import Update.Span
updatesFromFile :: FilePath -> IO (Either Warning [SpanUpdate])
updatesFromFile f = runExceptT $ do
expr <- ExceptT $ ourParseNixFile f
treeWithArgs <- hoistEither $ exprToFetchTree expr
treeWithLatest <- ExceptT $
sequenceA <$> mapConcurrently getFetchGitLatestInfo treeWithArgs
pure (fetchTreeToSpanUpdates treeWithLatest)
exprToFetchTree :: NExprLoc -> Either Warning (FetchTree FetchGitArgs)
exprToFetchTree = para $ \e subs -> case e of
AnnE _ (NApp function (AnnE _ (NSet bindings)))
| extractFuncName function == Just "fetchgit"
|| extractFuncName function == Just "fetchgitPrivate"
-> FetchNode <$> extractFetchGitArgs bindings
AnnE _ (NApp function (AnnE _ (NSet bindings)))
| extractFuncName function == Just "fetchFromGitHub"
-> FetchNode <$> extractFetchFromGitHubArgs bindings
AnnE _ (NSet bindings)
-> Node <$> findAttr "version" bindings <*> sequenceA subs
_ -> Node Nothing <$> sequenceA subs
extractFetchGitArgs :: [Binding NExprLoc] -> Either Warning FetchGitArgs
extractFetchGitArgs bindings =
FetchGitArgs <$> (URL <$> (exprText =<< extractAttr "url" bindings))
<*> extractAttr "rev" bindings
<*> extractAttr "sha256" bindings
extractFetchFromGitHubArgs :: [Binding NExprLoc] -> Either Warning FetchGitArgs
extractFetchFromGitHubArgs bindings =
FetchGitArgs <$> (GitHub <$> (exprText =<< extractAttr "owner" bindings)
<*> (exprText =<< extractAttr "repo" bindings))
<*> extractAttr "rev" bindings
<*> extractAttr "sha256" bindings
getFetchGitLatestInfo :: FetchGitArgs -> IO (Either Warning FetchGitLatestInfo)
getFetchGitLatestInfo args = runExceptT $ do
o <- ExceptT (nixPrefetchGit (extractUrlString $ repoLocation args))
d <- hoistEither (parseISO8601DateToDay (date o))
pure $ FetchGitLatestInfo args (rev o) (sha256 o) d
fetchTreeToSpanUpdates :: FetchTree FetchGitLatestInfo -> [SpanUpdate]
fetchTreeToSpanUpdates node@(Node _ cs) =
concatMap fetchTreeToSpanUpdates cs ++
toList (maybeUpdateVersion node)
fetchTreeToSpanUpdates (FetchNode f) = [revUpdate, sha256Update]
where revUpdate = SpanUpdate (exprSpan (revExpr args))
(quoteString (latestRev f))
sha256Update = SpanUpdate (exprSpan (sha256Expr args))
(quoteString (latestSha256 f))
args = originalInfo f
maybeUpdateVersion :: FetchTree FetchGitLatestInfo -> Maybe SpanUpdate
maybeUpdateVersion node@(Node (Just versionExpr) _) = do
maxDay <- (maximumMay . fmap latestDate . toList) node
pure $ SpanUpdate (exprSpan versionExpr) ((quoteString . pack . show) maxDay)
maybeUpdateVersion _ = Nothing