@@ -28,6 +28,7 @@ module Distribution.Client.VCS (
2828 vcsGit ,
2929 vcsHg ,
3030 vcsSvn ,
31+ vcsPijul ,
3132 ) where
3233
3334import Prelude ()
@@ -498,3 +499,147 @@ svnProgram = (simpleProgram "svn") {
498499 _ -> " "
499500 }
500501
502+
503+ -- | VCS driver for Pijul.
504+ -- Documentation for Pijul can be found at <https://pijul.org/manual/introduction.html>
505+ --
506+ -- 2020-04-09 Oleg:
507+ --
508+ -- As far as I understand pijul, there are branches and "tags" in pijul,
509+ -- but there aren't a "commit hash" identifying an arbitrary state.
510+ --
511+ -- One can create `a pijul tag`, which will make a patch hash,
512+ -- which depends on everything currently in the repository.
513+ -- I guess if you try to apply that patch, you'll be forced to apply
514+ -- all the dependencies too. In other words, there are no named tags.
515+ --
516+ -- It's not clear to me whether there is an option to
517+ -- "apply this patch *and* all of its dependencies".
518+ -- And relatedly, whether how to make sure that there are no other
519+ -- patches applied.
520+ --
521+ -- With branches it's easier, as you can `pull` and `checkout` them,
522+ -- and they seem to be similar enough. Yet, pijul documentations says
523+ --
524+ -- > Note that the purpose of branches in Pijul is quite different from Git,
525+ -- since Git's "feature branches" can usually be implemented by just
526+ -- patches.
527+ --
528+ -- I guess it means that indeed instead of creating a branch and making PR
529+ -- in "GitHub" workflow, you'd just create a patch and offer it.
530+ -- You can do that with `git` too. Push (a branch with) commit to remote
531+ -- and ask other to cherry-pick that commit. Yet, in git identity of commit
532+ -- changes when it applied to other trees, where patches in pijul have
533+ -- will continue to have the same hash.
534+ --
535+ -- Unfortunately pijul doesn't talk about conflict resolution.
536+ -- It seems that you get something like:
537+ --
538+ -- % pijul status
539+ -- On branch merge
540+ --
541+ -- Unresolved conflicts:
542+ -- (fix conflicts and record the resolution with "pijul record ...")
543+ --
544+ -- foo
545+ --
546+ -- % cat foo
547+ -- first line
548+ -- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
549+ -- branch BBB
550+ -- ================================
551+ -- branch AAA
552+ -- <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
553+ -- last line
554+ --
555+ -- And then the `pijul dependencies` would draw you a graph like
556+ --
557+ --
558+ -- -----> foo on branch B ----->
559+ -- resolve confict Initial patch
560+ -- -----> foo on branch A ----->
561+ --
562+ -- Which is seems reasonable.
563+ --
564+ -- So currently, pijul support is very experimental, and most likely
565+ -- won't work, even the basics are in place. Tests are also written
566+ -- but disabled, as the branching model differs from `git` one,
567+ -- for which tests are written.
568+ --
569+ vcsPijul :: VCS Program
570+ vcsPijul =
571+ VCS {
572+ vcsRepoType = KnownRepoType Pijul ,
573+ vcsProgram = pijulProgram,
574+ vcsCloneRepo,
575+ vcsSyncRepos
576+ }
577+ where
578+ vcsCloneRepo :: Verbosity -- ^ it seems that pijul does not have verbose flag
579+ -> ConfiguredProgram
580+ -> SourceRepositoryPackage f
581+ -> FilePath
582+ -> FilePath
583+ -> [ProgramInvocation ]
584+ vcsCloneRepo _verbosity prog repo srcuri destdir =
585+ [ programInvocation prog cloneArgs ]
586+ -- And if there's a tag, we have to do that in a second step:
587+ ++ [ (programInvocation prog (checkoutArgs tag)) {
588+ progInvokeCwd = Just destdir
589+ }
590+ | tag <- maybeToList (srpTag repo) ]
591+ where
592+ cloneArgs = [" clone"
593+ ++ branchArgs
594+ branchArgs = case srpBranch repo of
595+ Just b -> [" --from-branch"
596+ Nothing -> []
597+ checkoutArgs tag = " checkout" : [tag] -- TODO: this probably doesn't work either
598+
599+ vcsSyncRepos :: Verbosity
600+ -> ConfiguredProgram
601+ -> [(SourceRepositoryPackage f , FilePath
602+ -> IO MonitorFilePath ]
603+ vcsSyncRepos _ _ [] = return []
604+ vcsSyncRepos verbosity pijulProg
605+ ((primaryRepo, primaryLocalDir) : secondaryRepos) = do
606+
607+ vcsSyncRepo verbosity pijulProg primaryRepo primaryLocalDir Nothing
608+ sequence_
609+ [ vcsSyncRepo verbosity pijulProg repo localDir (Just primaryLocalDir)
610+ | (repo, localDir) <- secondaryRepos ]
611+ return [ monitorDirectoryExistence dir
612+ | dir <- (primaryLocalDir : map snd secondaryRepos) ]
613+
614+ vcsSyncRepo verbosity pijulProg SourceRepositoryPackage {.. } localDir peer = do
615+ exists <- doesDirectoryExist localDir
616+ if exists
617+ then pijul localDir [" pull" -- TODO: this probably doesn't work.
618+ else pijul (takeDirectory localDir) cloneArgs
619+ pijul localDir checkoutArgs
620+ where
621+ pijul :: FilePath -> [String -> IO ()
622+ pijul cwd args = runProgramInvocation verbosity $
623+ (programInvocation pijulProg args) {
624+ progInvokeCwd = Just cwd
625+ }
626+
627+ cloneArgs = [" clone"
628+ ++ case peer of
629+ Nothing -> []
630+ Just peerLocalDir -> [peerLocalDir]
631+ where loc = srpLocation
632+ checkoutArgs = " checkout" : [" --force" " --"
633+ checkoutTarget = fromMaybe " HEAD" `mplus` srpTag) -- TODO: this is definitely wrong.
634+
635+ pijulProgram :: Program
636+ pijulProgram = (simpleProgram " pijul"
637+ programFindVersion = findProgramVersion " --version" $ \ str ->
638+ case words str of
639+ -- "pijul 0.12.2
640+ (_: ver: _) | all isTypical ver -> ver
641+ _ -> " "
642+ }
643+ where
644+ isNum c = c >= ' 0' && c <= ' 9'
645+ isTypical c = isNum c || c == ' .'
0 commit comments