module RandomDotOrg (getRandomNumbers) where
import Data.Either
import Network.URI
import Network.HTTP.Simple

uri num min max 
    = concat [ "http://random.org/integers/?num="
             , show num
             , "&min="
             , show min
             , "&max="
             , show max
             , "&col=1&base=10&format=plain&rnd=new" ]

-- | Used to get a list of random numbers from http://random.org.
-- Note: the minimum must be greater than the maximum. The maximum
-- amount of numbers you can retrieve is 10,000, and the numbers 
-- themselves are limited to a range of +/- 1,000,000,000 (inclusive)
getRandomNumbers :: Int -- ^ Number of integers to get
                 -> Int -- ^ Minimum number
                 -> Int -- ^ Maximum number
                 -> IO (Either String [Int]) -- ^ Returns either an error string or the list of integers
getRandomNumbers num min max
    | max <= min           = return $ Left "err: minimum must be greater than maximum"
    | num > 10000          = return $ Left "err: can't retrieve more than 10,000 numbers"
    | abs min > 1000000000 = return $ Left "err: min can't be more/less than 1,000,000,000"
    | abs max > 1000000000 = return $ Left "err: max can't be more/less than 1,000,000,000"
    | otherwise            = do
        let uri' = parseURI (uri num min max)
        case uri' of
          Nothing -> return $ Left "err: Network.URI.parseURI returned Nothing"
          Just u  -> getResult u
 where getResult u = do
           s <- httpGet u
           case s of
             Nothing -> return $ Left "err: Network.HTTP.Simple.httpGet returned Nothing"
             Just s'  -> return $ Right (map read (lines s'))