pit (empty) → 0.2.0

raw patch · 6 files changed

+243/−0 lines, 6 filesdep +basedep +bytestringdep +directorysetup-changed

Dependencies added: base, bytestring, directory, filepath, optparse-applicative, pit, process, temporary, text, unordered-containers, yaml

Files

LICENSE +22/−0
README.md +6/−0
Setup.hs +2/−0
pit.cabal +53/−0
src-exec/Main.hs +77/−0
src/Pit.hs +83/−0

+ LICENSE view

@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2014 chiro++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.+

+ README.md view

@@ -0,0 +1,6 @@+haskell-pit+===========++Account manager tool for haskell.++This is a haskell porting of [cho45/pit](https://github.com/cho45/pit)

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ pit.cabal view

@@ -0,0 +1,53 @@+name:                pit+version:             0.2.0+synopsis:            Account management tool.+license:             MIT+license-file:        LICENSE+author:              Yuichiro Hanada+maintainer:          Yuichiro Hanada <i@chir.jp>+stability:           Experimental+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10+homepage:            https://github.com/chiro/haskell-pit+category:            Tools++description:+  This package provides the account management tool and the library for+  account management.+  .+  This package is a porting of Pit (see <https://github.com/cho45/pit>).++source-repository head+  type: git+  location: git://github.com/chiro/haskell-pit.git++library+  exposed-modules: Pit++  build-depends:       base >= 4.7 && < 4.8+                       , directory >= 1.1 && < 1.3+                       , filepath >= 1.2 && < 1.4+                       , text >= 1.2 && < 1.3+                       , unordered-containers >= 0.2 && < 0.3+                       , yaml >= 0.8 && < 0.9+  hs-source-dirs:      src+  default-language:    Haskell2010++  ghc-options: -Wall++executable pit+  hs-source-dirs: src-exec+  default-language: Haskell2010+  main-is: Main.hs+  build-depends: base >= 4.7 && < 4.8+                 , 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++  ghc-options: -Wall

+ src-exec/Main.hs view

@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (join, when)++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++-- | Text 'Option' Reader+text :: Monad m => String -> m Text+text = return . T.pack++opts :: Parser (IO ())+opts = subparser (+  command "get" (info (getCommand <$> argument text idm) idm)+  <> command "set" (info (setCommand <$> argument text idm) idm)+  <> command "switch" (info (Pit.switch <$> argument text idm) idm)+  )++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'++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."++main :: IO ()+main = join $ execParser (info opts idm)

+ src/Pit.hs view

@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}++module Pit (+  get,+  set,+  switch+  ) where++import Control.Applicative ((<$>))+import Control.Monad (unless)++import Data.HashMap.Strict (HashMap())+import qualified Data.HashMap.Strict as H+import Data.Maybe (fromJust, fromMaybe)+import qualified Data.Yaml as Y++import System.Directory+import qualified System.FilePath as F++import Data.Text (Text())+import qualified Data.Text as T++type Config = HashMap Text Y.Value++pitDirectory :: IO FilePath+pitDirectory = (F.</> ".pit") <$> getHomeDirectory++pitConfigFile :: IO FilePath+pitConfigFile = (F.</> "pit.yaml") <$> pitDirectory++pitProfileFile :: FilePath -> IO FilePath+pitProfileFile profile =+  (\dir -> dir F.</> profile F.<.> "yaml") <$> pitDirectory++writeDefaultConfig :: IO ()+writeDefaultConfig = switch "default"++loadProfile :: Text -> IO (Maybe Config)+loadProfile profile' = do+  let profile = T.unpack profile'+  file <- pitProfileFile profile+  exist <- doesFileExist file+  if exist then Y.decodeFile file else return Nothing++getProfile :: IO Text+getProfile = do+  file <- pitConfigFile+  conf <- fromJust <$> Y.decodeFile file+  return . fromJust $ H.lookup ("profile" :: Text) conf++-- If '~/.pit' directory or 'pit.yaml' file don't exist, make them.+initialize :: IO ()+initialize = do+  dir <- pitDirectory+  createDirectoryIfMissing False dir+  existsConf <- pitConfigFile >>= doesFileExist+  unless existsConf writeDefaultConfig++get :: (Y.FromJSON a) => Text -> IO (Maybe a)+get name = do+  initialize+  prof <- getProfile+  conf <- loadProfile prof+  case conf of+   Nothing -> return Nothing+   Just c -> case H.lookup name c of+     Nothing -> return Nothing+     Just v -> return $ Y.parseMaybe Y.parseJSON v++set :: (Y.ToJSON a) => Text -> a -> IO ()+set name value = do+  initialize+  prof <- getProfile+  conf <- fromMaybe H.empty <$> loadProfile prof+  let newConf = H.insert name (Y.toJSON value) conf+  file <- pitProfileFile $ T.unpack prof+  Y.encodeFile file newConf++switch :: Text -> IO ()+switch newProf = do+  let newConf = Y.object ["profile" Y..= Y.String newProf]+  file <- pitConfigFile+  Y.encodeFile file newConf