From a1837d70fee7b7a9e29aac940d4a9cced85080cb Mon Sep 17 00:00:00 2001 From: rnhmjoj Date: Thu, 5 May 2016 17:55:34 +0200 Subject: [PATCH] Switch to optparse-applicative --- src/Main.hs | 78 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 51 insertions(+), 27 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 5fa1836..0631349 100644 --- a/src/Main.hs +++ b/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"