mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-09-11 20:27:09 +03:00
Not use Show instance for GitHubRepo and Rev
This commit is contained in:
parent
745c03c173
commit
ca51e1bc4f
@ -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}
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user