git-annex/Types/DeferredParse.hs
Joey Hess d16d739ce2
implement fastDebug
Most of the changes here involve global option parsing: GlobalSetter
changed so it can both run an Annex action to set state, but can also
change the AnnexRead value, which is immutable once the Annex monad is
running.

That allowed a debugselector value to be added to AnnexRead, seeded
from the git config. The --debugfilter option's GlobalSetter then updates
the AnnexRead.

This improved GlobalSetter can later be used to move more stuff to
AnnexRead. Things that don't involve a git config will be easier to
move, and probably a *lot* of things can be moved eventually.

fastDebug, while implemented, is not used anywhere yet. But it should be
fast..
2021-04-06 15:24:28 -04:00

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 GlobalOption = Parser GlobalSetter
-- Used for global options that can modify Annex state by running
-- an arbitrary action in it, and can also set up AnnexRead.
data GlobalSetter = GlobalSetter
{ annexStateSetter :: Annex ()
, annexReadSetter :: AnnexRead -> AnnexRead
}
instance Sem.Semigroup GlobalSetter where
a <> b = GlobalSetter
{ annexStateSetter = annexStateSetter a >> annexStateSetter b
, annexReadSetter = annexReadSetter b . annexReadSetter a
}
instance Monoid GlobalSetter where
mempty = GlobalSetter (return ()) id