b223988e22
--backend is no longer a global option, and is only accepted by commands that actually need it. Three commands that used to support backend but don't any longer are watch, webapp, and assistant. It would be possible to make them support it, but I doubt anyone used the option with these. And in the case of webapp and assistant, the option was handled inconsistently, only taking affect when the command is run with an existing git-annex repo, not when it creates a new one. Also, renamed GlobalOption etc to AnnexOption. Because there are many options of this type that are not actually global (any more) and get added to commands that need them. Sponsored-by: Kevin Mueller on Patreon
57 lines
1.6 KiB
Haskell
57 lines
1.6 KiB
Haskell
{- git-annex deferred parse values
|
|
-
|
|
- Copyright 2015-2021 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
module Types.DeferredParse where
|
|
|
|
import Annex
|
|
|
|
import Options.Applicative
|
|
import qualified Data.Semigroup as Sem
|
|
import Prelude
|
|
|
|
-- Some values cannot be fully parsed without performing an action.
|
|
-- The action may be expensive, so it's best to call finishParse on such a
|
|
-- value before using getParsed repeatedly.
|
|
data DeferredParse a = DeferredParse (Annex a) | ReadyParse a
|
|
|
|
class DeferredParseClass a where
|
|
finishParse :: a -> Annex a
|
|
|
|
getParsed :: DeferredParse a -> Annex a
|
|
getParsed (DeferredParse a) = a
|
|
getParsed (ReadyParse a) = pure a
|
|
|
|
instance DeferredParseClass (DeferredParse a) where
|
|
finishParse (DeferredParse a) = ReadyParse <$> a
|
|
finishParse (ReadyParse a) = pure (ReadyParse a)
|
|
|
|
instance DeferredParseClass (Maybe (DeferredParse a)) where
|
|
finishParse Nothing = pure Nothing
|
|
finishParse (Just v) = Just <$> finishParse v
|
|
|
|
instance DeferredParseClass [DeferredParse a] where
|
|
finishParse v = mapM finishParse v
|
|
|
|
type AnnexOption = Parser AnnexSetter
|
|
|
|
-- Used for options that can modify Annex state by running
|
|
-- an arbitrary action in it, and can also set up AnnexRead.
|
|
data AnnexSetter = AnnexSetter
|
|
{ annexStateSetter :: Annex ()
|
|
, annexReadSetter :: AnnexRead -> AnnexRead
|
|
}
|
|
|
|
instance Sem.Semigroup AnnexSetter where
|
|
a <> b = AnnexSetter
|
|
{ annexStateSetter = annexStateSetter a >> annexStateSetter b
|
|
, annexReadSetter = annexReadSetter b . annexReadSetter a
|
|
}
|
|
|
|
instance Monoid AnnexSetter where
|
|
mempty = AnnexSetter (return ()) id
|