Switch to optparse-applicative

This commit is contained in:
rnhmjoj 2016-05-05 17:55:34 +02:00
parent 1e49f95847
commit a1837d70fe
No known key found for this signature in database
GPG Key ID: 362BB82B7E496B7C

View File

@ -9,41 +9,63 @@ import Data.Aeson (decode, toJSON)
import Data.Maybe (fromJust)
import Data.HashMap.Strict (delete)
import Data.ByteString.Lazy.Char8 (pack)
import System.Console.ArgParser
import Options.Applicative
import System.Process
data ProgArgs = ProgArgs
-- * CLI interface
-- | Program arguments record
data Options = Options
{ name :: String
, url :: String
, dnschain :: Bool
, block :: Bool
, raw :: Bool
} deriving (Show)
}
parser :: ParserSpec ProgArgs
parser = ProgArgs
`parsedBy` reqPos "name" `Descr` "Namecoin name id"
`andBy` optFlag "http://dns.dnschain.net/" "url"
`Descr` "Use custom api url"
`andBy` boolFlag "dnschain" `Descr` "Use dnschain api"
`andBy` boolFlag "block" `Descr` "Show blockchain data (require local connecton)"
`andBy` boolFlag "raw" `Descr` "Print raw JSON data"
-- | Program arguments parser
options :: Parser Options
options = Options
<$> strArgument ( help "Namecoin name id" )
<*> strOption
( long "url"
<> short 'u'
<> value "http://dns.dnschain.net/"
<> metavar "URL"
<> help "Use custom api url" )
<*> switch
( long "dnschain"
<> short 'd'
<> help "Use dnschain api")
<*> switch
( long "block"
<> short 'b'
<> help "Show blockchain data (require local connection)")
<*> switch
( long "raw"
<> short 'r'
<> help "Print raw JSON data")
interface :: IO (CmdLnInterface ProgArgs)
interface =
(`setAppDescr` "Query the namecoin blockchain") .
(`setAppEpilog` "Stat rosa pristina nomine, nomina nuda tenemus.") <$>
mkApp parser
-- | Program description
description :: ParserInfo Options
description = info (helper <*> options)
( fullDesc
<> progDesc "Query the namecoin blockchain"
<> footer "Stat rosa pristina nomine, nomina nuda tenemus." )
-- | Main function
main :: IO ()
main = interface >>= flip runApp exec
main = execParser description >>= exec where
exec Options{..} =
if dnschain
then doDnschain url name raw
else doLocal name block
exec :: ProgArgs -> IO ()
exec ProgArgs{..} =
if dnschain
then doDnschain url name raw
else doLocal name block
-- | Connect to local namecoin node
doLocal :: String -> Bool -> IO ()
doLocal name block = do
out <- readProcess "namecoin-cli" ["name_show", name] ""
@ -56,12 +78,14 @@ doLocal name block = do
reparse = fromJust . decode . pack
extra = toJSON (delete "value" res)
-- | Connect to dnschain api endpoint
doDnschain :: String -> String -> Bool -> IO ()
doDnschain url name raw = do
body <- (^. responseBody) <$> get (url ++ name)
if raw
then print body
else putStrLn $
case decode body of
Just res -> repr res
Nothing -> "Error parsing data"
then print body
else putStrLn $
case decode body of
Just res -> repr res
Nothing -> "Error parsing data"