Change default connection method

This commit is contained in:
Rnhmjoj 2014-11-25 00:20:24 +01:00
parent 8d1cb7b3ef
commit 28ec0bc1e5

29
Main.hs
View File

@ -4,7 +4,6 @@ import Network.Wreq (get, responseBody)
import Data.Aeson (decode, toJSON) import Data.Aeson (decode, toJSON)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.HashMap.Strict (delete) import Data.HashMap.Strict (delete)
import Control.Monad (when)
import Control.Lens import Control.Lens
import Control.Applicative import Control.Applicative
@ -17,7 +16,7 @@ import Json
data ProgArgs = ProgArgs data ProgArgs = ProgArgs
{ name :: String { name :: String
, url :: String , url :: String
, local :: Bool , dnschain :: Bool
, block :: Bool , block :: Bool
, raw :: Bool , raw :: Bool
} deriving (Show) } deriving (Show)
@ -26,8 +25,8 @@ parser :: ParserSpec ProgArgs
parser = ProgArgs parser = ProgArgs
`parsedBy` reqPos "name" `Descr` "Namecoin name id" `parsedBy` reqPos "name" `Descr` "Namecoin name id"
`andBy` optFlag "http://dns.dnschain.net/" "url" `andBy` optFlag "http://dns.dnschain.net/" "url"
`Descr` "Use custom dnschain API url" `Descr` "Use custom api url"
`andBy` boolFlag "local" `Descr` "Use local namecoind db" `andBy` boolFlag "dnschain" `Descr` "Use dnschain api"
`andBy` boolFlag "block" `Descr` "Show blockchain data (require local connecton)" `andBy` boolFlag "block" `Descr` "Show blockchain data (require local connecton)"
`andBy` boolFlag "raw" `Descr` "Print raw JSON data" `andBy` boolFlag "raw" `Descr` "Print raw JSON data"
@ -37,20 +36,20 @@ interface =
(`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$> (`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$>
mkApp parser mkApp parser
exec :: ProgArgs -> IO () handleLocal :: String -> Bool -> IO ()
exec args@ProgArgs{..} = handleLocal name block = do
if local
then do
out <- readProcess "namecoind" ["name_show", name] "" out <- readProcess "namecoind" ["name_show", name] ""
case decode (C.pack out) of case decode (C.pack out) of
Just res -> do Just res -> do
putStrLn (repr value) jprint $ reparse (res |: "value")
when block $ putStrLn (repr extra) if block then jprint extra else return ()
where where
value = fromJust . decode . C.pack $ res |: "value" reparse = fromJust . decode . C.pack
extra = toJSON $ delete "value" res extra = toJSON $ delete "value" res
Nothing -> putStrLn "Error parsing data" Nothing -> putStrLn "Error parsing data"
else do
handleDnschain :: String -> String -> Bool -> IO ()
handleDnschain url name raw = do
req <- get (url ++ name) req <- get (url ++ name)
let body = req ^. responseBody let body = req ^. responseBody
if raw if raw
@ -60,5 +59,11 @@ exec args@ProgArgs{..} =
Just res -> repr res Just res -> repr res
Nothing -> "Error parsing data" Nothing -> "Error parsing data"
exec :: ProgArgs -> IO ()
exec args@ProgArgs{..} =
if dnschain
then handleDnschain url name raw
else handleLocal name block
main :: IO () main :: IO ()
main = interface >>= flip runApp exec main = interface >>= flip runApp exec