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

31
src/Main.hs
View File

@ -1,16 +1,15 @@
{-# LANGUAGE RecordWildCards, OverloadedStrings #-} {-# LANGUAGE RecordWildCards, OverloadedStrings #-}
import Network.Wreq (get, responseBody)
import Data.Aeson (decode, toJSON)
import Data.Maybe (fromJust)
import Data.HashMap.Strict (delete)
import Control.Lens
import Control.Applicative
import System.Console.ArgParser
import System.Process
import qualified Data.ByteString.Lazy.Char8 as C
import Json import Json
import Control.Lens
import Network.Wreq (get, responseBody)
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 System.Process
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)