diff --git a/pit.cabal b/pit.cabal --- a/pit.cabal +++ b/pit.cabal @@ -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 diff --git a/src-exec/Main.hs b/src-exec/Main.hs --- a/src-exec/Main.hs +++ b/src-exec/Main.hs @@ -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) diff --git a/src/Pit.hs b/src/Pit.hs --- a/src/Pit.hs +++ b/src/Pit.hs @@ -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