src/lib/Namecoin.hs: cleanup

- Replace TemplateHaskell with DeriveGenerics for Aeson instance
- Limit exported functions
- Use qualified module names

src/lib/Namecoin.hs

@@ -1,16 +1,34 @@
--- | Namecoin utility library
+{-# LANGUAGE DeriveAnyClass #-}
-module Namecoin where
+{-# LANGUAGE DeriveGeneric  #-}
 
-import Control.Applicative         (many, (<|>))
+-- | Namecoin utility library
-import Control.Lens                (set, view)
+module Namecoin
-import Control.Exception           (SomeException, try)
+-- * JSON-RPC client
-import Prelude              hiding (error)
+( RPCRequest(..)
-import Data.Attoparsec.Text hiding (try)
+, RPCResponse(..)
-import Data.Maybe                  (fromJust)
+, RPCError(..)
-import Data.Text                   (Text, unpack)
+, rpcRequest
-import Data.Aeson
+
-import Data.Aeson.TH
+-- * Name operations
-import Network.Wreq
+, Name(..)
+, nameList
+, nameUpdate
+
+-- * Miscellanea
+, uri
+) where
+
+import Control.Applicative  (many, (<|>))
+import Control.Lens         (set, view)
+import Data.Maybe           (fromJust)
+import Data.Text            (Text, unpack)
+import Data.Aeson           (ToJSON, FromJSON, Value)
+import GHC.Generics         (Generic)
+
+import Network.Wreq                   as W
+import qualified Data.Aeson           as J
+import qualified Data.Attoparsec.Text as P
+import qualified Control.Exception    as E
 
 
 -- | Alias for types with an error message
@@ -20,36 +38,40 @@ type Error = Either String
 -- * Namecoin config parser
 
 -- | Parse a comment (line beggining with a "#")
-comment :: Parser ()
+comment :: P.Parser ()
 comment = do
-  char '#' >> takeTill isEndOfLine
+  P.char '#' >> P.takeTill P.isEndOfLine
-  endOfLine
+  P.endOfLine
   return ()
 
+
 -- | Parse an option of form
 --
 -- > key=value
-setting :: Parser (Text, Text)
+setting :: P.Parser (Text, Text)
 setting = do
-  name <- takeTill (== '=')
+  name <- P.takeTill (== '=')
-  char '='
+  P.char '='
-  value <- takeTill isEndOfLine
+  value <- P.takeTill P.isEndOfLine
-  endOfLine
+  P.endOfLine
   return (name, value)
 
+
 -- | Parse a line (either a comment or an option)
-line :: Parser (Text, Text)
+line :: P.Parser (Text, Text)
 line = (comment >> line) <|> setting
 
+
 -- | Parse the namecoin config format
-config :: Parser [(Text, Text)]
+config :: P.Parser [(Text, Text)]
 config = many line
 
+
 -- | Takes the content of a namecoin config file
 -- and gives the URI to connect to the JSON-RPC server
 uri :: Text -> Error String
 uri content = do
-  dict     <- parseOnly config content
+  dict     <- P.parseOnly config content
   username <- get dict "rpcuser"
   password <- get dict "rpcpassword"
   address  <- get dict "rpcbind"
@@ -64,64 +86,65 @@ uri content = do
 
 -- | JSON-RPC 1.0 request record
 data RPCRequest = RPCRequest
-  { id      :: String   -- ^ a string identificating the client
+  { id      :: String    -- ^ a string identificating the client
-  , method  :: String   -- ^ the name of the method
+  , method  :: String    -- ^ the name of the method
-  , params  :: [String] -- ^ a list of parameters for the method
+  , params  :: [String]  -- ^ a list of parameters for the method
-  }
+  } deriving (Generic, FromJSON, ToJSON)
+
 
 -- | JSON-RPC 1.0 response record
 data RPCResponse = RPCResponse
-  { id      :: String          -- ^ the same identificative string 
+  { id       :: String          -- ^ the same identificative string 
-  , result  :: Value           -- ^ result if the method call succeded
+  , result   :: Value           -- ^ result if the method call succeded
-  , error   :: Maybe RPCError  -- ^ error in case the method call failed
+  , rpcError :: Maybe RPCError  -- ^ error in case the method call failed
-  }
+  } deriving (Generic, FromJSON, ToJSON)
+
 
 -- | Namecoin API error record
 data RPCError = RPCError
   { code    :: Int     -- ^ a number indicating the kind of error
   , message :: String  -- ^ a detailed explanation of the error
-  }
+  } deriving (Generic, FromJSON, ToJSON)
+
 
 -- | Namecoin API Value record
 data Name = Name
-  { name       :: String -- ^ the namecoin name
+  { name       :: String  -- ^ the namecoin name
-  , value      :: String -- ^ its value
+  , value      :: String  -- ^ its value
-  , expires_in :: Int    -- ^ number of blocks before the name expires
+  , expires_in :: Int     -- ^ number of blocks before the name expires
-  } deriving (Show)
+  } deriving (Show, Generic, FromJSON)
 
-deriveJSON defaultOptions ''RPCRequest
-deriveJSON defaultOptions ''RPCResponse
-deriveJSON defaultOptions ''RPCError
-deriveJSON defaultOptions ''Name
 
 -- | Turn an Aeson AST object into a 'fromJSON' type
 decodeValue :: FromJSON a => Value -> Error a
-decodeValue = eitherDecode . encode
+decodeValue = J.eitherDecode . J.encode
+
 
 -- | Execute an RPC method
 rpcRequest
-  :: String               -- ^ the URI of the JSON-RPC endpoint
+  :: String            -- ^ the URI of the JSON-RPC endpoint
-  -> String               -- ^ the method name
+  -> String            -- ^ the method name
-  -> [String]             -- ^ the method parameters
+  -> [String]          -- ^ the method parameters
-  -> IO (Error Value)     -- ^ and error or the wanted result
+  -> IO (Error Value)  -- ^ and error or the wanted result
 rpcRequest uri method params = do
-  req <- try (view responseBody <$> (asJSON =<< postWith options uri req))
+  req <- E.try (view W.responseBody <$> (W.asJSON =<< W.postWith options uri req))
   return $ case req of
-    Left  err -> Left ("RPC error: "++show (err :: SomeException))
+    Left  err -> Left ("RPC error: "++show (err :: E.SomeException))
-    Right res -> case (error res) of
+    Right res -> case (rpcError res) of
       Nothing  -> Right (result res)
       Just err -> Left  ("API error "++show (code err)++": "++message err)
   where
-    req = toJSON (RPCRequest "namecoin-update" method params)
+    req = J.toJSON (RPCRequest "namecoin-update" method params)
     options = set checkResponse (Just $ \_ _ -> return ()) defaults
 
 
 -- * Name operations
 
--- | Return the list of currently registered names
+-- | Returns the list of currently registered names
 nameList :: String -> IO (Error [Name])
 nameList uri = fmap (decodeValue =<<) (rpcRequest uri "name_list" [])
 
+
 -- | Issue an udpate for a name (confirming its current value)
 nameUpdate :: String -> Name -> IO Int
 nameUpdate uri (Name {..}) = do
@@ -130,4 +153,3 @@ nameUpdate uri (Name {..}) = do
   case req of
     Left  err -> putStrLn "failed" >> putStrLn err >> return 1
     Right _   -> putStrLn "ok" >> return 1
-