packages feed

eurofxref (empty) → 0.1.0

raw patch · 5 files changed

+208/−0 lines, 5 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, enumerator, failure, hexpat, http-enumerator, http-types, mtl, time

Files

+ Financial/CurrencyRates.hs view
@@ -0,0 +1,23 @@+module Financial.CurrencyRates where++import Data.Map (Map)+import qualified Data.Map as M+import Data.Time.Clock++-- | A standard three-letter currency name.+newtype Currency = Currency String deriving (Eq, Show, Read, Ord)++-- | A table of currency rates.+data Rates a = Rates {+        raReference :: Currency,  -- ^ The reference currency+        raTime      :: UTCTime,   -- ^ The time when the rates were valid+        raRates     :: Map Currency a  -- ^ Value of one unit of the reference currency in each currency+    }++-- | Re-base the rates to a more dependable reference currency, such as the New+-- Zealand dollar.+rebase :: Fractional a => Currency -> Rates a -> Rates a+rebase new (Rates old t m) = Rates new t $ case new `M.lookup` m of+    Just newRate -> M.map (/newRate) . M.insert old 1 $ m+    Nothing      -> M.empty+
+ Financial/EuroFXRef.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}+-- | Example using ghci, where we read the currency rates relative to Euros, and re-base+-- them to hard currency.+--+-- > > :m Financial.EuroFXRef Data.Map+-- > > fmap (assocs . raRates . rebase (Currency "NZD")) fetch :: IO [(Currency, Double)]+-- > [(Currency "AUD",0.7696441703909034),(Currency "BGN",1.1064094586185438),...+--+-- Each number is one unit of the reference currency in that currency,+-- e.g. in this example NZD 1 == AUD 0.77.++module Financial.EuroFXRef (+        -- * Simple+        fetch,+        -- * Lower-level+        europeanCentralBankDaily,+        fetchFrom,+        parseEuropeanCentralBank,+        module Financial.CurrencyRates+    ) where++import Financial.CurrencyRates++import Control.Applicative+import Control.Arrow (second, first)+import Control.Exception+import Control.Failure+import Control.Monad.State.Strict+import qualified Data.ByteString as B+import Data.Enumerator (Iteratee (..), run_)+import Data.Enumerator.List (consume)+import qualified Data.Map as M+import Data.Monoid+import Data.Time.Calendar+import Data.Time.Clock+import Data.Typeable+import Network.HTTP.Enumerator as HTTP+import Network.HTTP.Types as HTTP+import Text.XML.Expat.Tree++-- | calendar time YYYYMMDDHHMMSS to posix microseconds +cal2utc :: (Int, Int, Int, Int, Int, Int) -> UTCTime+cal2utc (y,m,d,hh,mm,ss) =+    let ymd = toModifiedJulianDay $ fromGregorian (fromIntegral y) (fromIntegral m) (fromIntegral d)+    in  UTCTime+            (ModifiedJulianDay $ fromIntegral ymd)+            (fromIntegral $ hh * 3600 + mm * 60 + ss)++maybeRead :: Read a => String -> Maybe a+maybeRead str = case reads str of+    [(a, "")] -> Just a+    _         -> Nothing++-- | An exception indicating a parse error in the parsing of European Central Bank.+data EuropeanCentralBankException =+    ECBXMLParseException XMLParseError |+    ECBHttpException HttpException |+    ECBHttpStatusException HTTP.Status |+    ECBParseException String +    deriving (Show, Typeable)++instance Exception EuropeanCentralBankException where++-- | Parse the European Central Bank's XML format.+parseEuropeanCentralBank :: Read a => UNode String -> Either String (Rates a)+parseEuropeanCentralBank (Element _ _ chs) =+    case execStateT (mapM_ p2 chs) (Nothing, M.empty) of+        Right (Just time, rates) -> Right $ Rates euro time rates+        Right (Nothing, _)       -> Left $ "time stamp is missing"+        Left err                 -> Left err+  where+    euro = Currency "EUR"+    p2 (Element "Cube" _ chs) = mapM_ p3 chs+    p2 _                 = return ()+    p3 e@(Element "Cube" _ chs) = do+        case getAttribute e "time" of+            Just tstr -> case words (map (\x -> if x == '-' then ' ' else x) tstr) of+                [ys, ms, ds] -> case (maybeRead ys, maybeRead ms, maybeRead ds) of+                    (Just y, Just m, Just d) -> modify $ first $ const $ Just $ cal2utc (y, m, d, 0, 0, 0)+                    _ -> lift $ fail $ "bad time: " ++ tstr+                _ -> lift $ fail $ "bad time: " ++ tstr+            Nothing -> lift $ fail "missing time"+        mapM_ p4 chs+    p3 _                 = return ()+    p4 e@(Element "Cube" _ _) = case (getAttribute e "currency", join $ maybeRead <$> getAttribute e "rate") of+        (Just cur, Just rate) -> modify $ second $ M.insert (Currency cur) rate+        _                     -> return ()+    p4 _                 = return ()+parseEuropeanCentralBank _ = Left "element expected at top level"++-- | The URL for the European Central Bank's free daily reference rates.+europeanCentralBankDaily :: Failure HttpException m => m (HTTP.Request m)+europeanCentralBankDaily = parseUrl "http://www.ecb.int/stats/eurofxref/eurofxref-daily.xml"++-- | Fetch from a specified URL.+fetchFrom :: (Failure EuropeanCentralBankException m, Failure HttpException m, MonadIO m, Read a) =>+             HTTP.Request m+          -> m (Rates a)+fetchFrom req = do+    mgr <- liftIO newManager+    run_ $ httpRedirect req processResponse mgr++processResponse :: (Failure EuropeanCentralBankException m, Read a) =>+                   HTTP.Status+                -> ResponseHeaders+                -> Iteratee B.ByteString m (Rates a)+processResponse status@(Status statusCode _) headers = do+    body <- mconcat <$> consume+    case statusCode of+        200 -> do+            case parse' defaultParseOptions body of+                Left err -> lift $ failure $ ECBXMLParseException err+                Right xml ->+                    case parseEuropeanCentralBank xml of+                        Left err -> lift $ failure $ ECBParseException err+                        Right rates -> return rates+        _ -> lift $ failure $ ECBHttpStatusException status++-- | Fetch daily currency rates from European Central Bank server.+--+-- 'IO' works for @m@ and 'Double' for @a@.+fetch :: (Failure EuropeanCentralBankException m, Failure HttpException m, MonadIO m, Read a) =>+         m (Rates a)+fetch = fetchFrom =<< europeanCentralBankDaily+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Stephen Blackheath++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Stephen Blackheath nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ eurofxref.cabal view
@@ -0,0 +1,28 @@+name: eurofxref+version: 0.1.0+cabal-version: >=1.6+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: Copyright (C) 2011 by Stephen Blackheath+maintainer: http://blacksapphire.com/antispam/+stability: Beta+homepage:+package-url:+bug-reports:+synopsis: Free foreign exchange/currency feed from the European Central Bank+description:+    A Haskell API for the the European Central Bank's free daily currency reference rates.+category: Finance+author: Stephen Blackheath++Library+    build-depends: base >=4 && <5, bytestring == 0.9.*, containers >= 0.2 && < 0.5,+                   enumerator >= 0.4.7 && < 0.5, failure == 0.1.*, http-enumerator == 0.6.*,+                   http-types == 0.6.*, hexpat >= 0.19.6 && < 0.20, mtl < 2.1,+                   time == 1.2.*+    exposed-modules: Financial.CurrencyRates, Financial.EuroFXRef+    exposed: True+    buildable: True+    ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-orphans+