diff options
Diffstat (limited to 'Types')
| -rw-r--r-- | Types/Distribution.hs | 42 | ||||
| -rw-r--r-- | Types/Transfer.hs | 14 |
2 files changed, 51 insertions, 5 deletions
diff --git a/Types/Distribution.hs b/Types/Distribution.hs index d4de7a79b..a7e2f4c95 100644 --- a/Types/Distribution.hs +++ b/Types/Distribution.hs @@ -1,16 +1,22 @@ {- Data type for a distribution of git-annex - - - Copyright 2013 Joey Hess <id@joeyh.name> + - Copyright 2013, 2017 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} module Types.Distribution where +import Utility.PartialPrelude import Types.Key +import Key import Data.Time.Clock import Git.Config (isTrue, boolConfig) +import Data.String.Utils + +type GitAnnexVersion = String + data GitAnnexDistribution = GitAnnexDistribution { distributionUrl :: String , distributionKey :: Key @@ -20,7 +26,39 @@ data GitAnnexDistribution = GitAnnexDistribution } deriving (Read, Show, Eq) -type GitAnnexVersion = String +{- The first line of the info file is in the format old versions of + - git-annex expect to read a GitAnnexDistribution. + - The remainder of the file is in the new format. + - This works because old versions of git-annex used readish to parse + - the file, and that ignores the second line. + -} +formatInfoFile :: GitAnnexDistribution -> String +formatInfoFile d = replace "keyVariant = " "keyBackendName = " (show d) ++ + "\n" ++ formatGitAnnexDistribution d + +parseInfoFile :: String -> Maybe GitAnnexDistribution +parseInfoFile s = case lines s of + (_oldformat:rest) -> parseGitAnnexDistribution (unlines rest) + _ -> Nothing + +formatGitAnnexDistribution :: GitAnnexDistribution -> String +formatGitAnnexDistribution d = unlines + [ distributionUrl d + , key2file (distributionKey d) + , distributionVersion d + , show (distributionReleasedate d) + , maybe "" show (distributionUrgentUpgrade d) + ] + +parseGitAnnexDistribution :: String -> Maybe GitAnnexDistribution +parseGitAnnexDistribution s = case lines s of + (u:k:v:d:uu:_) -> GitAnnexDistribution + <$> pure u + <*> file2key k + <*> pure v + <*> readish d + <*> pure (readish uu) + _ -> Nothing data AutoUpgrade = AskUpgrade | AutoUpgrade | NoAutoUpgrade deriving (Eq) diff --git a/Types/Transfer.hs b/Types/Transfer.hs index 1920bc73b..349eccf4b 100644 --- a/Types/Transfer.hs +++ b/Types/Transfer.hs @@ -16,8 +16,7 @@ import Control.Concurrent import Control.Applicative import Prelude -{- Enough information to uniquely identify a transfer, used as the filename - - of the transfer information file. -} +{- Enough information to uniquely identify a transfer. -} data Transfer = Transfer { transferDirection :: Direction , transferUUID :: UUID @@ -46,7 +45,16 @@ stubTransferInfo :: TransferInfo stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False data Direction = Upload | Download - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Show, Read) + +formatDirection :: Direction -> String +formatDirection Upload = "upload" +formatDirection Download = "download" + +parseDirection :: String -> Maybe Direction +parseDirection "upload" = Just Upload +parseDirection "download" = Just Download +parseDirection _ = Nothing instance Arbitrary TransferInfo where arbitrary = TransferInfo |