ちょっとしたこと(buildやdeploy等)をshell(bash)でやっていることが多いのですが、
shellで思ったようにプログラミングできないなーって思うことがちょくちょくあります。
特にバリデーションやステータスの確認をきちんとやりつつモジュール化みたいなことをやろうとすると
結構shellではつらかったりします。
shellのつらいところ
- 関数に変数を渡したら空白が入って思った通りに引数を渡せない
- 関数から戻り値を貰いたいけど面倒なのでグローバル変数で受け取る
- $()内でエラーが起きた場合のハンドリングをちゃんとやるのがつらい
(私のshell力が低いのが多分にありますが...)
ちょっとしたことなので、好きな言語でやっちゃえば良いんじゃない?
という軽い気持ちでHaskellでやる場合の便利ライブラリを紹介します。
(個人的にはPythonとかRubyでやるのが良いような気がします)
紹介するのは以下のライブラリになります。
- turtle
- optparse-declarative
- heredocs
- validation
turtle
https://hackage.haskell.org/package/turtle
shellコマンドを関数として持っているライブラリです。
shellyというのもありますが、turtleの方が後発で使いやすそうな感じがしたのでこっちを使っています。
ちゃんとTutorialがついているので説明することはないのですが、超簡単な使い方を説明します。
echo
turtleは文字列として Data.Text を使う必要があります。
そのため、OverloadedStrings も設定します。
{-# LANGUAGE OverloadedStrings #-}
port Turtle
import qualified Data.Text as Text
main = do
echo "Hello, world!"
ファイルを作成
ホームディレクトリにtest.txtというファイルを作って、lsするサンプルです。
format fp h でFilePathをTextに変換します。それからtext.txtを連結して fromText で FilePath にもどしています。
view は以下の型で標準出力にコマンドの結果を出力します。
また、tutleで使われる FilePath は system-filepath 由来のものです。
view :: (Show a, MonadIO io) => Shell a -> io ()
{-# LANGUAGE OverloadedStrings #-}
port Turtle
import qualified Data.Text as Text
main = do
h <- home
touch $ fromText $ (format fp h) <> "/test.txt"
view (ls h)
コマンドを実行する
コマンドを実行するには下記のように行います。
コマンドの実行は主に shell を通して行います。
shellは以下の型で連続して実行出来るようになっているので、単独で実行する時は empty をつけてい実行します。
shell :: MonadIO io => Text -> Shell Line -> io ExitCode
{-# LANGUAGE OverloadedStrings #-}
import Turtle
import qualified Data.Text as Text
exec :: (MonadIO m) => Text -> m ()
exec cmd = do
x <- shell cmd empty
case x of
ExitSuccess -> return ()
ExitFailure n -> die (cmd <> " failed with exit code: " <> repr n) >> return ()
コマンドの結果を取得する
結果を取得するには少し手間でfoldを使う必要があります。
inshell は以下の型です。shellの戻り値はステータスコードなので戻り値を取得出来ません。
inshell :: Text -> Shell Line -> Shell Line
import qualified Control.Foldl as Fold
get :: (MonadIO m) => Text -> m (Maybe Line)
get cmd = do
fold (inshell cmd empty) Fold.head
optparse-declarative
型でコマンドの引数を定義出来るライブラリです。
結構詳細な説明があるのであんまり説明することはないのですが、以下のような感じで使います。
deploy :: Flag "e" '["exec"] "BOOL" "execute deploy" Bool
-> Flag "n" '["env"] "ENV" "deploy env" String
-> Flag "c" '["color"] "COLOR" "deployment color" String
-> Arg "CONTAINER" String
-> Cmd "Deploy container" ()
deploy = undefined
main = run_ deploy
Flag でオプションを指定して、 Arg で引数を指定します。
このサンプルだと以下のように実行出来ます。
(mainというバイナリでコンパイルした場合)
$ main -e -n stage -c blue api
# or
$ main --exec --env stage --color blue api
はまった点としては以下のようなことがあります。
-
Argは1つしかとることが出来ない - デフォルトで
v V ?が予約されている
また、turtleは Data.Text で、optparse-declarativeは String なので変換する必要があります...
heredocs
ヒアドキュメントをHaskellのTemplateで記述出来るライブラリです。
コマンドを複数実行したい場合に重宝します。
これも、詳しい説明があるので、特に言うこともないのです...
if文や変数が使えてとても便利です。
ただ、変数が ${x} みたいな感じになるのでshellの変数とごっちゃになりやすいです...
import Text.Heredoc (heredoc)
clean :: Text -> Text
clean uri = [heredoc|
docker images --format "{{.ID}}\t{{.CreatedAt}}\t{{.Tag}}" ${uri} | \
sort -r -k2,3 | \
awk -F"\t" '$3 != "latest" && NR > 3 {print $1}' | \
xargs -n 1 docker rmi -f || true
|]
validation
その名の通りのバリデーション用のライブラリです。
Data-Either-ValidationというシンプルなValidationもありますが、今回紹介するのはちょっと複雑なもので、以下のような型を持っています。
- AccValidation
- AplicativeなValidation
- Validation
- MonadなValidation
- ValidationT
- monad transformerなValidation
- ValidationB
- bifunctorなValidation
exampleを見て型に対してvalidationをすることができるみたいだったので、使ったのですが、
shellで使うようなものはあんまり型として定義する必要が無かったので、ちょっとオーバースペックかもしれません。
(lensを使っているのでインストールが遅い...)
以下はTargetという型に対してのValidationをするサンプルです。
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Lens
import Data.List
import Data.Validation (_Success, _Failure, AccValidation(AccSuccess, AccFailure))
import qualified Data.Text as Text
import Turtle
type Field = String
type Value = String
type Message = String
type Error = String
type Validated a = AccValidation [Error] a
type Rule = Field -> Value -> Validated Value
data Target = Target String deriving (Show, Eq)
validateTarget :: (MonadIO m) => Target -> [Value] -> m Target
validateTarget target values = case evaluate target values of
AccFailure errors -> die (conv errors)
AccSuccess target -> return target
where
conv errors = foldr (<>) Text.empty $ map Text.pack errors
evaluate (Target value) values = validates "Target" [notEmpty, include values] Target value
validates :: Field -> [Rule] -> (Value -> a) -> Value -> Validated a
validates name rules constructor value = constructor <$> validate name rules value
validate :: Field -> [Rule] -> Value -> Validated Value
validate name rules value = head <$> sequenceA (map (\f -> f name) rules <*> [value])
mkErrors :: Field -> Value -> Message -> [Error]
mkErrors name value message = [name ++ "[" ++ value ++ "]: " ++ message ++ " "]
notEmpty :: Rule
notEmpty name value
| value /= "" = _Success # value
| otherwise = _Failure # mkErrors name value "empty string is not allowed"
include :: [Value] -> Rule
include list name value
| elem value list = _Success # value
| otherwise = _Failure # _mkErrors list name value
where _mkErrors list name value = mkErrors name value
$ "expected values [" ++ intercalate "," list ++ "]"
main :: IO ()
main = do
target' <- validateTarget goodTarget params
target' <- validateTarget badTarget params
return ()
where
params = ["better", "good", "best"]
goodTarget = Target "good"
badTarget = Target "bad"
型を定義しないで複数のValidationを行うサンプルです。
関数は上で定義したものを使っています。
validateEtc :: (MonadIO m) => Value -> Value -> m ()
validateEtc color container =
case pure () <* vdColor <* vdContainer of
AccFailure errors -> die (conv errors)
AccSuccess _ -> return ()
where
vdColor = validate "color" [notEmpty, include colors] color
vdContainer = validate "container" [notEmpty, include containers] container
conv errors = foldr (<>) Text.empty $ map Text.pack errors
colors = ["blue", "green"]
containers = ["front", "api", "cache", "prediction"]
本当は作ったものをまるっと紹介したいのですが、なかなか仕様がややこしくて説明するのが大変なので、
あんまり説明のいらないところをサンプルとして乗せておきます。(heredocsは使ってないのですが...)
下のプログラムは環境変数をグループで登録して切り替えられるツールです。
下記3つのコマンドがあり、環境変数は~/.myenv.yamlに保存しています。
- envshow 登録しているグループと値の一覧を表示
- envswitch グループを切り替える
- envput 環境変数をグループに登録する
上記ライブラリ紹介に出ていない Data.Yaml も使っています。
思ったより情報がなさそうだったので、ちょっとだけ説明します。
yaml
以下のような定義を書くだけで、復元と保存が出来るようになります。
aeson由来の定義を使っているのでFromJSON、ToJSONになっていますが、Yamlになります。
import Data.Yaml (FromJSON, ToJSON)
import qualified Data.Yaml as Y
import GHC.Generics
data EnvRoot = EnvRoot { env_root :: HashMap String EnvMap }
deriving (Eq, Show, Generic)
instance FromJSON EnvRoot
instance ToJSON EnvRoot
data EnvMap = EnvMap { env_map :: HashMap String String }
deriving (Eq, Show, Generic)
instance FromJSON EnvMap
instance ToJSON EnvMap
あと、下記の型を持った encodeFile で保存できますが、使うFilePath が Prelude のものなのでturtleと使う時は変換しなければなりません。
encodeFile :: ToJSON a => FilePath -> a -> IO ()
ちょっと別名でインポートする方法に悩みました...
import Prelude hiding (FilePath)
import qualified Prelude as P (FilePath)
cvFilePath :: FilePath -> P.FilePath
cvFilePath f = Text.unpack $ format fp f
保存されるyamlは以下のようになります。
env_root:
other:
env_map:
TEST_VALUE: other_test
ROOT_PATH: /Users/other/
default:
env_map:
TEST_VALUE: default_test
ROOT_PATH: /Users/default/
まぁ、envdirとかあるので、作ってからこれ要らないなって思ったんですが...
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Lens
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text
import Data.Validation (_Success, _Failure, AccValidation(AccSuccess, AccFailure))
import Data.Yaml (FromJSON, ToJSON)
import qualified Data.Yaml as Y
import GHC.Generics
import Options.Declarative (get, run_, subCmd, Arg, Cmd, Flag, Group(..))
import Prelude hiding (FilePath)
import qualified Prelude as P (FilePath)
import Turtle
data EnvRoot = EnvRoot { env_root :: HashMap String EnvMap }
deriving (Eq, Show, Generic)
instance FromJSON EnvRoot
instance ToJSON EnvRoot
data EnvMap = EnvMap { env_map :: HashMap String String }
deriving (Eq, Show, Generic)
instance FromJSON EnvMap
instance ToJSON EnvMap
envshow :: Cmd "Show passed env's map" ()
envshow = do
b <- hasFile
when (not b) $ die ("yaml not exists") >> return ()
f <- liftIO $ getFilePath
r <- liftIO $ (Y.decodeFile (cvFilePath f) :: IO (Maybe EnvRoot))
case r of
Nothing -> die ("yaml parse error") >> return ()
Just r -> showList r
where
showList root = mapM_ _show $ HashMap.toList $ env_root root
_show (k, ls) = do
liftIO $ putStrLn $ "env = " ++ k
mapM_ _print $ HashMap.toList $ env_map ls
_print (k, v) = liftIO $ putStrLn $ " " ++ k ++ " = " ++ v
envswitch :: Arg "Group" String
-> Cmd "Swith env Group" ()
envswitch group = do
b <- hasFile
when (not b) $ die ("yaml not exists") >> return ()
f <- liftIO $ getFilePath
r <- liftIO $ (Y.decodeFile (cvFilePath f) :: IO (Maybe EnvRoot))
case r of
Nothing -> die ("yaml parser error") >> return ()
Just r -> switch r (get group)
where
switch root group = do
_export root group
liftIO $ echo "# Run this command to configure your shell:"
liftIO $ echo "# eval $(mycmd envswitch group)"
_export root group = case HashMap.lookup group (env_root root) of
Nothing -> die (Text.pack group <> " is undefined") >> return ()
Just m -> mapM_ _print $ HashMap.toList $ env_map m
_print (k, v) = liftIO $ putStrLn $ "export " ++ k ++ "=" ++ v
envput :: Flag "k" '["key"] "KEY" "env key" String
-> Flag "a" '["value"] "VALUE" "env value" String
-> Arg "Group" String
-> Cmd "Put to env" ()
envput key value group = do
validatePut (get key) (get value) (get group)
b <- hasFile
when (not b) $ createFile
f <- getFilePath
r <- liftIO $ (Y.decodeFile (cvFilePath f) :: IO (Maybe EnvRoot))
case r of
Nothing -> die "yaml is broken" >> return ()
Just r -> updateYaml r (get key) (get value) (get group)
updateYaml :: (MonadIO m) => EnvRoot -> String -> String -> String -> m ()
updateYaml root key value group = do
f <- getFilePath
liftIO $ Y.encodeFile (cvFilePath f) EnvRoot {env_root = update $ env_root root}
where
update er = HashMap.alter (\x -> Just $ _update er) group er
_update er = case HashMap.lookup group er of
Nothing -> EnvMap {env_map = HashMap.fromList [(key, value)]}
Just eMap -> EnvMap {env_map = _alter eMap}
_alter em = HashMap.alter (\x -> Just value) key $ env_map em
createFile :: (MonadIO m) => m ()
createFile = do
f <- getFilePath
liftIO $ touch f
liftIO $ Y.encodeFile (cvFilePath f) EnvRoot {env_root = HashMap.empty}
getFilePath :: (MonadIO m) => m FilePath
getFilePath = do
h <- home
return $ fromText $ (format fp h) <> "/.myenv.yaml"
cvFilePath :: FilePath -> P.FilePath
cvFilePath f = Text.unpack $ format fp f
hasFile :: (MonadIO m) => m Bool
hasFile = do
f <- getFilePath
testfile f
type Field = String
type Value = String
type Message = String
type Error = String
type Validated a = AccValidation [Error] a
type Rule = Field -> Value -> Validated Value
validatePut :: (MonadIO m) => Value -> Value -> Value -> m ()
validatePut key value group =
case pure () <* vdKey <* vdValue <* vdGroup of
AccFailure errors -> die (conv errors)
AccSuccess _ -> return ()
where
vdKey = validate "key" [notEmpty] key
vdValue = validate "value" [notEmpty] value
vdGroup = validate "group" [notEmpty] group
conv errors = foldr (<>) Text.empty $ map Text.pack errors
validate :: Field -> [Rule] -> Value -> Validated Value
validate name rules value = head <$> sequenceA (map (\f -> f name) rules <*> [value])
mkErrors :: Field -> Value -> Message -> [Error]
mkErrors name value message = [name ++ "[" ++ value ++ "]: " ++ message ++ " "]
notEmpty :: Rule
notEmpty name value
| value /= "" = _Success # value
| otherwise = _Failure # mkErrors name value "empty string is not allowed"
main :: IO ()
main = run_ $
Group "env tool commands"
[ subCmd "envshow" envshow
, subCmd "envput" envput
, subCmd "envswitch" envswitch
]
cabalファイル
name: envcmd
version: 0.1.0.0
license: BSD3
license-file: LICENSE
copyright: MIT
category: App
build-type: Simple
cabal-version: >=1.10
executable envcmd
hs-source-dirs: app
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base >= 4.7 && < 5
, lens
, text
, turtle
, validation
, unordered-containers
, optparse-declarative
, yaml
default-language: Haskell2010
stack.yaml
resolver: lts-8.12
packages:
- '.'
extra-deps:
- optparse-declarative-0.3.0
flags: {}
extra-package-dbs: []