module Darcs.Util.Download.Request ( UrlRequest(..) , Cachable(..) , UrlState(..) , Q(..) , readQ , insertQ , pushQ , addUsingPriority , deleteQ , elemQ , emptyQ , nullQ , Priority(..) , ConnectionError(..) ) where import Darcs.Prelude import Data.List ( delete ) import Data.Map ( Map ) import Foreign.C.Types ( CInt ) data Priority = High | Low deriving Priority -> Priority -> Bool (Priority -> Priority -> Bool) -> (Priority -> Priority -> Bool) -> Eq Priority forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Priority -> Priority -> Bool $c/= :: Priority -> Priority -> Bool == :: Priority -> Priority -> Bool $c== :: Priority -> Priority -> Bool Eq data Cachable = Cachable | Uncachable | MaxAge !CInt deriving (Int -> Cachable -> ShowS [Cachable] -> ShowS Cachable -> String (Int -> Cachable -> ShowS) -> (Cachable -> String) -> ([Cachable] -> ShowS) -> Show Cachable forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Cachable] -> ShowS $cshowList :: [Cachable] -> ShowS show :: Cachable -> String $cshow :: Cachable -> String showsPrec :: Int -> Cachable -> ShowS $cshowsPrec :: Int -> Cachable -> ShowS Show, Cachable -> Cachable -> Bool (Cachable -> Cachable -> Bool) -> (Cachable -> Cachable -> Bool) -> Eq Cachable forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Cachable -> Cachable -> Bool $c/= :: Cachable -> Cachable -> Bool == :: Cachable -> Cachable -> Bool $c== :: Cachable -> Cachable -> Bool Eq) -- | A UrlRequest object contains a url to get, the file into which the -- contents at the given url should be written, the cachability of this request -- and the request's priority. data UrlRequest = UrlRequest { UrlRequest -> String url :: String , UrlRequest -> String file :: FilePath , UrlRequest -> Cachable cachable :: Cachable , UrlRequest -> Priority priority :: Priority } type InProgressStatus = ( FilePath -- FilePath to write url contents into , [FilePath] -- Extra paths to copy complete file into , Cachable -- Cachable status ) -- | A UrlState object contains a map of url -> InProgressStatus, a Q of urls -- waiting to be started, the current pipe length and the unique junk to -- create unique filenames. data UrlState = UrlState { UrlState -> Map String InProgressStatus inProgress :: Map String InProgressStatus , UrlState -> Q String waitToStart :: Q String , UrlState -> Int pipeLength :: Int , UrlState -> String randomJunk :: String } -- |Q represents a prioritised queue, with two-tier priority. The left list -- contains higher priority items than the right list. data Q a = Q [a] [a] -- |'readQ' will try and take an element from the Q, preferring elements from -- the high priority list. readQ :: Q a -> Maybe (a, Q a) readQ :: Q a -> Maybe (a, Q a) readQ (Q (a x : [a] xs) [a] ys) = (a, Q a) -> Maybe (a, Q a) forall (m :: * -> *) a. Monad m => a -> m a return (a x, [a] -> [a] -> Q a forall a. [a] -> [a] -> Q a Q [a] xs [a] ys) readQ (Q [] [a] ys) = do a x : [a] xs <- [a] -> Maybe [a] forall (m :: * -> *) a. Monad m => a -> m a return ([a] -> Maybe [a]) -> [a] -> Maybe [a] forall a b. (a -> b) -> a -> b $ [a] -> [a] forall a. [a] -> [a] reverse [a] ys (a, Q a) -> Maybe (a, Q a) forall (m :: * -> *) a. Monad m => a -> m a return (a x, [a] -> [a] -> Q a forall a. [a] -> [a] -> Q a Q [a] xs []) -- | Return a function for adding an element based on the priority. addUsingPriority :: Priority -> a -> Q a -> Q a addUsingPriority :: Priority -> a -> Q a -> Q a addUsingPriority Priority High = a -> Q a -> Q a forall a. a -> Q a -> Q a pushQ addUsingPriority Priority Low = a -> Q a -> Q a forall a. a -> Q a -> Q a insertQ -- |'insertQ' inserts a low priority item into a Q. insertQ :: a -> Q a -> Q a insertQ :: a -> Q a -> Q a insertQ a y (Q [a] xs [a] ys) = [a] -> [a] -> Q a forall a. [a] -> [a] -> Q a Q [a] xs (a ya -> [a] -> [a] forall a. a -> [a] -> [a] :[a] ys) -- |'pushQ' inserts a high priority item into a Q. pushQ :: a -> Q a -> Q a pushQ :: a -> Q a -> Q a pushQ a x (Q [a] xs [a] ys) = [a] -> [a] -> Q a forall a. [a] -> [a] -> Q a Q (a xa -> [a] -> [a] forall a. a -> [a] -> [a] :[a] xs) [a] ys -- |'deleteQ' removes any instances of a given element from the Q. deleteQ :: Eq a => a -> Q a -> Q a deleteQ :: a -> Q a -> Q a deleteQ a x (Q [a] xs [a] ys) = [a] -> [a] -> Q a forall a. [a] -> [a] -> Q a Q (a -> [a] -> [a] forall a. Eq a => a -> [a] -> [a] delete a x [a] xs) (a -> [a] -> [a] forall a. Eq a => a -> [a] -> [a] delete a x [a] ys) -- |'deleteQ' checks for membership in a Q. elemQ :: Eq a => a -> Q a -> Bool elemQ :: a -> Q a -> Bool elemQ a x (Q [a] xs [a] ys) = a x a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [a] xs Bool -> Bool -> Bool || a x a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [a] ys -- |'emptyQ' is an empty Q. emptyQ :: Q a emptyQ :: Q a emptyQ = [a] -> [a] -> Q a forall a. [a] -> [a] -> Q a Q [] [] -- |'nullQ' checks if the Q contains no items. nullQ :: Q a -> Bool nullQ :: Q a -> Bool nullQ (Q [] []) = Bool True nullQ Q a _ = Bool False -- | Data type to represent a connection error. -- The following are the codes from libcurl -- which map to each of the constructors: -- * 6 -> CouldNotResolveHost : The remote host was not resolved. -- * 7 -> CouldNotConnectToServer : Failed to connect() to host or proxy. -- * 28 -> OperationTimeout: the specified time-out period was reached. data ConnectionError = CouldNotResolveHost | CouldNotConnectToServer | OperationTimeout deriving (ConnectionError -> ConnectionError -> Bool (ConnectionError -> ConnectionError -> Bool) -> (ConnectionError -> ConnectionError -> Bool) -> Eq ConnectionError forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ConnectionError -> ConnectionError -> Bool $c/= :: ConnectionError -> ConnectionError -> Bool == :: ConnectionError -> ConnectionError -> Bool $c== :: ConnectionError -> ConnectionError -> Bool Eq, ReadPrec [ConnectionError] ReadPrec ConnectionError Int -> ReadS ConnectionError ReadS [ConnectionError] (Int -> ReadS ConnectionError) -> ReadS [ConnectionError] -> ReadPrec ConnectionError -> ReadPrec [ConnectionError] -> Read ConnectionError forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [ConnectionError] $creadListPrec :: ReadPrec [ConnectionError] readPrec :: ReadPrec ConnectionError $creadPrec :: ReadPrec ConnectionError readList :: ReadS [ConnectionError] $creadList :: ReadS [ConnectionError] readsPrec :: Int -> ReadS ConnectionError $creadsPrec :: Int -> ReadS ConnectionError Read, Int -> ConnectionError -> ShowS [ConnectionError] -> ShowS ConnectionError -> String (Int -> ConnectionError -> ShowS) -> (ConnectionError -> String) -> ([ConnectionError] -> ShowS) -> Show ConnectionError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ConnectionError] -> ShowS $cshowList :: [ConnectionError] -> ShowS show :: ConnectionError -> String $cshow :: ConnectionError -> String showsPrec :: Int -> ConnectionError -> ShowS $cshowsPrec :: Int -> ConnectionError -> ShowS Show)