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

Support the new GHC 7.10 base library

Browse Source
This commit is contained in:
rnhmjoj 2015-04-11 20:29:16 +02:00
parent 2ef3e66b48
commit ae5069b3ad
2 changed files with 18 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rosa.cabal
View File

@ -1,5 +1,5 @@
name: rosa name: rosa
version: 0.1.3.0 version: 0.2.0.0
synopsis: Query the namecoin blockchain synopsis: Query the namecoin blockchain
description: description:
@ -12,7 +12,7 @@ license: MIT
license-file: LICENSE license-file: LICENSE
author: Rnhmjoj author: Rnhmjoj
maintainer: micheleguerinirocco@me.com maintainer: micheleguerinirocco@me.com
copyright: (C) Michele Guerini Rocco 2014 copyright: (C) Michele Guerini Rocco 2015
category: Utility category: Utility
build-type: Simple build-type: Simple
extra-source-files: README.md, LICENSE extra-source-files: README.md, LICENSE
@ -28,8 +28,8 @@ executable rosa
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
other-extensions: RecordWildCards, OverloadedStrings other-extensions: RecordWildCards, OverloadedStrings
build-depends: base ==4.7.*, aeson ==0.8.*, text ==1.2.*, build-depends: base >=4.8 && <5.0 , aeson, text,
vector ==0.10.*, unordered-containers ==0.2.*, vector, unordered-containers,
wreq ==0.3.*, lens >=4.4, bytestring ==0.10.*, wreq, lens >=4.4, bytestring,
argparser ==0.3.*, process ==1.2.* argparser, process
ghc-options: -O2 ghc-options: -O2

23
src/Main.hs
View File

@ -1,16 +1,15 @@
{-# LANGUAGE RecordWildCards, OverloadedStrings #-} {-# LANGUAGE RecordWildCards, OverloadedStrings #-}
import Json
import Control.Lens
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 Data.ByteString.Lazy.Char8 (pack)
import Control.Applicative
import System.Console.ArgParser import System.Console.ArgParser
import System.Process import System.Process
import qualified Data.ByteString.Lazy.Char8 as C
import Json
data ProgArgs = ProgArgs data ProgArgs = ProgArgs
{ name :: String { name :: String
@ -20,7 +19,6 @@ data ProgArgs = ProgArgs
, 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"
@ -30,38 +28,33 @@ parser = ProgArgs
`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 ()
main = interface >>= flip runApp exec main = interface >>= flip runApp exec
exec :: ProgArgs -> IO () exec :: ProgArgs -> IO ()
exec ProgArgs{..} = do exec ProgArgs{..} =
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 (pack out) of
Just res -> do Just res -> do
pprint $ reparse (res |: "value") pprint $ reparse (res |: "value")
if block then pprint extra else return () if block then pprint extra else return ()
where where
reparse = fromJust . decode . C.pack reparse = fromJust . decode . 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)