{-# LANGUAGE CPP #-}
-- |
-- Module: Staversion.Internal.BuildPlan.Stackage
-- Description: dealing with Stackage and build-plan repositories online.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not use it.__
--
-- This module is meant to be exposed only to
-- "Staversion.Internal.BuildPlan" and test modules.

module Staversion.Internal.BuildPlan.Stackage
       ( -- * High level API
         ExactResolver(..),
         PartialResolver(..),
         parseResolverString,
         formatResolverString,
         formatExactResolverString,
         Disambiguator,
         fetchDisambiguator,
         -- * Low level API
         parseDisambiguator
       ) where

import Control.Monad (void)
import Control.Applicative ((<|>), (*>), (<$>), (<*>), empty, pure)
import qualified Control.Exception as Exception (handle)
import Data.Aeson (FromJSON(..), Value(..))
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.Function (on)
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (toString)
import qualified Data.Aeson.KeyMap as HM
#else
import Data.Text (unpack)
import qualified Data.HashMap.Strict as HM
#endif
import qualified Data.Map as M
import Data.Maybe (listToMaybe)
import Data.List (sortBy)
import Data.Word (Word)
import Data.IORef (IORef)
import System.IO.Error (ioError, userError)
import qualified Text.ParserCombinators.ReadP as P
import Text.Printf (printf)
import Text.Read.Lex (readDecP)

import Staversion.Internal.HTTP (Manager, fetchURL, OurHttpException)
import Staversion.Internal.Query (Resolver, ErrorMsg)

-- | Non-ambiguous fully-resolved resolver for stackage.
data ExactResolver = ExactLTS Word Word  -- ^ lts-(major).(minor)
                   | ExactNightly Word Word Word -- ^ nightly-(year)-(month)-(day)
                   deriving (Int -> ExactResolver -> ShowS
[ExactResolver] -> ShowS
ExactResolver -> [Char]
(Int -> ExactResolver -> ShowS)
-> (ExactResolver -> [Char])
-> ([ExactResolver] -> ShowS)
-> Show ExactResolver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExactResolver -> ShowS
showsPrec :: Int -> ExactResolver -> ShowS
$cshow :: ExactResolver -> [Char]
show :: ExactResolver -> [Char]
$cshowList :: [ExactResolver] -> ShowS
showList :: [ExactResolver] -> ShowS
Show,ExactResolver -> ExactResolver -> Bool
(ExactResolver -> ExactResolver -> Bool)
-> (ExactResolver -> ExactResolver -> Bool) -> Eq ExactResolver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExactResolver -> ExactResolver -> Bool
== :: ExactResolver -> ExactResolver -> Bool
$c/= :: ExactResolver -> ExactResolver -> Bool
/= :: ExactResolver -> ExactResolver -> Bool
Eq,Eq ExactResolver
Eq ExactResolver =>
(ExactResolver -> ExactResolver -> Ordering)
-> (ExactResolver -> ExactResolver -> Bool)
-> (ExactResolver -> ExactResolver -> Bool)
-> (ExactResolver -> ExactResolver -> Bool)
-> (ExactResolver -> ExactResolver -> Bool)
-> (ExactResolver -> ExactResolver -> ExactResolver)
-> (ExactResolver -> ExactResolver -> ExactResolver)
-> Ord ExactResolver
ExactResolver -> ExactResolver -> Bool
ExactResolver -> ExactResolver -> Ordering
ExactResolver -> ExactResolver -> ExactResolver
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 :: ExactResolver -> ExactResolver -> Ordering
compare :: ExactResolver -> ExactResolver -> Ordering
$c< :: ExactResolver -> ExactResolver -> Bool
< :: ExactResolver -> ExactResolver -> Bool
$c<= :: ExactResolver -> ExactResolver -> Bool
<= :: ExactResolver -> ExactResolver -> Bool
$c> :: ExactResolver -> ExactResolver -> Bool
> :: ExactResolver -> ExactResolver -> Bool
$c>= :: ExactResolver -> ExactResolver -> Bool
>= :: ExactResolver -> ExactResolver -> Bool
$cmax :: ExactResolver -> ExactResolver -> ExactResolver
max :: ExactResolver -> ExactResolver -> ExactResolver
$cmin :: ExactResolver -> ExactResolver -> ExactResolver
min :: ExactResolver -> ExactResolver -> ExactResolver
Ord)

-- | Potentially partial resolver for stackage.
data PartialResolver = PartialExact ExactResolver
                     | PartialLTSLatest -- ^ lts (latest)
                     | PartialLTSMajor Word -- ^ lts-(major)
                     | PartialNightlyLatest -- ^ nightly (latest)
                     deriving (Int -> PartialResolver -> ShowS
[PartialResolver] -> ShowS
PartialResolver -> [Char]
(Int -> PartialResolver -> ShowS)
-> (PartialResolver -> [Char])
-> ([PartialResolver] -> ShowS)
-> Show PartialResolver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialResolver -> ShowS
showsPrec :: Int -> PartialResolver -> ShowS
$cshow :: PartialResolver -> [Char]
show :: PartialResolver -> [Char]
$cshowList :: [PartialResolver] -> ShowS
showList :: [PartialResolver] -> ShowS
Show,PartialResolver -> PartialResolver -> Bool
(PartialResolver -> PartialResolver -> Bool)
-> (PartialResolver -> PartialResolver -> Bool)
-> Eq PartialResolver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PartialResolver -> PartialResolver -> Bool
== :: PartialResolver -> PartialResolver -> Bool
$c/= :: PartialResolver -> PartialResolver -> Bool
/= :: PartialResolver -> PartialResolver -> Bool
Eq,Eq PartialResolver
Eq PartialResolver =>
(PartialResolver -> PartialResolver -> Ordering)
-> (PartialResolver -> PartialResolver -> Bool)
-> (PartialResolver -> PartialResolver -> Bool)
-> (PartialResolver -> PartialResolver -> Bool)
-> (PartialResolver -> PartialResolver -> Bool)
-> (PartialResolver -> PartialResolver -> PartialResolver)
-> (PartialResolver -> PartialResolver -> PartialResolver)
-> Ord PartialResolver
PartialResolver -> PartialResolver -> Bool
PartialResolver -> PartialResolver -> Ordering
PartialResolver -> PartialResolver -> PartialResolver
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 :: PartialResolver -> PartialResolver -> Ordering
compare :: PartialResolver -> PartialResolver -> Ordering
$c< :: PartialResolver -> PartialResolver -> Bool
< :: PartialResolver -> PartialResolver -> Bool
$c<= :: PartialResolver -> PartialResolver -> Bool
<= :: PartialResolver -> PartialResolver -> Bool
$c> :: PartialResolver -> PartialResolver -> Bool
> :: PartialResolver -> PartialResolver -> Bool
$c>= :: PartialResolver -> PartialResolver -> Bool
>= :: PartialResolver -> PartialResolver -> Bool
$cmax :: PartialResolver -> PartialResolver -> PartialResolver
max :: PartialResolver -> PartialResolver -> PartialResolver
$cmin :: PartialResolver -> PartialResolver -> PartialResolver
min :: PartialResolver -> PartialResolver -> PartialResolver
Ord)

parseResolverString :: Resolver -> Maybe PartialResolver
parseResolverString :: [Char] -> Maybe PartialResolver
parseResolverString = [(PartialResolver, [Char])] -> Maybe PartialResolver
forall {b} {a}. [(b, [a])] -> Maybe b
getResult ([(PartialResolver, [Char])] -> Maybe PartialResolver)
-> ([Char] -> [(PartialResolver, [Char])])
-> [Char]
-> Maybe PartialResolver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP PartialResolver -> [Char] -> [(PartialResolver, [Char])]
forall a. ReadP a -> ReadS a
P.readP_to_S ReadP PartialResolver
parser where
  getResult :: [(b, [a])] -> Maybe b
getResult = ((b, [a]) -> b) -> Maybe (b, [a]) -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, [a]) -> b
forall a b. (a, b) -> a
fst (Maybe (b, [a]) -> Maybe b)
-> ([(b, [a])] -> Maybe (b, [a])) -> [(b, [a])] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, [a])] -> Maybe (b, [a])
forall a. [a] -> Maybe a
listToMaybe ([(b, [a])] -> Maybe (b, [a]))
-> ([(b, [a])] -> [(b, [a])]) -> [(b, [a])] -> Maybe (b, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, [a]) -> (b, [a]) -> Ordering) -> [(b, [a])] -> [(b, [a])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((b, [a]) -> Int) -> (b, [a]) -> (b, [a]) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ((b, [a]) -> [a]) -> (b, [a]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, [a]) -> [a]
forall a b. (a, b) -> b
snd))
  decimal :: ReadP Word
decimal = ReadP Word
forall a. (Eq a, Num a) => ReadP a
readDecP
  parser :: ReadP PartialResolver
parser = ReadP PartialResolver
lts ReadP PartialResolver
-> ReadP PartialResolver -> ReadP PartialResolver
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP PartialResolver
nightly
  lts :: ReadP PartialResolver
lts = [Char] -> ReadP [Char]
P.string [Char]
"lts" ReadP [Char] -> ReadP PartialResolver -> ReadP PartialResolver
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( ReadP PartialResolver
lts_exact ReadP PartialResolver
-> ReadP PartialResolver -> ReadP PartialResolver
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadP PartialResolver
lts_major ReadP PartialResolver
-> ReadP PartialResolver -> ReadP PartialResolver
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReadP ()
P.eof ReadP () -> ReadP PartialResolver -> ReadP PartialResolver
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PartialResolver -> ReadP PartialResolver
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialResolver
PartialLTSLatest) )
  lts_exact :: ReadP PartialResolver
lts_exact = do
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'-'
    Word
major <- ReadP Word
decimal
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'.'
    Word
minor <- ReadP Word
decimal
    PartialResolver -> ReadP PartialResolver
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialResolver -> ReadP PartialResolver)
-> PartialResolver -> ReadP PartialResolver
forall a b. (a -> b) -> a -> b
$ ExactResolver -> PartialResolver
PartialExact (ExactResolver -> PartialResolver)
-> ExactResolver -> PartialResolver
forall a b. (a -> b) -> a -> b
$ Word -> Word -> ExactResolver
ExactLTS Word
major Word
minor
  lts_major :: ReadP PartialResolver
lts_major = Char -> ReadP Char
P.char Char
'-' ReadP Char -> ReadP PartialResolver -> ReadP PartialResolver
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( Word -> PartialResolver
PartialLTSMajor (Word -> PartialResolver) -> ReadP Word -> ReadP PartialResolver
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Word
decimal )
  nightly :: ReadP PartialResolver
nightly = [Char] -> ReadP [Char]
P.string [Char]
"nightly" ReadP [Char] -> ReadP PartialResolver -> ReadP PartialResolver
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( ReadP PartialResolver
nightly_exact ReadP PartialResolver
-> ReadP PartialResolver -> ReadP PartialResolver
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReadP ()
P.eof ReadP () -> ReadP PartialResolver -> ReadP PartialResolver
forall a b. ReadP a -> ReadP b -> ReadP b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PartialResolver -> ReadP PartialResolver
forall a. a -> ReadP a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PartialResolver
PartialNightlyLatest) )
  nightly_exact :: ReadP PartialResolver
nightly_exact = do
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'-'
    Word
year <- ReadP Word
decimal
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'-'
    Word
month <- ReadP Word
decimal
    ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'-'
    Word
day <- ReadP Word
decimal
    PartialResolver -> ReadP PartialResolver
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialResolver -> ReadP PartialResolver)
-> PartialResolver -> ReadP PartialResolver
forall a b. (a -> b) -> a -> b
$ ExactResolver -> PartialResolver
PartialExact (ExactResolver -> PartialResolver)
-> ExactResolver -> PartialResolver
forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> ExactResolver
ExactNightly Word
year Word
month Word
day

formatResolverString :: PartialResolver -> Resolver
formatResolverString :: PartialResolver -> [Char]
formatResolverString PartialResolver
pr = case PartialResolver
pr of
  PartialExact (ExactLTS Word
major Word
minor) -> [Char]
"lts-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
major [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
minor
  PartialExact (ExactNightly Word
year Word
month Word
day) -> [Char] -> Word -> Word -> Word -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"nightly-%04d-%02d-%02d" Word
year Word
month Word
day
  PartialResolver
PartialLTSLatest -> [Char]
"lts"
  PartialLTSMajor Word
major -> [Char]
"lts-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> [Char]
forall a. Show a => a -> [Char]
show Word
major
  PartialResolver
PartialNightlyLatest -> [Char]
"nightly"

formatExactResolverString :: ExactResolver -> Resolver
formatExactResolverString :: ExactResolver -> [Char]
formatExactResolverString ExactResolver
er = PartialResolver -> [Char]
formatResolverString (PartialResolver -> [Char]) -> PartialResolver -> [Char]
forall a b. (a -> b) -> a -> b
$ ExactResolver -> PartialResolver
PartialExact ExactResolver
er

type Disambiguator = PartialResolver -> Maybe ExactResolver

-- | Fetch the 'Disambiguator' from the Internet.
fetchDisambiguator :: Manager -> IO (Either ErrorMsg Disambiguator)
fetchDisambiguator :: Manager -> IO (Either [Char] Disambiguator)
fetchDisambiguator Manager
man = (Either [Char] Disambiguator -> IO (Either [Char] Disambiguator)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] Disambiguator -> IO (Either [Char] Disambiguator))
-> (ByteString -> Either [Char] Disambiguator)
-> ByteString
-> IO (Either [Char] Disambiguator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Disambiguator -> Either [Char] Disambiguator
forall {b}. Maybe b -> Either [Char] b
toEither (Maybe Disambiguator -> Either [Char] Disambiguator)
-> (ByteString -> Maybe Disambiguator)
-> ByteString
-> Either [Char] Disambiguator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Disambiguator
parseDisambiguator) (ByteString -> IO (Either [Char] Disambiguator))
-> IO ByteString -> IO (Either [Char] Disambiguator)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Manager -> [Char] -> IO ByteString
fetchURL Manager
man [Char]
disambiguator_url where
  disambiguator_url :: [Char]
disambiguator_url = [Char]
"https://www.stackage.org/download/snapshots.json"
  toEither :: Maybe b -> Either [Char] b
toEither = Either [Char] b
-> (b -> Either [Char] b) -> Maybe b -> Either [Char] b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] b
forall a b. a -> Either a b
Left ([Char]
"Failed to parse disambiguator from" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
disambiguator_url)) b -> Either [Char] b
forall a b. b -> Either a b
Right

newtype DisamMap = DisamMap { DisamMap -> Map PartialResolver ExactResolver
unDisamMap :: M.Map PartialResolver ExactResolver }

instance FromJSON DisamMap where
  parseJSON :: Value -> Parser DisamMap
parseJSON (Object Object
o) = ([(PartialResolver, ExactResolver)] -> DisamMap)
-> Parser [(PartialResolver, ExactResolver)] -> Parser DisamMap
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map PartialResolver ExactResolver -> DisamMap
DisamMap (Map PartialResolver ExactResolver -> DisamMap)
-> ([(PartialResolver, ExactResolver)]
    -> Map PartialResolver ExactResolver)
-> [(PartialResolver, ExactResolver)]
-> DisamMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PartialResolver, ExactResolver)]
-> Map PartialResolver ExactResolver
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList) (Parser [(PartialResolver, ExactResolver)] -> Parser DisamMap)
-> Parser [(PartialResolver, ExactResolver)] -> Parser DisamMap
forall a b. (a -> b) -> a -> b
$ ((Key, Value) -> Parser (PartialResolver, ExactResolver))
-> [(Key, Value)] -> Parser [(PartialResolver, ExactResolver)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Key, Value) -> Parser (PartialResolver, ExactResolver)
parsePair ([(Key, Value)] -> Parser [(PartialResolver, ExactResolver)])
-> [(Key, Value)] -> Parser [(PartialResolver, ExactResolver)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
HM.toList Object
o
    where
    parsePair :: (Key, Value) -> Parser (PartialResolver, ExactResolver)
parsePair (Key
k,Value
v) = (,) (PartialResolver
 -> ExactResolver -> (PartialResolver, ExactResolver))
-> Parser PartialResolver
-> Parser (ExactResolver -> (PartialResolver, ExactResolver))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Parser PartialResolver
forall {f :: * -> *}.
(Alternative f, Monad f) =>
Key -> f PartialResolver
parseKey Key
k Parser (ExactResolver -> (PartialResolver, ExactResolver))
-> Parser ExactResolver -> Parser (PartialResolver, ExactResolver)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ExactResolver
parseValue Value
v
    parseKey :: Key -> f PartialResolver
parseKey Key
key = f PartialResolver
-> (PartialResolver -> f PartialResolver)
-> Maybe PartialResolver
-> f PartialResolver
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f PartialResolver
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty PartialResolver -> f PartialResolver
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PartialResolver -> f PartialResolver)
-> Maybe PartialResolver -> f PartialResolver
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe PartialResolver
parseResolverString ([Char] -> Maybe PartialResolver)
-> [Char] -> Maybe PartialResolver
forall a b. (a -> b) -> a -> b
$ Key -> [Char]
toString Key
key
    parseValue :: Value -> Parser ExactResolver
parseValue Value
v = (Maybe PartialResolver -> Parser ExactResolver
forall {m :: * -> *}.
(Monad m, Alternative m) =>
Maybe PartialResolver -> m ExactResolver
expectExact (Maybe PartialResolver -> Parser ExactResolver)
-> ([Char] -> Maybe PartialResolver)
-> [Char]
-> Parser ExactResolver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe PartialResolver
parseResolverString) ([Char] -> Parser ExactResolver)
-> Parser [Char] -> Parser ExactResolver
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser [Char]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    expectExact :: Maybe PartialResolver -> m ExactResolver
expectExact (Just (PartialExact ExactResolver
e)) = ExactResolver -> m ExactResolver
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ExactResolver
e
    expectExact Maybe PartialResolver
_ = m ExactResolver
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
#if !MIN_VERSION_aeson(2,0,0)
    toString = unpack
#endif
  parseJSON Value
_ = Parser DisamMap
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

parseDisambiguator :: BSL.ByteString -- ^ disambiguation JSON text.
                   -> Maybe Disambiguator
parseDisambiguator :: ByteString -> Maybe Disambiguator
parseDisambiguator ByteString
input = DisamMap -> Disambiguator
toDisam (DisamMap -> Disambiguator)
-> Maybe DisamMap -> Maybe Disambiguator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe DisamMap
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
input where
  toDisam :: DisamMap -> Disambiguator
toDisam DisamMap
_ (PartialExact ExactResolver
e) = ExactResolver -> Maybe ExactResolver
forall a. a -> Maybe a
Just ExactResolver
e
  toDisam DisamMap
dis_map PartialResolver
key = PartialResolver
-> Map PartialResolver ExactResolver -> Maybe ExactResolver
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PartialResolver
key (DisamMap -> Map PartialResolver ExactResolver
unDisamMap DisamMap
dis_map)