-- |
-- 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 -> String
(Int -> RegisteredVersions -> ShowS)
-> (RegisteredVersions -> String)
-> ([RegisteredVersions] -> ShowS)
-> Show RegisteredVersions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisteredVersions] -> ShowS
$cshowList :: [RegisteredVersions] -> ShowS
show :: RegisteredVersions -> String
$cshow :: RegisteredVersions -> String
showsPrec :: Int -> RegisteredVersions -> ShowS
$cshowsPrec :: Int -> RegisteredVersions -> ShowS
Show,RegisteredVersions -> RegisteredVersions -> Bool
(RegisteredVersions -> RegisteredVersions -> Bool)
-> (RegisteredVersions -> RegisteredVersions -> Bool)
-> Eq RegisteredVersions
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
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
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
$cp1Ord :: Eq 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 -> Text -> Parser [VersionJSON]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"normal-version")
  parseJSON Value
_ = Parser RegisteredVersions
forall (f :: * -> *) a. Alternative f => f a
empty

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