Skip to content

Commit

Permalink
record date field
Browse files Browse the repository at this point in the history
  • Loading branch information
nmattia committed Aug 3, 2020
1 parent f3f763f commit 2931490
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 13 deletions.
22 changes: 13 additions & 9 deletions src/Niv/Git/Cmd.hs
Expand Up @@ -118,11 +118,13 @@ describeGit =
Opts.<$$> " niv add git --repo /my/custom/repo --name custom --ref foobar"
]

data CommitInfo = CommitInfo { revision :: T.Text, date :: T.Text }

gitUpdate ::
-- | latest rev
(T.Text -> T.Text -> IO T.Text) ->
(T.Text -> T.Text -> IO CommitInfo) ->
-- | latest rev and default ref
(T.Text -> IO (T.Text, T.Text)) ->
(T.Text -> IO (T.Text, CommitInfo)) ->
Update () ()
gitUpdate latestRev' defaultRefAndHEAD' = proc () -> do
useOrSet "type" -< ("git" :: Box T.Text)
Expand All @@ -132,20 +134,22 @@ gitUpdate latestRev' defaultRefAndHEAD' = proc () -> do
discoverRefAndRev = proc repository -> do
refAndRev <- run defaultRefAndHEAD' -< repository
update "ref" -< fst <$> refAndRev
update "rev" -< snd <$> refAndRev
update "rev" -< (revision . snd) <$> refAndRev
update "date" -< (date . snd) <$> refAndRev
returnA -< ()
discoverRev = proc repository -> do
ref <- load "ref" -< ()
rev <- run' (uncurry latestRev') -< (,) <$> repository <*> ref
update "rev" -< rev
update "rev" -< revision <$> rev
update "date" -< date <$> rev
returnA -< ()

-- | The "real" (IO) update
gitUpdate' :: Update () ()
gitUpdate' = gitUpdate latestRev defaultRefAndHEAD

-- TODO: document the git operations
latestRevInfo :: T.Text -> Maybe T.Text -> IO (T.Text, T.Text)
latestRevInfo :: T.Text -> Maybe T.Text -> IO (T.Text, CommitInfo)
latestRevInfo repo mref = runGits $ \git -> do
void $ git ["init"]
void $ git ["remote", "add", "origin", repo]
Expand All @@ -154,10 +158,10 @@ latestRevInfo repo mref = runGits $ \git -> do
void $ git ["checkout", ref]
git ["show", "--quiet", "--format=%H%n%aD", ref] >>= \case
[] -> abort "Git did not produce enough output while reading commit information"
[rev, _date] -> do
[rev, dte] -> do
unless (isRev rev) $ do
abort $ "The revision retrieved from git does not look like a revision: '" <> rev <> "'."
pure (ref, rev)
pure (ref, CommitInfo { revision = rev, date = dte } )
output ->
abort $ T.unlines $
["Git produced too much output while reading commit information:"] <> output
Expand All @@ -166,14 +170,14 @@ latestRevInfo repo mref = runGits $ \git -> do
Just l -> pure (T.strip l)
Nothing -> abort $ T.unlines $ ["could not parse default ref: "] <> ls

latestRev :: T.Text -> T.Text -> IO T.Text
latestRev :: T.Text -> T.Text -> IO CommitInfo
latestRev repo ref = snd <$> latestRevInfo repo (Just ref)

-- TODO: test this
defaultRefAndHEAD ::
-- | the repository
T.Text ->
IO (T.Text, T.Text)
IO (T.Text, CommitInfo)
defaultRefAndHEAD repo = latestRevInfo repo Nothing

abortNoRev :: [T.Text] -> T.Text -> IO a
Expand Down
14 changes: 10 additions & 4 deletions src/Niv/Git/Test.hs
Expand Up @@ -65,8 +65,10 @@ test_gitUpdateRev = do
$ error
$ "State mismatch: " <> show actualState
where
latestRev' _ _ = pure "some-other-rev"
defaultRefAndHEAD' _ = pure ("some-ref", "some-rev")
latestRev' _ _ = pure someOtherCommit
someCommit = CommitInfo { revision = "some-rev", date = "some-date" }
someOtherCommit = CommitInfo { revision = "some-other-rev", date = "some-other-date" }
defaultRefAndHEAD' _ = pure ("some-ref", someCommit)
initialState =
HMS.fromList
[("repo", (Free, "git@github.com:nmattia/niv"))]
Expand All @@ -75,6 +77,7 @@ test_gitUpdateRev = do
[ ("repo", "git@github.com:nmattia/niv"),
("ref", "some-ref"),
("rev", "some-other-rev"),
("date", "some-other-date"),
("type", "git")
]

Expand Down Expand Up @@ -115,8 +118,10 @@ test_gitCalledOnce = do
$ error
$ "State mismatch: " <> show actualState
where
latestRev' _ _ = pure "some-other-rev"
defaultRefAndHEAD' _ = pure ("some-ref", "some-rev")
latestRev' _ _ = pure someOtherCommit
someCommit = CommitInfo { revision = "some-rev", date = "some-date" }
someOtherCommit = CommitInfo { revision = "some-other-rev", date = "some-other-date" }
defaultRefAndHEAD' _ = pure ("some-ref", someCommit)
initialState =
HMS.fromList
[("repo", (Free, "git@github.com:nmattia/niv"))]
Expand All @@ -125,5 +130,6 @@ test_gitCalledOnce = do
[ ("repo", "git@github.com:nmattia/niv"),
("ref", "some-ref"),
("rev", "some-other-rev"),
("date", "some-other-date"),
("type", "git")
]

0 comments on commit 2931490

Please sign in to comment.