Safe Haskell | None |
---|---|
Language | Haskell2010 |
- data WrappedNamed (rt :: RepoType) p wX wY where
- NormalP :: !(Named p wX wY) -> WrappedNamed rt p wX wY
- RebaseP :: (PrimPatchBase p, FromPrim p, Effect p) => !PatchInfo -> !(Suspended p wX wX) -> WrappedNamed (RepoType IsRebase) p wX wX
- patch2patchinfo :: WrappedNamed rt p wX wY -> PatchInfo
- activecontents :: WrappedNamed rt p wX wY -> FL p wX wY
- infopatch :: PatchInfo -> FL p wX wY -> WrappedNamed rt p wX wY
- namepatch :: String -> String -> String -> [String] -> FL p wX wY -> IO (WrappedNamed rt p wX wY)
- anonymous :: FL p wX wY -> IO (WrappedNamed rt p wX wY)
- getdeps :: WrappedNamed rt p wX wY -> [PatchInfo]
- adddeps :: WrappedNamed rt p wX wY -> [PatchInfo] -> WrappedNamed rt p wX wY
- mkRebase :: (PrimPatchBase p, FromPrim p, Effect p) => Suspended p wX wX -> IO (WrappedNamed (RepoType IsRebase) p wX wX)
- toRebasing :: Named p wX wY -> WrappedNamed (RepoType IsRebase) p wX wY
- fromRebasing :: WrappedNamed (RepoType IsRebase) p wX wY -> Named p wX wY
- runInternalChecker :: InternalChecker p -> forall wX wY. p wX wY -> EqCheck wX wY
- namedInternalChecker :: forall rt p. IsRepoType rt => Maybe (InternalChecker (WrappedNamed rt p))
- namedIsInternal :: IsRepoType rt => WrappedNamed rt p wX wY -> EqCheck wX wY
- removeInternalFL :: IsRepoType rt => FL (WrappedNamed rt p) wX wY -> FL (Named p) wX wY
- fmapFL_WrappedNamed :: (FL p wA wB -> FL q wA wB) -> ((RebaseTypeOf rt :~~: IsRebase) -> p :~: q) -> WrappedNamed rt p wA wB -> WrappedNamed rt q wA wB
- data (a :: * -> * -> *) :~: b where
- data (a :: RebaseType) :~~: b where
- ReflRebaseType :: a :~~: a
- generaliseRepoTypeWrapped :: WrappedNamed (RepoType NoRebase) p wA wB -> WrappedNamed rt p wA wB
Documentation
data WrappedNamed (rt :: RepoType) p wX wY where Source #
A layer inbetween the 'Named p' type and 'PatchInfoAnd p' design for holding "internal" patches such as the rebase container. Ideally these patches would be stored at the repository level but this would require some significant refactoring/cleaning up of that code.
NormalP :: !(Named p wX wY) -> WrappedNamed rt p wX wY | |
RebaseP :: (PrimPatchBase p, FromPrim p, Effect p) => !PatchInfo -> !(Suspended p wX wX) -> WrappedNamed (RepoType IsRebase) p wX wX |
patch2patchinfo :: WrappedNamed rt p wX wY -> PatchInfo Source #
activecontents :: WrappedNamed rt p wX wY -> FL p wX wY Source #
Return a list of the underlying patches that are actually
active
in the repository, i.e. not suspended as part of a rebase
namepatch :: String -> String -> String -> [String] -> FL p wX wY -> IO (WrappedNamed rt p wX wY) Source #
getdeps :: WrappedNamed rt p wX wY -> [PatchInfo] Source #
adddeps :: WrappedNamed rt p wX wY -> [PatchInfo] -> WrappedNamed rt p wX wY Source #
mkRebase :: (PrimPatchBase p, FromPrim p, Effect p) => Suspended p wX wX -> IO (WrappedNamed (RepoType IsRebase) p wX wX) Source #
toRebasing :: Named p wX wY -> WrappedNamed (RepoType IsRebase) p wX wY Source #
fromRebasing :: WrappedNamed (RepoType IsRebase) p wX wY -> Named p wX wY Source #
runInternalChecker :: InternalChecker p -> forall wX wY. p wX wY -> EqCheck wX wY Source #
namedInternalChecker :: forall rt p. IsRepoType rt => Maybe (InternalChecker (WrappedNamed rt p)) Source #
Is the given WrappedNamed
patch an internal implementation detail
that shouldn't be visible in the UI or included in tags/matchers etc?
Two-level checker for efficiency: if the value of this is Nothing
for a given
patch type then there's no need to inspect patches of this type at all,
as none of them can be internal.
namedIsInternal :: IsRepoType rt => WrappedNamed rt p wX wY -> EqCheck wX wY Source #
Is the given WrappedNamed
patch an internal implementation detail
that shouldn't be visible in the UI or included in tags/matchers etc?
removeInternalFL :: IsRepoType rt => FL (WrappedNamed rt p) wX wY -> FL (Named p) wX wY Source #
:: (FL p wA wB -> FL q wA wB) | |
-> ((RebaseTypeOf rt :~~: IsRebase) -> p :~: q) | If the patch might be a rebase container patch,
then |
-> WrappedNamed rt p wA wB | |
-> WrappedNamed rt q wA wB |
lift a function over an FL
of patches to one over
a 'WrappedNamed rt'.
The function is only applied to "normal" patches,
and any rebase container patch is left alone.
data (a :: RebaseType) :~~: b where Source #
ReflRebaseType :: a :~~: a |
generaliseRepoTypeWrapped :: WrappedNamed (RepoType NoRebase) p wA wB -> WrappedNamed rt p wA wB Source #