refactor
This commit is contained in:
parent
a7f58634b8
commit
e59ba5a70b
3 changed files with 35 additions and 22 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
33
Types/DeferredParse.hs
Normal 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
|
Loading…
Reference in a new issue