diff options
Diffstat (limited to 'app/Issue.hs')
| -rw-r--r-- | app/Issue.hs | 55 |
1 files changed, 3 insertions, 52 deletions
diff --git a/app/Issue.hs b/app/Issue.hs index f7895af..75e700d 100644 --- a/app/Issue.hs +++ b/app/Issue.hs @@ -1,22 +1,14 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} module Issue (Issue (..), Provenance (..), fromMatch, id) where -import Data.Binary (Binary, Put, get, put) -import Data.ByteString.Lazy (toStrict) -import Data.Fixed (Pico) -import Data.Function ((&)) +import Data.Binary (Binary) import Data.List (find, foldl') import Data.Text (Text) import Data.Text qualified as T -import Data.Text.Encoding (decodeUtf8) -import Data.Time.Calendar (Day (..), toModifiedJulianDay) -import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime) import GHC.Generics (Generic) +import Issue.Provenance (Provenance (..), provenanceFromHEAD) import Issue.Tag (Tag (..)) import Issue.Tag qualified as I import Issue.Text qualified as I -import Process (sh) -import System.Process.Typed (setWorkingDir) import TreeGrepper.Match (Match (..)) import TreeGrepper.Match qualified as G import TreeGrepper.Result (Result (..)) @@ -35,30 +27,6 @@ data Issue = Issue } deriving (Show, Binary, Generic) -data Provenance = Provenance - { firstCommit :: Text, - date :: UTCTime, - authorEmail :: Text, - authorName :: Text - } - deriving (Show, Generic, Binary) - --- XXX These are taken from `Data.Binary.Orphans` [1]. I cannot get importing --- the instance from the package to work.. so we use `-fno-warn-orphans` here. --- --- [1] https://hackage.haskell.org/package/binary-orphans-0.1.5.1/docs/src/Data-Binary-Orphans.html#line-132 -instance Binary UTCTime where - get = UTCTime <$> get <*> get - put (UTCTime d dt) = put d >> put dt - -instance Binary Day where - get = fmap ModifiedJulianDay get - put = put . toModifiedJulianDay - -instance Binary DiffTime where - get = fmap picosecondsToDiffTime get - put = (put :: Pico -> Put) . realToFrac - id :: Issue -> Maybe String id issue = (\(Tag _ v) -> T.unpack v) @@ -68,24 +36,7 @@ id issue = fromMatch :: FilePath -> G.Result -> G.Match -> IO (Maybe Issue) fromMatch cwd result match = do - rawProvenance <- - fmap (T.splitOn "\NUL" . head . T.lines . decodeUtf8 . toStrict) $ - sh $ - "git show --quiet --format='%H%x00%ai%x00%ae%x00%an'" - & setWorkingDir cwd - let provenance = - case rawProvenance of - firstCommit' : rawDate : authorEmail : authorName : _ -> - let date = read (T.unpack rawDate) - in Just - Provenance - { firstCommit = firstCommit', - date = date, - authorEmail = authorEmail, - authorName = authorName - } - _ -> - Nothing + provenance <- provenanceFromHEAD cwd pure ( if any (\marker -> T.isPrefixOf marker title') issueMarkers |