replaceable backend and test prototype

diff --git a/NmcDom.hs b/NmcDom.hs
index b975522095ef4416ab79741f621c381ae250e1fa..f2ad26f3f1e6ec793e2229633c622c3b85287408 100644 (file)
--- 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 (file)
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 (file)
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
+