-- |
-- Module: Staversion.Internal.BuildPlan.Hackage
-- Description: (virtual) BuildPlan expressing the latest Hackage
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
module Staversion.Internal.BuildPlan.Hackage
       ( -- * entry API
         RegisteredVersions,
         fetchPreferredVersions,
         latestVersion,
         -- * low-level API
         parsePreferredVersionsJSON
       ) where

import Control.Applicative ((<$>), empty)
import qualified Control.Exception as Exception
import Data.Aeson (FromJSON(..), Value(..), (.:), eitherDecode)
import qualified Data.ByteString.Lazy as BSL
import Data.List (sort, reverse)
import Data.Text (unpack)

import Staversion.Internal.BuildPlan.Version (unVersionJSON)
import Staversion.Internal.Query (ErrorMsg, PackageName)
import Staversion.Internal.HTTP (Manager, fetchURL, OurHttpException, asStatusFailureException)
import Staversion.Internal.Version (Version)

data RegisteredVersions = RegisteredVersions { RegisteredVersions -> [Version]
regPreferredVersions :: [Version]
                                               -- ^ Sorted list of preferred versions of the package.
                                               -- The head is the latest.
                                             }
                          deriving (Int -> RegisteredVersions -> ShowS
[RegisteredVersions] -> ShowS
RegisteredVersions -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RegisteredVersions] -> ShowS
$cshowList :: [RegisteredVersions] -> ShowS
show :: RegisteredVersions -> [Char]
$cshow :: RegisteredVersions -> [Char]
showsPrec :: Int -> RegisteredVersions -> ShowS
$cshowsPrec :: Int -> RegisteredVersions -> ShowS
Show,RegisteredVersions -> RegisteredVersions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisteredVersions -> RegisteredVersions -> Bool
$c/= :: RegisteredVersions -> RegisteredVersions -> Bool
== :: RegisteredVersions -> RegisteredVersions -> Bool
$c== :: RegisteredVersions -> RegisteredVersions -> Bool
Eq,Eq RegisteredVersions
RegisteredVersions -> RegisteredVersions -> Bool
RegisteredVersions -> RegisteredVersions -> Ordering
RegisteredVersions -> RegisteredVersions -> RegisteredVersions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
$cmin :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
max :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
$cmax :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
>= :: RegisteredVersions -> RegisteredVersions -> Bool
$c>= :: RegisteredVersions -> RegisteredVersions -> Bool
> :: RegisteredVersions -> RegisteredVersions -> Bool
$c> :: RegisteredVersions -> RegisteredVersions -> Bool
<= :: RegisteredVersions -> RegisteredVersions -> Bool
$c<= :: RegisteredVersions -> RegisteredVersions -> Bool
< :: RegisteredVersions -> RegisteredVersions -> Bool
$c< :: RegisteredVersions -> RegisteredVersions -> Bool
compare :: RegisteredVersions -> RegisteredVersions -> Ordering
$ccompare :: RegisteredVersions -> RegisteredVersions -> Ordering
Ord)

instance FromJSON RegisteredVersions where
  parseJSON :: Value -> Parser RegisteredVersions
parseJSON (Object Object
o) = ([Version] -> RegisteredVersions
RegisteredVersions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map VersionJSON -> Version
unVersionJSON) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"normal-version")
  parseJSON Value
_ = forall (f :: * -> *) a. Alternative f => f a
empty

parsePreferredVersionsJSON :: BSL.ByteString -> Either ErrorMsg RegisteredVersions
parsePreferredVersionsJSON :: ByteString -> Either [Char] RegisteredVersions
parsePreferredVersionsJSON = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
e -> forall a b. a -> Either a b
Left ([Char]
"Decoding preferred versions error: " forall a. [a] -> [a] -> [a]
++ [Char]
e)) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode

latestVersion :: RegisteredVersions -> Maybe Version
latestVersion :: RegisteredVersions -> Maybe Version
latestVersion RegisteredVersions
rvers = case RegisteredVersions -> [Version]
regPreferredVersions RegisteredVersions
rvers of
  [] -> forall a. Maybe a
Nothing
  (Version
v : [Version]
_) -> forall a. a -> Maybe a
Just Version
v

fetchPreferredVersions :: Manager -> PackageName -> IO (Either ErrorMsg RegisteredVersions)
fetchPreferredVersions :: Manager -> PackageName -> IO (Either [Char] RegisteredVersions)
fetchPreferredVersions Manager
man PackageName
text_name = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle OurHttpException -> IO (Either [Char] RegisteredVersions)
handler forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] RegisteredVersions
parsePreferredVersionsJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager -> [Char] -> IO ByteString
fetchURL Manager
man [Char]
url where
  name :: [Char]
name = PackageName -> [Char]
unpack PackageName
text_name
  url :: [Char]
url = [Char]
"http://hackage.haskell.org/package/" forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"/preferred.json"
  handler :: OurHttpException -> IO (Either ErrorMsg RegisteredVersions)
  handler :: OurHttpException -> IO (Either [Char] RegisteredVersions)
handler OurHttpException
e = case OurHttpException -> Maybe Int
asStatusFailureException OurHttpException
e of
    Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [Char]
err
    Just Int
code -> case Int
code of
      Int
404 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [Version] -> RegisteredVersions
RegisteredVersions []
      Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [Char]
err
    where
      err :: [Char]
err = [Char]
"HTTP error while fetching versions of " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" in hackage: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show OurHttpException
e