choose config from args

This commit is contained in:
rnhmjoj 2017-01-26 23:50:27 +01:00
parent bc30a9dc34
commit 086abe6bc6
No known key found for this signature in database
GPG Key ID: 362BB82B7E496B7C
2 changed files with 19 additions and 12 deletions

27
Main.hs
View File

@ -2,6 +2,8 @@
import System.Process
import System.Exit
import System.Environment (getArgs)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Aeson
import Data.Aeson.TH
import Data.ByteString.Lazy.Char8 (pack)
@ -16,18 +18,22 @@ data Name = Name
deriveJSON defaultOptions ''Name
namecoin :: [String] -> CreateProcess
namecoin args = shell ("namecoind -conf=$HOME/.config/namecoin " ++ unwords args)
defaultPath :: FilePath
defaultPath = "$XDG_CONFIG_HOME/namecoin"
readCommand = readCreateProcess (namecoin ["name_list"]) ""
updateCommand n v = readCreateProcessWithExitCode (namecoin ["name_update", n, v]) ""
namecoin :: FilePath -> [String] -> CreateProcess
namecoin path args = shell ("namecoind -conf=" ++ path ++ " " ++ unwords args)
updateName :: Name -> IO Int
updateName Name{..}
readCommand conf = readCreateProcess (namecoin conf ["name_list"]) ""
updateCommand conf n v = readCreateProcessWithExitCode (namecoin conf ["name_update", n, v]) ""
updateName :: FilePath -> Name -> IO Int
updateName conf Name{..}
| expires_in < 100 = do
(code, out, err) <- updateCommand name value
(code, out, err) <- updateCommand conf name value
if code == ExitSuccess
then putStrLn (name ++ " updated: " ++ out) >> return 0
else putStrLn (name ++ " update failed: " ++ err) >> return 1
@ -36,11 +42,12 @@ updateName Name{..}
main :: IO ()
main = do
out <- pack <$> readCommand
conf <- (fromMaybe defaultPath . listToMaybe) <$> getArgs
out <- pack <$> readCommand conf
case eitherDecode out of
Right names -> do
errs <- sum <$> mapM updateName (names :: [Name])
errs <- sum <$> mapM (updateName conf) (names :: [Name])
if errs > 0
then putStrLn (show errs ++ " updates failed")
else putStrLn "All ok"
Left err -> putStrLn ("Error communicating with namecoin: " ++ err)
Left err -> putStrLn ("Error communicating with namecoin: " ++ err)

View File

@ -1,5 +1,5 @@
name: namecoin-update
version: 0.1.1.0
version: 0.1.2.0
synopsis: Script to update namecoin names
license: MIT
license-file: LICENSE
@ -13,4 +13,4 @@ cabal-version: >=1.10
executable namecoin-update
main-is: Main.hs
build-depends: base, bytestring, aeson, process
default-language: Haskell2010
default-language: Haskell2010