fixer-0.0.0.0: A Haskell client for http://fixer.io/

Safe HaskellNone
LanguageHaskell2010

Fixer

Contents

Description

The top-level API for the Haskell Fixer client.

There is an example usage in the README file.

Synopsis

Documentation

data FClient a Source #

A client function

Instances

Monad FClient Source # 

Methods

(>>=) :: FClient a -> (a -> FClient b) -> FClient b #

(>>) :: FClient a -> FClient b -> FClient b #

return :: a -> FClient a #

fail :: String -> FClient a #

Functor FClient Source # 

Methods

fmap :: (a -> b) -> FClient a -> FClient b #

(<$) :: a -> FClient b -> FClient a #

Applicative FClient Source # 

Methods

pure :: a -> FClient a #

(<*>) :: FClient (a -> b) -> FClient a -> FClient b #

liftA2 :: (a -> b -> c) -> FClient a -> FClient b -> FClient c #

(*>) :: FClient a -> FClient b -> FClient b #

(<*) :: FClient a -> FClient b -> FClient a #

MonadIO FClient Source # 

Methods

liftIO :: IO a -> FClient a #

autoRunFixerClient :: FClient a -> IO (Either ServantError a) Source #

Run a FClient action and figure out the ClientEnv and FixerCache arguments automatically.

This is probably the function you want to use

data RatesResult Source #

The result of calling the API the local cache

Constructors

DateNotInPast

because you tried to call the API for a future date

RateDoesNotExist

because the date is on a weekend, for example

RatesFound Rates 

Instances

Eq RatesResult Source # 
Show RatesResult Source # 
Generic RatesResult Source # 

Associated Types

type Rep RatesResult :: * -> * #

Validity RatesResult Source # 
type Rep RatesResult Source # 
type Rep RatesResult = D1 * (MetaData "RatesResult" "Fixer.Client" "fixer-0.0.0.0-KyDvPt0WkGj3Gzgyze5650" False) ((:+:) * (C1 * (MetaCons "DateNotInPast" PrefixI False) (U1 *)) ((:+:) * (C1 * (MetaCons "RateDoesNotExist" PrefixI False) (U1 *)) (C1 * (MetaCons "RatesFound" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Rates)))))

getLatest :: Maybe Currency -> Maybe Symbols -> FClient RatesResult Source #

Get the latest rates.

Note that this function fetches the latest rates, but that does not mean that the latest symbols appeared on the current date. However, there is no way to predict what date the last rates appeared on, so we still look in the cache at the current date. For maximum cache hits, use getAtDate and only look at the past beyond the last three days.

getAtDate :: Day -> Maybe Currency -> Maybe Symbols -> FClient RatesResult Source #

Get the rates at a specific date.

withFileCache :: FilePath -> FClient a -> FClient a Source #

Declare that we want to use the given file as a persistent cache.

Note that FClient will still use a per-run cache if this function is not used. This function only makes sure that the cache is persistent accross runs.

withFileCache path func = do
   readCacheFromFileIfExists path
   r <- func
   flushCacheToFile path
   pure r

Types

data Currency Source #

A sum-type of the supported currencies on fixer.io

Constructors

AUD 
BGN 
BRL 
CAD 
CHF 
CNY 
CZK 
DKK 
EUR 
GBP 
HKD 
HRK 
HUF 
IDR 
ILS 
INR 
JPY 
KRW 
MXN 
MYR 
NOK 
NZD 
PHP 
PLN 
RON 
RUB 
SEK 
SGD 
THB 
TRY 
USD 
ZAR 

Instances

Bounded Currency Source # 
Enum Currency Source # 
Eq Currency Source # 
Ord Currency Source # 
Read Currency Source # 
Show Currency Source # 
Generic Currency Source # 

Associated Types

type Rep Currency :: * -> * #

Methods

from :: Currency -> Rep Currency x #

to :: Rep Currency x -> Currency #

ToJSON Currency Source # 
ToJSONKey Currency Source # 
FromJSON Currency Source # 
FromJSONKey Currency Source # 
ToHttpApiData Currency Source # 
Validity Currency Source # 
type Rep Currency Source # 
type Rep Currency = D1 * (MetaData "Currency" "Fixer.Types" "fixer-0.0.0.0-KyDvPt0WkGj3Gzgyze5650" False) ((:+:) * ((:+:) * ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "AUD" PrefixI False) (U1 *)) (C1 * (MetaCons "BGN" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "BRL" PrefixI False) (U1 *)) (C1 * (MetaCons "CAD" PrefixI False) (U1 *)))) ((:+:) * ((:+:) * (C1 * (MetaCons "CHF" PrefixI False) (U1 *)) (C1 * (MetaCons "CNY" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "CZK" PrefixI False) (U1 *)) (C1 * (MetaCons "DKK" PrefixI False) (U1 *))))) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "EUR" PrefixI False) (U1 *)) (C1 * (MetaCons "GBP" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "HKD" PrefixI False) (U1 *)) (C1 * (MetaCons "HRK" PrefixI False) (U1 *)))) ((:+:) * ((:+:) * (C1 * (MetaCons "HUF" PrefixI False) (U1 *)) (C1 * (MetaCons "IDR" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "ILS" PrefixI False) (U1 *)) (C1 * (MetaCons "INR" PrefixI False) (U1 *)))))) ((:+:) * ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "JPY" PrefixI False) (U1 *)) (C1 * (MetaCons "KRW" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "MXN" PrefixI False) (U1 *)) (C1 * (MetaCons "MYR" PrefixI False) (U1 *)))) ((:+:) * ((:+:) * (C1 * (MetaCons "NOK" PrefixI False) (U1 *)) (C1 * (MetaCons "NZD" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "PHP" PrefixI False) (U1 *)) (C1 * (MetaCons "PLN" PrefixI False) (U1 *))))) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "RON" PrefixI False) (U1 *)) (C1 * (MetaCons "RUB" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "SEK" PrefixI False) (U1 *)) (C1 * (MetaCons "SGD" PrefixI False) (U1 *)))) ((:+:) * ((:+:) * (C1 * (MetaCons "THB" PrefixI False) (U1 *)) (C1 * (MetaCons "TRY" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "USD" PrefixI False) (U1 *)) (C1 * (MetaCons "ZAR" PrefixI False) (U1 *)))))))

newtype Symbols Source #

A nonempty list of Currencys

Constructors

Symbols 

data Rate Source #

A positive and non-0 ratio

Instances

Eq Rate Source # 

Methods

(==) :: Rate -> Rate -> Bool #

(/=) :: Rate -> Rate -> Bool #

Show Rate Source # 

Methods

showsPrec :: Int -> Rate -> ShowS #

show :: Rate -> String #

showList :: [Rate] -> ShowS #

Generic Rate Source # 

Associated Types

type Rep Rate :: * -> * #

Methods

from :: Rate -> Rep Rate x #

to :: Rep Rate x -> Rate #

ToJSON Rate Source # 
FromJSON Rate Source # 
Validity Rate Source #

A rate is valid if:

  • The ratio inside is valid.
  • The ratio is not zero.
  • The ratio is normalised.
type Rep Rate Source # 
type Rep Rate = D1 * (MetaData "Rate" "Fixer.Types" "fixer-0.0.0.0-KyDvPt0WkGj3Gzgyze5650" True) (C1 * (MetaCons "Rate" PrefixI True) (S1 * (MetaSel (Just Symbol "unRate") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Ratio Natural))))

data Rates Source #

The raw response of fixer.io

Constructors

Rates 

Instances

oneRate :: Rate Source #

The identity of mulRate

mulRate :: Rate -> Rate -> Rate Source #

Multiply two rates

divRate :: Rate -> Rate -> Rate Source #

Divide one rate by another

rateToDouble :: Rate -> Double Source #

Convert a rate to a Double.

This may not be a lossless transformation

Re-exports

NonEmpty

data NonEmpty a :: * -> * #

Non-empty (and non-strict) list type.

Since: 4.9.0.0

Constructors

a :| [a] infixr 5 

Instances

Monad NonEmpty

Since: 4.9.0.0

Methods

(>>=) :: NonEmpty a -> (a -> NonEmpty b) -> NonEmpty b #

(>>) :: NonEmpty a -> NonEmpty b -> NonEmpty b #

return :: a -> NonEmpty a #

fail :: String -> NonEmpty a #

Functor NonEmpty

Since: 4.9.0.0

Methods

fmap :: (a -> b) -> NonEmpty a -> NonEmpty b #

(<$) :: a -> NonEmpty b -> NonEmpty a #

MonadFix NonEmpty

Since: 4.9.0.0

Methods

mfix :: (a -> NonEmpty a) -> NonEmpty a #

Applicative NonEmpty

Since: 4.9.0.0

Methods

pure :: a -> NonEmpty a #

(<*>) :: NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b #

liftA2 :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c #

(*>) :: NonEmpty a -> NonEmpty b -> NonEmpty b #

(<*) :: NonEmpty a -> NonEmpty b -> NonEmpty a #

Foldable NonEmpty

Since: 4.9.0.0

Methods

fold :: Monoid m => NonEmpty m -> m #

foldMap :: Monoid m => (a -> m) -> NonEmpty a -> m #

foldr :: (a -> b -> b) -> b -> NonEmpty a -> b #

foldr' :: (a -> b -> b) -> b -> NonEmpty a -> b #

foldl :: (b -> a -> b) -> b -> NonEmpty a -> b #

foldl' :: (b -> a -> b) -> b -> NonEmpty a -> b #

foldr1 :: (a -> a -> a) -> NonEmpty a -> a #

foldl1 :: (a -> a -> a) -> NonEmpty a -> a #

toList :: NonEmpty a -> [a] #

null :: NonEmpty a -> Bool #

length :: NonEmpty a -> Int #

elem :: Eq a => a -> NonEmpty a -> Bool #

maximum :: Ord a => NonEmpty a -> a #

minimum :: Ord a => NonEmpty a -> a #

sum :: Num a => NonEmpty a -> a #

product :: Num a => NonEmpty a -> a #

Traversable NonEmpty

Since: 4.9.0.0

Methods

traverse :: Applicative f => (a -> f b) -> NonEmpty a -> f (NonEmpty b) #

sequenceA :: Applicative f => NonEmpty (f a) -> f (NonEmpty a) #

mapM :: Monad m => (a -> m b) -> NonEmpty a -> m (NonEmpty b) #

sequence :: Monad m => NonEmpty (m a) -> m (NonEmpty a) #

ToJSON1 NonEmpty 

Methods

liftToJSON :: (a -> Value) -> ([a] -> Value) -> NonEmpty a -> Value #

liftToJSONList :: (a -> Value) -> ([a] -> Value) -> [NonEmpty a] -> Value #

liftToEncoding :: (a -> Encoding) -> ([a] -> Encoding) -> NonEmpty a -> Encoding #

liftToEncodingList :: (a -> Encoding) -> ([a] -> Encoding) -> [NonEmpty a] -> Encoding #

FromJSON1 NonEmpty 

Methods

liftParseJSON :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser (NonEmpty a) #

liftParseJSONList :: (Value -> Parser a) -> (Value -> Parser [a]) -> Value -> Parser [NonEmpty a] #

Eq1 NonEmpty

Since: 4.10.0.0

Methods

liftEq :: (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool #

Ord1 NonEmpty

Since: 4.10.0.0

Methods

liftCompare :: (a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering #

Read1 NonEmpty

Since: 4.10.0.0

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NonEmpty a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [NonEmpty a] #

liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (NonEmpty a) #

liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [NonEmpty a] #

Show1 NonEmpty

Since: 4.10.0.0

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [NonEmpty a] -> ShowS #

MonadZip NonEmpty

Since: 4.9.0.0

Methods

mzip :: NonEmpty a -> NonEmpty b -> NonEmpty (a, b) #

mzipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c #

munzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b) #

IsList (NonEmpty a)

Since: 4.9.0.0

Associated Types

type Item (NonEmpty a) :: * #

Methods

fromList :: [Item (NonEmpty a)] -> NonEmpty a #

fromListN :: Int -> [Item (NonEmpty a)] -> NonEmpty a #

toList :: NonEmpty a -> [Item (NonEmpty a)] #

Eq a => Eq (NonEmpty a) 

Methods

(==) :: NonEmpty a -> NonEmpty a -> Bool #

(/=) :: NonEmpty a -> NonEmpty a -> Bool #

Data a => Data (NonEmpty a) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> NonEmpty a -> c (NonEmpty a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (NonEmpty a) #

toConstr :: NonEmpty a -> Constr #

dataTypeOf :: NonEmpty a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (NonEmpty a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (NonEmpty a)) #

gmapT :: (forall b. Data b => b -> b) -> NonEmpty a -> NonEmpty a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NonEmpty a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NonEmpty a -> r #

gmapQ :: (forall d. Data d => d -> u) -> NonEmpty a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> NonEmpty a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> NonEmpty a -> m (NonEmpty a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> NonEmpty a -> m (NonEmpty a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> NonEmpty a -> m (NonEmpty a) #

Ord a => Ord (NonEmpty a) 

Methods

compare :: NonEmpty a -> NonEmpty a -> Ordering #

(<) :: NonEmpty a -> NonEmpty a -> Bool #

(<=) :: NonEmpty a -> NonEmpty a -> Bool #

(>) :: NonEmpty a -> NonEmpty a -> Bool #

(>=) :: NonEmpty a -> NonEmpty a -> Bool #

max :: NonEmpty a -> NonEmpty a -> NonEmpty a #

min :: NonEmpty a -> NonEmpty a -> NonEmpty a #

Read a => Read (NonEmpty a) 
Show a => Show (NonEmpty a) 

Methods

showsPrec :: Int -> NonEmpty a -> ShowS #

show :: NonEmpty a -> String #

showList :: [NonEmpty a] -> ShowS #

Generic (NonEmpty a) 

Associated Types

type Rep (NonEmpty a) :: * -> * #

Methods

from :: NonEmpty a -> Rep (NonEmpty a) x #

to :: Rep (NonEmpty a) x -> NonEmpty a #

Semigroup (NonEmpty a)

Since: 4.9.0.0

Methods

(<>) :: NonEmpty a -> NonEmpty a -> NonEmpty a #

sconcat :: NonEmpty (NonEmpty a) -> NonEmpty a #

stimes :: Integral b => b -> NonEmpty a -> NonEmpty a #

ToJSON a => ToJSON (NonEmpty a) 
FromJSON a => FromJSON (NonEmpty a) 
Validity a => Validity (NonEmpty a)

A nonempty list is valid if all the elements are valid.

See the instance for 'Validity [a]' for more information.

Generic1 * NonEmpty 

Associated Types

type Rep1 NonEmpty (f :: NonEmpty -> *) :: k -> * #

Methods

from1 :: f a -> Rep1 NonEmpty f a #

to1 :: Rep1 NonEmpty f a -> f a #

type Rep (NonEmpty a) 
type Item (NonEmpty a) 
type Item (NonEmpty a) = a
type Rep1 * NonEmpty 

Date

data Day :: * #

The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17.

Instances

Enum Day 

Methods

succ :: Day -> Day #

pred :: Day -> Day #

toEnum :: Int -> Day #

fromEnum :: Day -> Int #

enumFrom :: Day -> [Day] #

enumFromThen :: Day -> Day -> [Day] #

enumFromTo :: Day -> Day -> [Day] #

enumFromThenTo :: Day -> Day -> Day -> [Day] #

Eq Day 

Methods

(==) :: Day -> Day -> Bool #

(/=) :: Day -> Day -> Bool #

Data Day 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Day -> c Day #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Day #

toConstr :: Day -> Constr #

dataTypeOf :: Day -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Day) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day) #

gmapT :: (forall b. Data b => b -> b) -> Day -> Day #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r #

gmapQ :: (forall d. Data d => d -> u) -> Day -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Day -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Day -> m Day #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Day -> m Day #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Day -> m Day #

Ord Day 

Methods

compare :: Day -> Day -> Ordering #

(<) :: Day -> Day -> Bool #

(<=) :: Day -> Day -> Bool #

(>) :: Day -> Day -> Bool #

(>=) :: Day -> Day -> Bool #

max :: Day -> Day -> Day #

min :: Day -> Day -> Day #

Ix Day 

Methods

range :: (Day, Day) -> [Day] #

index :: (Day, Day) -> Day -> Int #

unsafeIndex :: (Day, Day) -> Day -> Int

inRange :: (Day, Day) -> Day -> Bool #

rangeSize :: (Day, Day) -> Int #

unsafeRangeSize :: (Day, Day) -> Int

ToJSON Day 
ToJSONKey Day 
FromJSON Day 
FromJSONKey Day 
NFData Day 

Methods

rnf :: Day -> () #

ToFormKey Day 

Methods

toFormKey :: Day -> Text #

FromFormKey Day 
ToHttpApiData Day
>>> toUrlPiece (fromGregorian 2015 10 03)
"2015-10-03"
FromHttpApiData Day
>>> toGregorian <$> parseUrlPiece "2016-12-01"
Right (2016,12,1)
ParseTime Day 

Methods

buildTime :: TimeLocale -> [(Char, String)] -> Maybe Day #

fromGregorian :: Integer -> Int -> Int -> Day #

Convert from proleptic Gregorian calendar. First argument is year, second month number (1-12), third day (1-31). Invalid values will be clipped to the correct range, month first, then day.