input-output-hk/foliage
1
1
Fork 0
mirror of https://github.com/input-output-hk/foliage.git synced 2024-09-11 20:27:09 +03:00
Code Issues Packages Projects Releases Wiki Activity

Not use Show instance for GitHubRepo and Rev

Browse Source
This commit is contained in:
Sebastian Nagel 2023-11-13 16:07:26 +01:00
parent 745c03c173
commit ca51e1bc4f
No known key found for this signature in database
GPG Key ID: B2BF1EFDD95012D9
3 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
app/Foliage/GitClone.hs
View File

@ -14,7 +14,7 @@ import Development.Shake hiding (doesDirectoryExist)
import Development.Shake.Classes import Development.Shake.Classes
import Development.Shake.FilePath import Development.Shake.FilePath
import Development.Shake.Rule import Development.Shake.Rule
import Foliage.Meta (GitHubRepo) import Foliage.Meta (GitHubRepo, gitHubRepoToString)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import System.Directory (doesDirectoryExist) import System.Directory (doesDirectoryExist)
@ -23,7 +23,7 @@ newtype GitClone = GitClone {repo :: GitHubRepo}
deriving newtype (NFData) deriving newtype (NFData)
instance Show GitClone where instance Show GitClone where
show GitClone{repo} = "gitClone " <> show repo show GitClone{repo} = "gitClone " <> gitHubRepoToString repo
instance Hashable GitClone instance Hashable GitClone
@ -44,13 +44,13 @@ addGitCloneRule cacheDir = addBuiltinRule noLint noIdentity run
where where
run :: BuiltinRun GitClone FilePath run :: BuiltinRun GitClone FilePath
run GitClone{repo} _old _mode = do run GitClone{repo} _old _mode = do
let path = cacheDir </> "git" </> show repo let path = cacheDir </> "git" </> gitHubRepoToString repo
alreadyCloned <- liftIO $ doesDirectoryExist path alreadyCloned <- liftIO $ doesDirectoryExist path
if alreadyCloned if alreadyCloned
then command_ [Cwd path] "git" ["fetch"] then command_ [Cwd path] "git" ["fetch"]
else do else do
let url = "https://github.com/" <> show repo <> ".git" let url = "https://github.com/" <> gitHubRepoToString repo <> ".git"
command_ [] "git" ["clone", "--recursive", url, path] command_ [] "git" ["clone", "--recursive", url, path]
return $ RunResult{runChanged = ChangedRecomputeDiff, runStore = "", runValue = path} return $ RunResult{runChanged = ChangedRecomputeDiff, runStore = "", runValue = path}

16
app/Foliage/Meta.hs
View File

@ -24,7 +24,9 @@ module Foliage.Meta (
pattern URISource, pattern URISource,
pattern GitHubSource, pattern GitHubSource,
GitHubRepo (..), GitHubRepo (..),
gitHubRepoToString,
GitHubRev (..), GitHubRev (..),
gitHubRevToString,
UTCTime, UTCTime,
latestRevisionNumber, latestRevisionNumber,
packageVersionSourceToUri, packageVersionSourceToUri,
@ -51,16 +53,18 @@ import Toml (TomlCodec, (.=))
import Toml qualified import Toml qualified
newtype GitHubRepo = GitHubRepo {unGitHubRepo :: Text} newtype GitHubRepo = GitHubRepo {unGitHubRepo :: Text}
deriving (Eq, Binary, Hashable, NFData) via Text deriving (Show, Eq, Binary, Hashable, NFData) via Text
instance Show GitHubRepo where gitHubRepoToString :: GitHubRepo -> String
show = T.unpack . unGitHubRepo gitHubRepoToString =
T.unpack . unGitHubRepo
newtype GitHubRev = GitHubRev {unGitHubRev :: Text} newtype GitHubRev = GitHubRev {unGitHubRev :: Text}
deriving (Eq, Binary, Hashable, NFData) via Text deriving (Show, Eq, Binary, Hashable, NFData) via Text
instance Show GitHubRev where gitHubRevToString :: GitHubRev -> String
show = T.unpack . unGitHubRev gitHubRevToString =
T.unpack . unGitHubRev
data PackageVersionSource data PackageVersionSource
= URISource = URISource

2
app/Foliage/PrepareSource.hs
View File

@ -123,7 +123,7 @@ addPrepareSourceRule inputDir cacheDir = addBuiltinRule noLint noIdentity run
copyGitWorktree :: FilePath -> GitHubRev -> Maybe FilePath -> FilePath -> Action () copyGitWorktree :: FilePath -> GitHubRev -> Maybe FilePath -> FilePath -> Action ()
copyGitWorktree repoDir rev mSubdir outDir = do copyGitWorktree repoDir rev mSubdir outDir = do
withTempDir $ \tmpDir -> do withTempDir $ \tmpDir -> do
command_ [Cwd repoDir] "git" ["worktree", "add", tmpDir, show rev] command_ [Cwd repoDir] "git" ["worktree", "add", tmpDir, gitHubRevToString rev]
command_ [Cwd tmpDir] "git" ["submodule", "update", "--init"] command_ [Cwd tmpDir] "git" ["submodule", "update", "--init"]
let packageDir = maybe tmpDir (tmpDir </>) mSubdir let packageDir = maybe tmpDir (tmpDir </>) mSubdir
copyDirectoryContents packageDir outDir copyDirectoryContents packageDir outDir