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.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}
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user