input-output-hk/foliage
1
1
Fork 0
mirror of https://github.com/input-output-hk/foliage.git synced 2024-08-18 00:10:22 +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.FilePath
import Development.Shake.Rule
import Foliage.Meta (GitHubRepo)
import Foliage.Meta (GitHubRepo, gitHubRepoToString)
import GHC.Generics (Generic)
import System.Directory (doesDirectoryExist)
@ -23,7 +23,7 @@ newtype GitClone = GitClone {repo :: GitHubRepo}
deriving newtype (NFData)
instance Show GitClone where
show GitClone{repo} = "gitClone " <> show repo
show GitClone{repo} = "gitClone " <> gitHubRepoToString repo
instance Hashable GitClone
@ -44,13 +44,13 @@ addGitCloneRule cacheDir = addBuiltinRule noLint noIdentity run
where
run :: BuiltinRun GitClone FilePath
run GitClone{repo} _old _mode = do
let path = cacheDir </> "git" </> show repo
let path = cacheDir </> "git" </> gitHubRepoToString repo
alreadyCloned <- liftIO $ doesDirectoryExist path
if alreadyCloned
then command_ [Cwd path] "git" ["fetch"]
else do
let url = "https://github.com/" <> show repo <> ".git"
let url = "https://github.com/" <> gitHubRepoToString repo <> ".git"
command_ [] "git" ["clone", "--recursive", url, 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 GitHubSource,
GitHubRepo (..),
gitHubRepoToString,
GitHubRev (..),
gitHubRevToString,
UTCTime,
latestRevisionNumber,
packageVersionSourceToUri,
@ -51,16 +53,18 @@ import Toml (TomlCodec, (.=))
import Toml qualified
newtype GitHubRepo = GitHubRepo {unGitHubRepo :: Text}
deriving (Eq, Binary, Hashable, NFData) via Text
deriving (Show, Eq, Binary, Hashable, NFData) via Text
instance Show GitHubRepo where
show = T.unpack . unGitHubRepo
gitHubRepoToString :: GitHubRepo -> String
gitHubRepoToString =
T.unpack . unGitHubRepo
newtype GitHubRev = GitHubRev {unGitHubRev :: Text}
deriving (Eq, Binary, Hashable, NFData) via Text
deriving (Show, Eq, Binary, Hashable, NFData) via Text
instance Show GitHubRev where
show = T.unpack . unGitHubRev
gitHubRevToString :: GitHubRev -> String
gitHubRevToString =
T.unpack . unGitHubRev
data PackageVersionSource
= 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 repoDir rev mSubdir outDir = 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"]
let packageDir = maybe tmpDir (tmpDir </>) mSubdir
copyDirectoryContents packageDir outDir