From c1ff403387064ff0027b9e762cc6f6a8fa20c8d9 Mon Sep 17 00:00:00 2001 From: Alexander Foremny Date: Thu, 7 Dec 2023 03:58:21 +0100 Subject: chore: move remaining `History.*` modules outside of `History` --- app/Cache.hs | 33 +++++++++++++++++++++++++++++ app/Git.hs | 4 +++- app/Git/CommitHash.hs | 37 ++++++++++++++++++++++++++++++++ app/History.hs | 8 +++---- app/History/Cache.hs | 33 ----------------------------- app/History/CommitHash.hs | 37 -------------------------------- app/History/IssueEvent.hs | 54 ----------------------------------------------- app/Issue/Provenance.hs | 4 ++-- app/IssueEvent.hs | 54 +++++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 133 insertions(+), 131 deletions(-) create mode 100644 app/Cache.hs create mode 100644 app/Git/CommitHash.hs delete mode 100644 app/History/Cache.hs delete mode 100644 app/History/CommitHash.hs delete mode 100644 app/History/IssueEvent.hs create mode 100644 app/IssueEvent.hs (limited to 'app') diff --git a/app/Cache.hs b/app/Cache.hs new file mode 100644 index 0000000..52d18ca --- /dev/null +++ b/app/Cache.hs @@ -0,0 +1,33 @@ +module Cache + ( cached, + cachedMaybe, + ) +where + +import Data.Binary (Binary, decodeFileOrFail, encodeFile) +import Data.Text qualified as T +import Debug +import Git qualified +import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.FilePath (()) + +cached :: Binary a => T.Text -> IO a -> IO a +cached key func = do + root <- Git.getRootDir + createDirectoryIfMissing True (root ".anissue") + let file = (root ".anissue" T.unpack key) + doesFileExist file >>= \case + True -> + decodeFileOrFail file >>= \case + Left e -> debug "e" e `seq` generate file + Right blob -> pure blob + False -> generate file + where + generate file = do + blob <- func + encodeFile (debug "cache miss" file) blob + pure blob + +cachedMaybe :: Binary a => Maybe T.Text -> IO a -> IO a +cachedMaybe Nothing func = func +cachedMaybe (Just key) func = cached key func diff --git a/app/Git.hs b/app/Git.hs index 653ddbd..0b8a561 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -1,5 +1,6 @@ module Git - ( withWorkingTree, + ( module Git.CommitHash, + withWorkingTree, getCommitHashes, getRootDir, ) @@ -13,6 +14,7 @@ import Data.Maybe (fromMaybe) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Exception qualified as E +import Git.CommitHash import Process (proc, sh, sh_) import System.Directory (createDirectoryIfMissing) import System.FilePath (dropTrailingPathSeparator, takeDirectory) diff --git a/app/Git/CommitHash.hs b/app/Git/CommitHash.hs new file mode 100644 index 0000000..db7a478 --- /dev/null +++ b/app/Git/CommitHash.hs @@ -0,0 +1,37 @@ +module Git.CommitHash + ( CommitHash (..), + toShortText, + toText, + ) +where + +import Data.Binary (Binary) +import Data.Maybe (fromMaybe) +import Data.Text qualified as T +import GHC.Generics (Generic) +import Render qualified as P + +data CommitHash + = WorkingTree + | Commit T.Text + deriving (Eq, Show, Binary, Generic) + +toShortText :: CommitHash -> Maybe T.Text +toShortText = fmap (T.take 7) . toText + +toText :: CommitHash -> Maybe T.Text +toText WorkingTree = Nothing +toText (Commit hash) = Just hash + +instance P.Render CommitHash where + render = P.render . P.Detailed + +instance P.Render (P.Detailed CommitHash) where + render (P.Detailed commitHash) = + P.styled [P.color P.Yellow] $ + P.render (fromMaybe "" (toText commitHash)) + +instance P.Render (P.Summarized CommitHash) where + render (P.Summarized commitHash) = + P.styled [P.color P.Yellow] $ + P.render (fromMaybe "" (toShortText commitHash)) diff --git a/app/History.hs b/app/History.hs index e1ea0ab..70fc123 100644 --- a/app/History.hs +++ b/app/History.hs @@ -5,6 +5,7 @@ module History where import CMark qualified as D +import Cache (cachedMaybe) import Control.Exception (catch, handle, try) import Data.Binary (Binary) import Data.ByteString.Lazy qualified as LB @@ -21,15 +22,14 @@ import Die (die) import Exception qualified as E import GHC.Generics (Generic) import Git qualified -import History.Cache (cachedMaybe) -import History.CommitHash (CommitHash (..)) -import History.CommitHash qualified as C -import History.IssueEvent (IssueEvent (..)) +import Git.CommitHash (CommitHash (..)) +import Git.CommitHash qualified as C import Issue qualified as I import Issue.Parser qualified as I import Issue.Provenance qualified as I import Issue.Tag qualified as I import Issue.Text qualified as I +import IssueEvent (IssueEvent (..)) import Patch qualified as A import Process (proc, sh) import Render qualified as P diff --git a/app/History/Cache.hs b/app/History/Cache.hs deleted file mode 100644 index 978f3d9..0000000 --- a/app/History/Cache.hs +++ /dev/null @@ -1,33 +0,0 @@ -module History.Cache - ( cached, - cachedMaybe, - ) -where - -import Data.Binary (Binary, decodeFileOrFail, encodeFile) -import Data.Text qualified as T -import Debug -import Git qualified -import System.Directory (createDirectoryIfMissing, doesFileExist) -import System.FilePath (()) - -cached :: Binary a => T.Text -> IO a -> IO a -cached key func = do - root <- Git.getRootDir - createDirectoryIfMissing True (root ".anissue") - let file = (root ".anissue" T.unpack key) - doesFileExist file >>= \case - True -> - decodeFileOrFail file >>= \case - Left e -> debug "e" e `seq` generate file - Right blob -> pure blob - False -> generate file - where - generate file = do - blob <- func - encodeFile (debug "cache miss" file) blob - pure blob - -cachedMaybe :: Binary a => Maybe T.Text -> IO a -> IO a -cachedMaybe Nothing func = func -cachedMaybe (Just key) func = cached key func diff --git a/app/History/CommitHash.hs b/app/History/CommitHash.hs deleted file mode 100644 index 1075b2f..0000000 --- a/app/History/CommitHash.hs +++ /dev/null @@ -1,37 +0,0 @@ -module History.CommitHash - ( CommitHash (..), - toShortText, - toText, - ) -where - -import Data.Binary (Binary) -import Data.Maybe (fromMaybe) -import Data.Text qualified as T -import GHC.Generics (Generic) -import Render qualified as P - -data CommitHash - = WorkingTree - | Commit T.Text - deriving (Eq, Show, Binary, Generic) - -toShortText :: CommitHash -> Maybe T.Text -toShortText = fmap (T.take 7) . toText - -toText :: CommitHash -> Maybe T.Text -toText WorkingTree = Nothing -toText (Commit hash) = Just hash - -instance P.Render CommitHash where - render = P.render . P.Detailed - -instance P.Render (P.Detailed CommitHash) where - render (P.Detailed commitHash) = - P.styled [P.color P.Yellow] $ - P.render (fromMaybe "" (toText commitHash)) - -instance P.Render (P.Summarized CommitHash) where - render (P.Summarized commitHash) = - P.styled [P.color P.Yellow] $ - P.render (fromMaybe "" (toShortText commitHash)) diff --git a/app/History/IssueEvent.hs b/app/History/IssueEvent.hs deleted file mode 100644 index 932cfd9..0000000 --- a/app/History/IssueEvent.hs +++ /dev/null @@ -1,54 +0,0 @@ -module History.IssueEvent (IssueEvent (..)) where - -import Data.Binary (Binary) -import GHC.Generics (Generic) -import History.CommitHash (CommitHash) -import Issue (Issue) -import Issue.Render qualified as I -import Patch (Patch) -import Render ((<<<)) -import Render qualified as P - -data IssueEvent - = IssueCreated - { hash :: CommitHash, - issue :: Issue, - patch :: Patch - } - | IssueChanged - { hash :: CommitHash, - oldIssue :: Issue, - issue :: Issue, - patch :: Patch - } - | IssueDeleted - { hash :: CommitHash, - issue :: Issue, - patch :: Patch - } - deriving (Show, Generic, Binary) - -instance P.Render IssueEvent where - render = P.render . P.Detailed - -instance P.Render (P.Detailed IssueEvent) where - render (P.Detailed issueEvent) = - P.Summarized issueEvent - <<< P.hardline @P.AnsiStyle - <<< issueEvent.patch - -instance P.Render (P.Summarized IssueEvent) where - render (P.Summarized issueEvent) = - case issueEvent of - IssueCreated {hash, issue} -> - P.Summarized hash - <<< P.styled [P.color P.Green] "created" - <<< I.IssueTitle issue - IssueChanged {hash, issue} -> - P.Summarized hash - <<< P.styled [P.color P.Green] "changed" - <<< I.IssueTitle issue - IssueDeleted {hash, issue} -> - P.Summarized hash - <<< P.styled [P.color P.Green] "deleted" - <<< I.IssueTitle issue diff --git a/app/Issue/Provenance.hs b/app/Issue/Provenance.hs index addb6fe..18255da 100644 --- a/app/Issue/Provenance.hs +++ b/app/Issue/Provenance.hs @@ -20,8 +20,8 @@ import Data.Time.Calendar (Day (..), toModifiedJulianDay) import Data.Time.Clock (DiffTime, UTCTime (..), picosecondsToDiffTime) import Exception qualified as E import GHC.Generics (Generic) -import History.CommitHash (CommitHash) -import History.CommitHash qualified as C +import Git.CommitHash (CommitHash) +import Git.CommitHash qualified as C import Process (sh) import System.Process.Typed (setWorkingDir) import Prelude hiding (lines) diff --git a/app/IssueEvent.hs b/app/IssueEvent.hs new file mode 100644 index 0000000..8f4cdd2 --- /dev/null +++ b/app/IssueEvent.hs @@ -0,0 +1,54 @@ +module IssueEvent (IssueEvent (..)) where + +import Data.Binary (Binary) +import GHC.Generics (Generic) +import Git.CommitHash (CommitHash) +import Issue (Issue) +import Issue.Render qualified as I +import Patch (Patch) +import Render ((<<<)) +import Render qualified as P + +data IssueEvent + = IssueCreated + { hash :: CommitHash, + issue :: Issue, + patch :: Patch + } + | IssueChanged + { hash :: CommitHash, + oldIssue :: Issue, + issue :: Issue, + patch :: Patch + } + | IssueDeleted + { hash :: CommitHash, + issue :: Issue, + patch :: Patch + } + deriving (Show, Generic, Binary) + +instance P.Render IssueEvent where + render = P.render . P.Detailed + +instance P.Render (P.Detailed IssueEvent) where + render (P.Detailed issueEvent) = + P.Summarized issueEvent + <<< P.hardline @P.AnsiStyle + <<< issueEvent.patch + +instance P.Render (P.Summarized IssueEvent) where + render (P.Summarized issueEvent) = + case issueEvent of + IssueCreated {hash, issue} -> + P.Summarized hash + <<< P.styled [P.color P.Green] "created" + <<< I.IssueTitle issue + IssueChanged {hash, issue} -> + P.Summarized hash + <<< P.styled [P.color P.Green] "changed" + <<< I.IssueTitle issue + IssueDeleted {hash, issue} -> + P.Summarized hash + <<< P.styled [P.color P.Green] "deleted" + <<< I.IssueTitle issue -- cgit v1.2.3