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.Maybe (fromJust)
import Data.HashMap.Strict (delete) import Data.HashMap.Strict (delete)
import Data.ByteString.Lazy.Char8 (pack) import Data.ByteString.Lazy.Char8 (pack)
import System.Console.ArgParser import Options.Applicative
import System.Process import System.Process
data ProgArgs = ProgArgs
-- * CLI interface
-- | Program arguments record
data Options = Options
{ name :: String { name :: String
, url :: String , url :: String
, dnschain :: Bool , dnschain :: Bool
, block :: Bool , block :: Bool
, raw :: Bool , raw :: Bool
} deriving (Show) }
parser :: ParserSpec ProgArgs -- | Program arguments parser
parser = ProgArgs options :: Parser Options
`parsedBy` reqPos "name" `Descr` "Namecoin name id" options = Options
`andBy` optFlag "http://dns.dnschain.net/" "url" <$> strArgument ( help "Namecoin name id" )
`Descr` "Use custom api url" <*> strOption
`andBy` boolFlag "dnschain" `Descr` "Use dnschain api" ( long "url"
`andBy` boolFlag "block" `Descr` "Show blockchain data (require local connecton)" <> short 'u'
`andBy` boolFlag "raw" `Descr` "Print raw JSON data" <> 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 :: 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 :: String -> Bool -> IO ()
doLocal name block = do doLocal name block = do
out <- readProcess "namecoin-cli" ["name_show", name] "" out <- readProcess "namecoin-cli" ["name_show", name] ""
@ -56,12 +78,14 @@ doLocal name block = do
reparse = fromJust . decode . pack reparse = fromJust . decode . pack
extra = toJSON (delete "value" res) extra = toJSON (delete "value" res)
-- | Connect to dnschain api endpoint
doDnschain :: String -> String -> Bool -> IO () doDnschain :: String -> String -> Bool -> IO ()
doDnschain url name raw = do doDnschain url name raw = do
body <- (^. responseBody) <$> get (url ++ name) body <- (^. responseBody) <$> get (url ++ name)
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"