Switch to optparse-applicative
This commit is contained in:
parent
1e49f95847
commit
a1837d70fe
78
src/Main.hs
78
src/Main.hs
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user