pit 0.2.0 → 0.3.0
raw patch · 3 files changed
+84/−51 lines, 3 files
Files
- pit.cabal +4/−3
- src-exec/Main.hs +6/−38
- src/Pit.hs +74/−10
pit.cabal view
@@ -1,5 +1,5 @@ name: pit-version: 0.2.0+version: 0.3.0 synopsis: Account management tool. license: MIT license-file: LICENSE@@ -26,8 +26,11 @@ exposed-modules: Pit build-depends: base >= 4.7 && < 4.8+ , bytestring >= 0.10 && < 0.11 , directory >= 1.1 && < 1.3 , filepath >= 1.2 && < 1.4+ , process >= 1.2 && < 1.3+ , temporary >= 1.2 && < 1.3 , text >= 1.2 && < 1.3 , unordered-containers >= 0.2 && < 0.3 , yaml >= 0.8 && < 0.9@@ -44,8 +47,6 @@ , pit , bytestring >= 0.10 && < 0.11 , optparse-applicative >= 0.10- , process >= 1.2 && < 1.3- , temporary >= 1.2 && < 1.3 , text >= 1.2 && < 1.3 , unordered-containers >= 0.2 && < 0.3 , yaml >= 0.8 && < 0.9
src-exec/Main.hs view
@@ -2,22 +2,16 @@ module Main where -import Control.Monad (join, when)+import Control.Monad (join) import qualified Data.ByteString.Char8 as C import qualified Data.HashMap.Strict as H-import Data.Maybe (isJust, fromJust) import Data.Text (Text()) import qualified Data.Text as T import qualified Data.Yaml as Y import Options.Applicative -import System.Process-import System.Environment-import System.IO-import System.IO.Temp- import Pit type HM = H.HashMap Text Text@@ -36,42 +30,16 @@ printYaml :: Y.Value -> IO () printYaml yaml = putStrLn $ C.unpack $ Y.encode yaml -openEditorAndGetNewValue :: Maybe Y.Value -> IO (Maybe Y.Value)-openEditorAndGetNewValue def = do- editor' <- lookupEnv "EDITOR"- tty <- hIsTerminalDevice stdout- if isJust editor' && tty- then withSystemTempFile "new.yaml" $ \path h -> do- hClose h- when (isJust def) $ do- let content = C.unpack $ Y.encode $ fromJust def- writeFile path content- _ <- callCommand (fromJust editor' ++ " " ++ path)- Y.decodeFile path- else return Nothing- getCommand :: Text -> IO () getCommand key = do- v <- Pit.get key :: IO (Maybe Y.Value)- case v of- Nothing -> do- v' <- openEditorAndGetNewValue Nothing- case v' of- Nothing -> putStrLn "Failed to get the value."- Just v'' -> do- Pit.set key v''- printYaml v''- Just v' -> printYaml v'+ v <- Pit.get key Y.Null+ printYaml v setCommand :: Text -> IO () setCommand key = do- v <- Pit.get key :: IO (Maybe Y.Value)- v' <- openEditorAndGetNewValue v- case v' of- Nothing -> putStrLn "Failed to set the value."- Just v'' -> do- Pit.set key v''- putStrLn "Succeed to set the value."+ Pit.set key+ v <- Pit.get key Y.Null+ printYaml v main :: IO () main = join $ execParser (info opts idm)
src/Pit.hs view
@@ -2,23 +2,29 @@ module Pit ( get,+ getValue, set,+ setValue, switch ) where import Control.Applicative ((<$>))-import Control.Monad (unless)+import Control.Monad (unless, when) +import qualified Data.ByteString.Char8 as C import Data.HashMap.Strict (HashMap()) import qualified Data.HashMap.Strict as H-import Data.Maybe (fromJust, fromMaybe)+import Data.Maybe (fromJust, fromMaybe, isJust)+import Data.Text (Text())+import qualified Data.Text as T import qualified Data.Yaml as Y import System.Directory+import System.Environment import qualified System.FilePath as F--import Data.Text (Text())-import qualified Data.Text as T+import System.IO+import System.IO.Temp+import System.Process type Config = HashMap Text Y.Value @@ -56,8 +62,45 @@ existsConf <- pitConfigFile >>= doesFileExist unless existsConf writeDefaultConfig -get :: (Y.FromJSON a) => Text -> IO (Maybe a)-get name = do+openEditorAndGetValue :: Maybe Y.Value -> IO (Maybe Y.Value)+openEditorAndGetValue def = do+ editor' <- lookupEnv "EDITOR"+ isTty <- hIsTerminalDevice stdout+ if isJust editor' && isTty+ then withSystemTempFile "new.yaml" $ \path h -> do+ hClose h+ when (isJust def) $ do+ let content = C.unpack $ Y.encode $ fromJust def+ writeFile path content+ _ <- callCommand (fromJust editor' ++ " " ++ path)+ Y.decodeFile path+ else return Nothing++-- | Tries to get the data by a key.+-- If the data associated with the key is not found,+-- open $EDITOR with the default value.+get :: Text -- ^ a key+ -> Y.Value -- ^ default value+ -> IO Y.Value+get key v = do+ v' <- getValue key+ case v' of+ Nothing -> do+ v'' <- openEditorAndGetValue $ Just v+ case v'' of+ Nothing -> error "Failed to set the value."+ Just v''' -> do+ setValue key v'''+ return v'''+ Just v'' -> return v''++-- | Gets the data by a key.+-- If current profile is set to 'dev', this function tries to+-- get the data from '~/.pit/dev.yaml'.+getValue :: (Y.FromJSON a)+ => Text -- ^ a key+ -> IO (Maybe a)+getValue name = do initialize prof <- getProfile conf <- loadProfile prof@@ -67,8 +110,25 @@ Nothing -> return Nothing Just v -> return $ Y.parseMaybe Y.parseJSON v -set :: (Y.ToJSON a) => Text -> a -> IO ()-set name value = do+-- | Sets new data.+-- Open $EDITOR with the current value.+set :: Text -- ^ a key+ -> IO ()+set key = do+ v <- getValue key :: IO (Maybe Y.Value)+ putStrLn $ show v+ v' <- openEditorAndGetValue v+ case v' of+ Nothing -> error "Failed to set the value."+ Just v'' -> do+ setValue key v''++-- | Sets new data.+setValue :: (Y.ToJSON a)+ => Text -- ^ a key+ -> a -- ^ new data+ -> IO ()+setValue name value = do initialize prof <- getProfile conf <- fromMaybe H.empty <$> loadProfile prof@@ -76,7 +136,11 @@ file <- pitProfileFile $ T.unpack prof Y.encodeFile file newConf -switch :: Text -> IO ()+-- | Switches the profile.+-- The current profile is stored in '~/.pit/pit.yaml'.+-- This function rewrites it.+switch :: Text -- ^ new profile+ -> IO () switch newProf = do let newConf = Y.object ["profile" Y..= Y.String newProf] file <- pitConfigFile