From 531dbfc03d955178e596a7cd9b87fca8bc23918e Mon Sep 17 00:00:00 2001 From: Eugene Crosser Date: Sat, 12 Apr 2014 18:56:22 +0400 Subject: [PATCH] replaceable backend and test prototype --- NmcDom.hs | 14 ++++++++++++++ data/root | 1 + test.hs | 20 ++++++++++++++++++++ 3 files changed, 35 insertions(+) create mode 100644 data/root create mode 100644 test.hs diff --git a/NmcDom.hs b/NmcDom.hs index b975522..f2ad26f 100644 --- a/NmcDom.hs +++ b/NmcDom.hs @@ -3,6 +3,7 @@ module NmcDom ( NmcDom(..) , emptyNmcDom , descendNmc + , queryDom ) where import Data.ByteString.Lazy (ByteString) @@ -158,3 +159,16 @@ mergeNmc sub dom = dom { domService = choose domService choose field = case field dom of Nothing -> field sub Just x -> Just x + +-- | Perform query and return error string or parsed domain object +queryDom :: + (ByteString -> IO (Either String ByteString)) -- ^ query operation action + -> ByteString -- ^ key + -> IO (Either String NmcDom) -- ^ error string or domain +queryDom queryOp key = do + l <- queryOp key + case l of + Left estr -> return $ Left estr + Right str -> case decode str :: Maybe NmcDom of + Nothing -> return $ Left $ "Unparseable value: " ++ (show str) + Just dom -> return $ Right dom diff --git a/data/root b/data/root new file mode 100644 index 0000000..a59957c --- /dev/null +++ b/data/root @@ -0,0 +1 @@ +{"info":{"description":"Dot-BIT Project - Official Website","registrar":"http://register.dot-bit.org"},"fingerprint":["30:B0:60:94:32:08:EC:F5:BE:DF:F4:BB:EE:52:90:2C:5D:47:62:46"],"ns":["ns0.web-sweet-web.net","ns1.web-sweet-web.net"],"map":{"":{"ns":["ns0.web-sweet-web.net","ns1.web-sweet-web.net"]}},"email":"register@dot-bit.org"} diff --git a/test.hs b/test.hs new file mode 100644 index 0000000..7c3be16 --- /dev/null +++ b/test.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Prelude hiding (readFile) +import Data.ByteString.Lazy (ByteString) +import Data.ByteString.Lazy.Char8 (unpack, readFile) +import System.IO.Error +import Control.Exception + +import NmcDom + +queryOp :: ByteString -> IO (Either String ByteString) +queryOp key = catch (readFile ("data/" ++ (unpack key)) >>= return . Right) + (\e -> return (Left (show (e :: IOException)))) + +main = do + d <- queryDom queryOp "root" + putStrLn $ show d + -- 2.39.2