-- |
-- 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]
(Int -> RegisteredVersions -> ShowS)
-> (RegisteredVersions -> [Char])
-> ([RegisteredVersions] -> ShowS)
-> Show RegisteredVersions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegisteredVersions -> ShowS
showsPrec :: Int -> RegisteredVersions -> ShowS
$cshow :: RegisteredVersions -> [Char]
show :: RegisteredVersions -> [Char]
$cshowList :: [RegisteredVersions] -> ShowS
showList :: [RegisteredVersions] -> ShowS
Show,RegisteredVersions -> RegisteredVersions -> Bool
(RegisteredVersions -> RegisteredVersions -> Bool)
-> (RegisteredVersions -> RegisteredVersions -> Bool)
-> Eq RegisteredVersions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegisteredVersions -> RegisteredVersions -> Bool
== :: RegisteredVersions -> RegisteredVersions -> Bool
$c/= :: RegisteredVersions -> RegisteredVersions -> Bool
/= :: RegisteredVersions -> RegisteredVersions -> Bool
Eq,Eq RegisteredVersions
Eq RegisteredVersions =>
(RegisteredVersions -> RegisteredVersions -> Ordering)
-> (RegisteredVersions -> RegisteredVersions -> Bool)
-> (RegisteredVersions -> RegisteredVersions -> Bool)
-> (RegisteredVersions -> RegisteredVersions -> Bool)
-> (RegisteredVersions -> RegisteredVersions -> Bool)
-> (RegisteredVersions -> RegisteredVersions -> RegisteredVersions)
-> (RegisteredVersions -> RegisteredVersions -> RegisteredVersions)
-> Ord 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
$ccompare :: RegisteredVersions -> RegisteredVersions -> Ordering
compare :: RegisteredVersions -> RegisteredVersions -> Ordering
$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
>= :: RegisteredVersions -> RegisteredVersions -> Bool
$cmax :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
max :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
$cmin :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
min :: RegisteredVersions -> RegisteredVersions -> RegisteredVersions
Ord)

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

parsePreferredVersionsJSON :: BSL.ByteString -> Either ErrorMsg RegisteredVersions
parsePreferredVersionsJSON :: ByteString -> Either [Char] RegisteredVersions
parsePreferredVersionsJSON = ([Char] -> Either [Char] RegisteredVersions)
-> (RegisteredVersions -> Either [Char] RegisteredVersions)
-> Either [Char] RegisteredVersions
-> Either [Char] RegisteredVersions
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[Char]
e -> [Char] -> Either [Char] RegisteredVersions
forall a b. a -> Either a b
Left ([Char]
"Decoding preferred versions error: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e)) RegisteredVersions -> Either [Char] RegisteredVersions
forall a b. b -> Either a b
Right (Either [Char] RegisteredVersions
 -> Either [Char] RegisteredVersions)
-> (ByteString -> Either [Char] RegisteredVersions)
-> ByteString
-> Either [Char] RegisteredVersions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] RegisteredVersions
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
  [] -> Maybe Version
forall a. Maybe a
Nothing
  (Version
v : [Version]
_) -> Version -> Maybe 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 = (OurHttpException -> IO (Either [Char] RegisteredVersions))
-> IO (Either [Char] RegisteredVersions)
-> IO (Either [Char] RegisteredVersions)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle OurHttpException -> IO (Either [Char] RegisteredVersions)
handler (IO (Either [Char] RegisteredVersions)
 -> IO (Either [Char] RegisteredVersions))
-> IO (Either [Char] RegisteredVersions)
-> IO (Either [Char] RegisteredVersions)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] RegisteredVersions
parsePreferredVersionsJSON (ByteString -> Either [Char] RegisteredVersions)
-> IO ByteString -> IO (Either [Char] RegisteredVersions)
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/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
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 -> Either [Char] RegisteredVersions
-> IO (Either [Char] RegisteredVersions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] RegisteredVersions
 -> IO (Either [Char] RegisteredVersions))
-> Either [Char] RegisteredVersions
-> IO (Either [Char] RegisteredVersions)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] RegisteredVersions
forall a b. a -> Either a b
Left [Char]
err
    Just Int
code -> case Int
code of
      Int
404 -> Either [Char] RegisteredVersions
-> IO (Either [Char] RegisteredVersions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] RegisteredVersions
 -> IO (Either [Char] RegisteredVersions))
-> Either [Char] RegisteredVersions
-> IO (Either [Char] RegisteredVersions)
forall a b. (a -> b) -> a -> b
$ RegisteredVersions -> Either [Char] RegisteredVersions
forall a b. b -> Either a b
Right (RegisteredVersions -> Either [Char] RegisteredVersions)
-> RegisteredVersions -> Either [Char] RegisteredVersions
forall a b. (a -> b) -> a -> b
$ [Version] -> RegisteredVersions
RegisteredVersions []
      Int
_ -> Either [Char] RegisteredVersions
-> IO (Either [Char] RegisteredVersions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] RegisteredVersions
 -> IO (Either [Char] RegisteredVersions))
-> Either [Char] RegisteredVersions
-> IO (Either [Char] RegisteredVersions)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] RegisteredVersions
forall a b. a -> Either a b
Left [Char]
err
    where
      err :: [Char]
err = [Char]
"HTTP error while fetching versions of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" in hackage: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ OurHttpException -> [Char]
forall a. Show a => a -> [Char]
show OurHttpException
e