rnhmjoj/rosa
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Indent with 2 spaces

Browse Source
This commit is contained in:
Rnhmjoj 2014-12-27 03:35:12 +01:00
parent 2535a7ee05
commit 7b025b2548
1 changed files with 39 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
Main.hs
View File

@ -1,8 +1,8 @@
{-# LANGUAGE RecordWildCards, OverloadedStrings #-} {-# LANGUAGE RecordWildCards, OverloadedStrings #-}
import Network.Wreq (get, responseBody) 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.Lens import Control.Lens
import Control.Applicative import Control.Applicative
@ -13,29 +13,29 @@ import Json
data ProgArgs = ProgArgs data ProgArgs = ProgArgs
{ name :: String { name :: String
, url :: String , url :: String
, dnschain :: Bool , dnschain :: Bool
, block :: Bool , block :: Bool
, raw :: Bool , raw :: Bool
} deriving (Show) } deriving (Show)
parser :: ParserSpec ProgArgs 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 api url" `Descr` "Use custom api url"
`andBy` boolFlag "dnschain" `Descr` "Use dnschain api" `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"
interface :: IO (CmdLnInterface ProgArgs) interface :: IO (CmdLnInterface ProgArgs)
interface = interface =
(`setAppDescr` "Query the namecoin blockchain") <$> (`setAppDescr` "Query the namecoin blockchain") <$>
(`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$> (`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$>
mkApp parser mkApp parser
main :: IO () main :: IO ()
@ -44,30 +44,31 @@ main = interface >>= flip runApp exec
exec :: ProgArgs -> IO () exec :: ProgArgs -> IO ()
exec ProgArgs{..} = do exec ProgArgs{..} = do
if dnschain if dnschain
then handleDnschain url name raw then handleDnschain url name raw
else handleLocal name block else handleLocal name block
handleLocal :: String -> Bool -> IO () handleLocal :: String -> Bool -> IO ()
handleLocal name block = do handleLocal name block = 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
jprint $ reparse (res |: "value") jprint $ reparse (res |: "value")
if block then jprint extra else return () if block then jprint extra else return ()
where where
reparse = fromJust . decode . C.pack 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"
handleDnschain :: String -> String -> Bool -> IO () handleDnschain :: String -> String -> Bool -> IO ()
handleDnschain url name raw = do 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
then print body then print body
else putStrLn $ else putStrLn $
case decode body of case decode body of
Just res -> repr res Just res -> repr res
Nothing -> "Error parsing data" Nothing -> "Error parsing data"