This commit is contained in:
Joey Hess 2015-07-09 16:20:30 -04:00
parent a7f58634b8
commit e59ba5a70b
3 changed files with 35 additions and 22 deletions

View file

@ -5,8 +5,6 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE FlexibleInstances #-}
module CmdLine.GitAnnex.Options where module CmdLine.GitAnnex.Options where
import System.Console.GetOpt import System.Console.GetOpt
@ -20,6 +18,7 @@ import Types.NumCopies
import Types.Messages import Types.Messages
import Types.Key import Types.Key
import Types.Command import Types.Command
import Types.DeferredParse
import qualified Annex import qualified Annex
import qualified Remote import qualified Remote
import qualified Limit import qualified Limit
@ -56,26 +55,6 @@ gitAnnexOptions = commonOptions ++
>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }) >>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })
>>= Annex.changeGitRepo >>= Annex.changeGitRepo
-- 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
parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote) parseRemoteOption :: Parser RemoteName -> Parser (DeferredParse Remote)
parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p parseRemoteOption p = DeferredParse . (fromJust <$$> Remote.byNameWithUUID) . Just <$> p

View file

@ -27,6 +27,7 @@ import qualified Backend
import qualified Git import qualified Git
import Types.Command as ReExported import Types.Command as ReExported
import Types.Option as ReExported import Types.Option as ReExported
import Types.DeferredParse as ReExported
import CmdLine.Seek as ReExported import CmdLine.Seek as ReExported
import Checks as ReExported import Checks as ReExported
import CmdLine.Usage as ReExported import CmdLine.Usage as ReExported

33
Types/DeferredParse.hs Normal file
View file

@ -0,0 +1,33 @@
{- git-annex deferred parse values
-
- Copyright 2015 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE FlexibleInstances #-}
module Types.DeferredParse where
import Annex
import Common
-- 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