この記事は Haskell Advent Calendar 2016 の9日目の記事です。
とか云ってもう11日ですね、ホントすみません。
8日目は @phi16_ さん、10日目は @bra_cat_ket さん でした。
Haskell を書き始めてはや5年、Monad や Applicative は使いこなしているけど、それ以上の抽象化のレパートリーを増やせていないと感じていました。
何となく「型レベルプログラミング」という言葉に興味はありつつも、具体的に何を学べば型レベルプログラミングができるようになるのか分からずにいたのです。
そんなあるとき、コマンドラインパーザーのライブラリを探している中でこんな記事を見つけました。
タイトルに「宣言的な型レベルコマンドラインパーザー」とあります。このライブラリが内部で何をしているのか追っていけば型レベルプログラミングってやつが分かるようになるのでは…？ そんな思いでこのライブラリのコードを読んでいくことに決めました。
今回はこの optparse-declarative のコードリーディングから得た学びを書き留めます。
型レベルプログラミングの世界に一歩踏み込みたい、型レベルFizzBuzzもいいけどもっと実用的な例を知りたいと思ってる人の参考になれば幸いです。
optparse-declarative とは
田中英行(@tanakh)氏が作ったコマンドラインパーザーです。
CLIツールのために、コマンドライン引数・コマンドラインオプションの取得、サブコマンドの制御などの機能を提供しています。
tanakh 氏自身がとても分かりやすい記事を書かれています。
ただ使うだけであれば、これらの記事を読むだけで充分に感触が掴めると思います。
使い方
公式のサンプルコードをそのまま引用します。
{-# LANGUAGE DataKinds #-} import Options.Declarative import Control.Monad.Trans greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" String) -> Arg "NAME" String -> Cmd "Greeting command" () greet msg name = liftIO $ putStrLn $ get msg ++ ", " ++ get name ++ "!" main :: IO () main = run_ greet
コマンドライン引数から「挨拶の言葉」と「名前」を受け取って挨拶を出力するコマンドです。
「挨拶の言葉」はデフォルト値が与えられたフラグとして定義されているのでオプションになります。
たったのこれだけで、
- コマンドラインオプションを解析して必要としている型に変換
- コマンドのヘルプ文字列を生成
- 不正なオプションが渡された場合にはエラーを表示
- サブコマンド実装のサポート
などを面倒見てくれます。
--help オプションとともに呼び出せば、
$ greet --help Usage: greet [OPTION...] NAME Greeting command Options: -g STRING --greet=STRING greeting message -? --help display this help and exit -v[n] --verbose[=n] set verbosity level
このようにいい感じに生成されたヘルプ文字列を表示してくれますし、
不正な引数を与えれば勝手にチェックしてエラーメッセージを表示してくれたりと、全体的にとても楽チンです。
引数の説明や引数名を 型注釈の方 に記述するコーディングスタイルが特徴です。
逆に greet 関数の本体では渡された引数を使うだけで済みます。
optparse-declarative を題材に選んだ理由
このライブラリは 実質1つのファイルだけ で構成されていて、 メインのコードは360行ほど しかありません。
内部で定義されている主要なデータ型は4個, 型クラスは3個ほどだけです。
このボリュームだったら初心者であっても心が折れずに読み進められそうだと思いました。
しかも、とても実用的で具体的な目的のために書かれたものなので、動かしながら理解するのに良さそうだと感じたのです。
実にありがたいことに、きれいで丁寧なコメントも付けられています。
読み解く
では、さっそく読んでいきましょう。
メインのファイルはこれです。
言語拡張
冒頭にはプラグマの指定が書かれていて、多くの言語拡張が有効化されています。
DataKinds, PolyKinds, KindSignatures, GADTs, DefaultSignatures, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, MultiWayIf, TupleSections 以上15個です。
これらの言語拡張は文法に影響を与えるので、最初に意味を確認しておくのがよさそうです。
DataKinds
値コンストラクタを型に、型をカインドに昇格させられる拡張です。 optparse-declarative ではコマンドの型の中に登場していました。
greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" String) -> Arg "NAME" String -> Cmd "Simple greeting example" ()
型注釈の中に現れる "g" などの文字列リテラルっぽいものが 型レベル文字列 で、Symbol というカインドを持っています。
Int や Bool のように "g" 自体が型として扱われています。
興味深いのは、この "g" :: Symbol という型がのちほど "g" :: String という値として使われることです。
型から値への変換をどういう仕組みで実現しているのか気になります。
KindSignatures
型変数に対してカインド注釈が付けられるようになります。
optparse-declarative の中では Arg 型の定義が、
-- | Unnamed argument newtype Arg (placeholder :: Symbol) a = Arg { getArg :: a }
というようになっています。
placeholder :: Symbol の部分を見ると、型変数 placeholder のカインドが Symbol であることが分かります。
GADTs
多相のデータ型を定義する際の新しい文法を導入します。
Maybe a と同じ意味のデータ型 MyMaybe a を定義する場合、
data MyMaybe a = MyNothing | MyJust a
と書くところを、
data MyMaybe a where MyNothing :: MyMaybe a MyJust :: a -> MyMaybe a
というように書けるようになります。 特定の値コンストラクタにだけ型制約を導入したりといった柔軟なデータ型を作れるようになります。
この拡張は文法に与える変化がとても大きく、事前に知っていないとコードを読み進めるのが無理になると感じました。
DefaultSignatures
型クラスのメソッドを定義する際、デフォルトのメソッド定義にだけ特別な型を与えられるようになります。
-- | Command line option's annotated types class ArgRead a where -- | Get the argument's value unwrap :: a -> Unwrap a default unwrap :: a ~ Unwrap a => a -> Unwrap a unwrap = id
default キーワードが新たに導入されます。
メソッドに複数の型が与えられているように見えるので、知らずにコードを読むと戸惑うことになりますね。
FlexibleInstances
こんな感じのインスタンス宣言が書けるようになります。
class Foo a where foo :: a -> a instance Foo String where foo = id
上記のコードは通常ならば以下のようにコンパイルエラーになります。
error:
? Illegal instance declaration for 'Foo String'
(All instance types must be of the form (T t1 ... tn)
where T is not a synonym.
Use TypeSynonymInstances if you want to disable this.)
? In the instance declaration for 'Foo String'
意訳するとインスタンス化する型は T t1 ... tn の形をしていないといけないよ。t1 などは具体型ではなく型変数で書かないといけないよ。とのことです。
String は [] Char のシノニムなので、確かにこのルールに即していないことが分かります。
FlexibleInstances 拡張を有効にすれば上記のルールに即さない型についてもインスタンス宣言が書けます。
GeneralizedNewtypeDeriving
newtype キーワードで定義したデータ型をお手軽に各型クラスのインスタンスにしてくれる便利な拡張です。
newtype Foo a = MkFoo [a] deriving (Functor)
これだけで Foo 型は Functor になります。
愚直にインスタンス化しようとすると次のようになるはずですが、
instance Functor (Foo a) where fmap f (MkFoo xs) = MkFoo $ fmap f xs
これは fmap を適用する前に MkFoo を剥がしたり包んだりしているだけなので、本質的には [a] に対するインスタンス宣言とやっていることは変わりません。
GeneralizedNewtypeDeriving 拡張はこのような定型のインスタンス宣言を自動化してボイラープレートコードを削減してくれます。
ScopedTypeVariables
型変数にもスコープの概念を持ち込むための拡張です。
instance (KnownSymbol s, KnownSymbols ss) => KnownSymbols (s ': ss) where symbolVals _ = symbolVal (Proxy :: Proxy s) : symbolVals (Proxy :: Proxy ss)
1行目で型制約を示すために使われている s という型変数が2行目でも Proxy s という形で使われています。
通常のルールでは1行目の s と2行目の s は偶然同じ名前が宛てられただけの全く別物の型変数とみなされます。ScopedTypeVariables 拡張を有効にすれば、where 以下の文脈でも型変数 s は KnownSymbol s という型制約を帯びて解釈されます。
TypeFamilies
型を返す関数を定義できるようになります。
-- | Command line option class Option a where -- | Type of the argument' value type Value a :: * -- | Get the argument' value get :: a -> Value a
type キーワードが新たに導入されていますね。
ここでの Value a は、Value a 型ではなく Value :: * -> * という型関数によって導き出される何かしらの具体型になると読まなければいけません。
コードの中でいろいろな型を Option クラスのインスタンスにしていますが、インスタンスにする型によって get が返す型をいろいろに変えるために型関数を持ち出しているようです。
コードを追う
言語拡張の予習が終わったところで本題のコードを読んでいきます。
サンプルコードにも出てきている run_ 関数あたりから。
run_
-- | Run a command run_ :: IsCmd c => c -> IO () run_ cmd = do progName <- getProgName run progName Nothing cmd
run_ 関数は do構文の中で getProgName :: IO String を評価して実行ファイル名を取得しています。
それをそのまま run 関数に渡していますね。
run
-- | Run a command with specifying program name and version run :: IsCmd c => String -> Maybe String -> c -> IO () run progName progVer cmd = run' cmd [progName] progVer =<< getArgs
run 関数は getArgs :: IO [String] からコマンドライン引数を取得して、今度は run' 関数に渡しています。
run'
run' :: IsCmd c => c -> [String] -> Maybe String -> [String] -> IO () run' cmd name mbver args = do let optDescr = getOptDescr cmd ++ [ Option "?" ["help"] (NoArg ("help", "t")) "display this help and exit" ] ++ [ Option "V" ["version"] (NoArg ("version", "t")) "output version information and exit" | isJust mbver ] ++ [ Option "v" ["verbose"] (OptArg (\arg -> ("verbose", fromMaybe "" arg)) "n") "set verbosity level" ] prog = unwords name vermsg = prog ++ maybe "" (" version " ++) mbver header = "Usage: " ++ prog ++ " [OPTION...]" ++ getUsageHeader cmd prog ++ "\n" ++ " " ++ getCmdHelp cmd ++ "\n\n" ++ "Options:" usage = usageInfo header optDescr ++ getUsageFooter cmd prog case getOpt' RequireOrder optDescr args of (options, nonOptions, unrecognized, errors) | not $ null errors -> errorExit name $ intercalate ", " errors | isJust (lookup "help" options) -> do putStr usage exitSuccess | isJust (lookup "version" options) -> do putStrLn vermsg exitSuccess | otherwise -> runCmd cmd name mbver options nonOptions unrecognized
run' 関数は let 式で書かれている前半と、 case 式で書かれている後半に分けられます。
前半部分では「オプションの説明」や「バージョン情報」などコマンドのヘルプを表示する際に必要になるヘルプ文字列を組み立てているようです。
前半の見どころは getOptDescr cmd, getUsageHeader cmd prog, getUsageFooter cmd prog, getCmdHelp cmd あたりですね。
これらは全て型に持たせた情報を取り出してヘルプのための文字列を組み立てています。
後半部分ではコマンドライン引数を解析して、その後の動作を振り分けています。
エラーを表示して終わるか、コマンドのヘルプを表示するか、バージョン情報を表示するか、さもなくばコマンドの実行をしています。
後半の見どころは間違いなく最終行の runCmd cmd name mbver options nonOptions unrecognized でしょう。
run' 前半部
順番に見ていきます。
getCmdHelp
getCmdHelp 関数は IsCmd クラスのメソッドとして定義されています。
Cmd から String を取り出します。
-- | Command class class IsCmd c where getCmdHelp :: c -> String default getCmdHelp :: (c ~ (a -> b), IsCmd b) => c -> String getCmdHelp f = getCmdHelp $ f undefined
具体的な動作を追うにはインスタンス宣言のほうを見ていく必要がありますね。
IsCmd クラスのインスタンスになっているのは Flag shortNames longNames placeholder help a -> c, Arg placeholder String -> c, Arg placeholder [String] -> c そして Cmd help () です。
その中でも Cmd help () に対してのインスタンス宣言を見てみましょう。
instance KnownSymbol help => IsCmd (Cmd help ()) where getCmdHelp _ = symbolVal (Proxy :: Proxy help)
型レベル文字列から通常の文字列を取り出す方法が分かってきました。
symbolVal :: KnownSymbol n => proxy n -> String を使うようです。symbolVal は GHC.TypeLits モジュール で定義されています。
Proxy "foo" 型の値 Proxy から String 型の値 "foo" を取り出すことができる不思議な関数です。
Proxy :: Proxy a は Data.Proxy モジュール で定義されていて型情報だけを持つ値(型に関係しない値)を扱うことができます。
型レベル文字列から Proxy を作って、Proxy から文字列を取り出す最小コードはたぶんこんな感じ。
{-# LANGUAGE DataKinds #-} import Data.Proxy import GHC.TypeLits main :: IO () main = do let fooProxy = Proxy :: Proxy "foo" putStrLn $ symbolVal fooProxy
そして、今回のように独自の型に型レベル文字列を埋め込んで、後程取り出す最小のコードがこちら。
{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} import Data.Proxy import GHC.TypeLits class GetMessage a where getMessage :: a -> String data Foo message = Foo instance KnownSymbol message => GetMessage (Foo message) where getMessage _ = symbolVal (Proxy :: Proxy message) main = do let foo1 = undefined :: Foo "Hello,world!" putStrLn $ getMessage foo1 let foo2 = undefined :: Foo "Hello,types!" putStrLn $ getMessage foo2
インスタンス宣言の中で 型変数のパターンマッチ をしているように見えます。これができるのは ScopedTypeVariables 拡張のおかげです。
また、getMessage は型から取り出した情報だけを使っているので、型さえ合えば undefined を突っ込んでも正常に動きます。不思議ー。
getOptDescr, getUsageHeader, getUsageFooter
型レベル文字列から通常の文字列を取り出す方法が分かってしまえば、残りの関数も似たことをしているんだなーと分かります。
どれも IsCmd クラスのメソッドとして定義されていて、
-- | Command class class IsCmd c where getOptDescr :: c -> [OptDescr (String, String)] default getOptDescr :: (c ~ (a -> b), IsCmd b) => c -> [OptDescr (String, String)] getOptDescr f = getOptDescr $ f undefined getUsageHeader :: c -> String -> String default getUsageHeader :: (c ~ (a -> b), IsCmd b) => c -> String -> String getUsageHeader f = getUsageHeader $ f undefined getUsageFooter :: c -> String -> String default getUsageFooter :: (c ~ (a -> b), IsCmd b) => c -> String -> String getUsageFooter f = getUsageFooter $ f undefined
例えば Flag shortNames longNames placeholder help a -> c 型のインスタンス宣言中で書かれれている getOptDescr の詳細はこんな感じ。
instance ( KnownSymbol shortNames , KnownSymbols longNames , KnownSymbol placeholder , KnownSymbol help , ArgRead a , IsCmd c ) => IsCmd (Flag shortNames longNames placeholder help a -> c) where getOptDescr f = let flagname = head $ symbolVals (Proxy :: Proxy longNames) ++ [ [c] | c <- symbolVal (Proxy :: Proxy shortNames) ] in Option (symbolVal (Proxy :: Proxy shortNames)) (symbolVals (Proxy :: Proxy longNames)) (if needArg (Proxy :: Proxy a) then ReqArg (flagname, ) (symbolVal (Proxy :: Proxy placeholder)) else NoArg (flagname, "t")) (symbolVal (Proxy :: Proxy help)) : getOptDescr (f undefined)
型レベルで埋め込んだ情報を取り出しているのが分かりますよね。
run' 後半部
後半部分では実際のコマンド関数に引数を渡して実行している runCmd が大事そうなのでした。
runCmd もまた様々な型に対して柔軟に適用できるように IsCmd クラスのメソッドとして宣言されています。
runCmd
-- | Command class class IsCmd c where runCmd :: c -> [String] -- ^ Command name -> Maybe String -- ^ Version -> [(String, String)] -- ^ Options -> [String] -- ^ Non options -> [String] -- ^ Unrecognized options -> IO ()
デフォルト実装は無し、インスタンス宣言の方を追っていきましょう。
instance ( KnownSymbol shortNames , KnownSymbols longNames , KnownSymbol placeholder , KnownSymbol help , ArgRead a , IsCmd c ) => IsCmd (Flag shortNames longNames placeholder help a -> c) where runCmd f name mbver options nonOptions unrecognized = let flagname = head $ symbolVals (Proxy :: Proxy longNames) ++ [ [c] | c <- symbolVal (Proxy :: Proxy shortNames) ] mbs = lookup flagname options in case (argRead mbs, mbs) of (Nothing, Nothing) -> errorExit name $ "flag must be specified: --" ++ flagname (Nothing, Just s) -> errorExit name $ "bad argument: --" ++ flagname ++ "=" ++ s (Just arg, _) -> runCmd (f $ Flag arg) name mbver options nonOptions unrecognized
Flag shortNames longNames placeholder help a -> c 型の値に対して runCmd を適用したときは、その Flag が表現している名前付き引数がコマンドラインから与えられるのかを調べていますね。
名前付き引数が与えられていないとき(mbs が Nothing)と、名前付き引数が与えられているとき(mbs が Just s)とで分岐すると同時に、与えられた引数が目的とする型の値として読めるかどうかを argRead でチェックしています。
argRead は ArgRead クラスのメソッドとして宣言されていて、デフォルト実装としては Text.Read モジュールの readMaybe を適用するものになっています。
デフォルト実装を上書きして独自実装で目的の型に変換してあげることも可能そうです。
instance ( KnownSymbol placeholder, IsCmd c ) => IsCmd (Arg placeholder String -> c) where runCmd f name mbver options nonOptions unrecognized = case nonOptions of [] -> errorExit name "not enough arguments" (opt: rest) -> case argRead (Just opt) of Nothing -> errorExit name $ "bad argument: " ++ opt Just arg -> runCmd (f $ Arg arg) name mbver options rest unrecognized
Arg placeholder String -> c 型の値に対して runCmd を適用したときは、名前無しの引数から最初の1つを消費して先ほどと同じように目的とする型の値に読み替えられるかを argRead でチェックしていますね。
消費されなかった名前無し引数は再び runCmd に渡されて再帰的に処理されています。
どうやら runCmd が呼ばれる度に、コマンド実行のために必要な 名前付き引数 と 名前無し引数 が与えられているか、与えられていてかつ目的とする型に合うかどうかをチェックし、加工しながら再帰しているようです。
instance KnownSymbol help => IsCmd (Cmd help ()) where runCmd (Cmd m) name _ options nonOptions unrecognized = case (options, nonOptions, unrecognized) of (_, [], []) -> do let verbosityLevel = fromMaybe 0 $ do s <- lookup "verbose" options if | null s -> return 1 | all (== 'v') s -> return $ length s + 1 | otherwise -> readMaybe s runReaderT m verbosityLevel _ -> do forM_ nonOptions $ \o -> errorExit name $ "unrecognized argument '" ++ o ++ "'" forM_ unrecognized $ \o -> errorExit name $ "unrecognized option '" ++ o ++ "'" exitFailure
そしていよいよ Cmd help () 型の値に対して runCmd を適用したときです。
前段までの引数のチェックと加工でコマンドラインから渡された引数が消費され尽くしたのかをチェックしているようです。
引数が消費され尽くされていれば最後に Verbosity Level を読んでからコマンドを実行。まだ引数が残っていればその旨をエラー通知しています。
コマンドライン引数から実際の値を取り出す get 関数
optparse-declarative はコマンドで必要としている値を、型に情報を付加することで表現しているんでした。
その関係で、コマンド本体の関数に渡される引数やオプションは Arg _a a や Flag _a _b _c _d a といった型をしています。
これらの型の値から実際に使う値を取り出すために get という関数が用意してあります。
最初にも引用したサンプルコードをもう一度引っ張ってくると、
greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" String) -> Arg "NAME" String -> Cmd "Greeting command" () greet msg name = liftIO $ putStrLn $ get msg ++ ", " ++ get name ++ "!"
name といった値を使うときに get name としているのがそれですね。
get もまた様々な型に適用でき、様々な型を返す不思議な関数です。
Option クラスのメソッドとして宣言されています。
-- | Command line option class Option a where -- | Type of the argument' value type Value a :: * -- | Get the argument' value get :: a -> Value a
ここで type キーワードが登場しています。
このキーワードによって Value a が Value a という型では無く、Value という型関数に a という型引数を適用したものだということを表現しているようです。
型を返す関数を定義出来るのは TypeFamilies 拡張のおかげでしたね。
Value a は例えば Int や Maybe String といった具体型になります。
なので get の型も get :: Flag _a _b _c _d Int -> Int や Arg _a String -> String という形になり、あたかも様々な型を返す関数であるように見えます。
Value a の具体的な実装はどうなっているんでしょうか。
instance Option (Arg _a a) where type Value (Arg _a a) = a get = getArg
なるほど、型関数を定義する際には型変数に対してパターンマッチが使えています。
独自の拡張をやってみる
せっかくコードを読み解いて勉強してきたので、optparse-declarative に独自の拡張を追加してみたいと思います。
コマンドオプションとしてリストが受け取れるってのはどうでしょう。
例えば -g オプションに Hello,Hi,Ho のようにカンマ区切りの文字列が渡された場合、内部でリストに変換され、出力は、
$ greet -g Hello,Hi,Ho world Hello, world! Hi, world! Ho, world!
のようになる想定です。
再び optparse-declarative を辿りながら考えたのですが、どうやら [String] を ArgRead クラスのインスタンスにしてあげさえすれば上記目的は達成されるようですね。
与えられた文字列を , で分割して文字列のリストにしてあげるだけなので実装はこんな感じ。
{-# LANGUAGE FlexibleInstances #-} import Data.List.Split instance ArgRead [String] where argRead s = splitOn "," <$> s
たったのこれだけです。
コード全体はこんな感じになりました。
{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} import Control.Monad import Control.Monad.Trans import Data.List.Split import Options.Declarative instance ArgRead [String] where argRead s = splitOn "," <$> s greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" [String]) -> Arg "NAME" String -> Cmd "Greeting command" () greet msgs name = liftIO $ mapM_ (putStrLn . \msg -> msg ++ ", " ++ get name ++ "!") $ get msgs main :: IO () main = run_ greet
実行します。
$ greet -g Hello,Hi,Ho world Hello, world! Hi, world! Ho, world!
なるほど。
感想
1週間ほどかけて optparse-declarative を読んできました。
中でも TypeFamilies 拡張を有効にした型関数定義と型変数に対するパターンマッチは、型を操作する方法として勉強になりました。
型レベル文字列の扱いについて学べたのも良かったですね。
GADTs 拡張で導入される data 宣言の形にも目が慣れてきた気がします。
optparse-declarative は簡素でコンパクトで、読んでいじって学ぶにはオススメです。Haskell 初心者から中級者への足がかりとして読んでみてはいかがでしょうか。
私からは以上です。
