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)