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

Safe HaskellNone
LanguageHaskell2010

Fixer.Client

Description

The transparently caching client

Synopsis

Documentation

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

defaultConfig :: Config Source #

A default configuration for the client: One second of delay between calls

runFixerClient :: FEnv -> ClientEnv -> FClient a -> IO (Either ServantError a) Source #

Run a FClient action with full control over the inputs.

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 #

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.

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)))))

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

readCacheFromFileIfExists :: FilePath -> FClient () Source #

Read a persistent cache from the given file if that file exists.

flushCacheToFile :: FilePath -> FClient () Source #

Flush the currently gathered cache to the given file.