グローバル変数のモジュール性

Haskell

StateT が使えるようになったらグローバル変数みたいなものが簡潔に書けるのかなーと考えました。グローバル変数たちを集めた data 型を定義して、トップレベルは基本的に StateT GlobalVars IO () 型にする感じ。

module Main(main) where
import Control.Monad.State

-- グローバル変数たち
data GlobalVars = GlobalVars { fooField :: Int
                             , barField :: Int
                             } deriving Show

-- トップレベルの型
type GlobalM = StateT GlobalVars IO

-- トップレベル
myMain :: GlobalM ()
myMain = do
    foo <- gets fooField              -- foo を読み出す
    modify $ \g -> g { barField = 1 } -- bar に 1 を書く
    g <- get
    liftIO $ print g                  -- グローバル変数たちを dump する

-- 本当のトップレベル (myMain を呼ぶだけ)
main = evalStateT myMain initGlobalVars

-- グローバル変数たちの初期状態
initGlobalVars = GlobalVars 1 2

この方法の欠点はグローバル変数一覧を列挙しないといけないことです。上の例ではグローバル変数が 2 つしかないのでさほど問題ではありませんが、普通はもっと多数になります。これを全部フラットに並べるのは何となく避けたいです。以下のように、まとめて使うことの多い変数をまとめた data 型を定義して、階層的にしたいと思います。

data GlobalVars = GlobalVars { module1Vars :: Module1Vars
                             , module2Vars :: Module2Vars
                             } deriving Show
data Module1Vars = Module1Vars { fooField :: Int
                               , barField :: Int
                               } deriving Show
data Module2Vars = Module2Vars { bazField :: Int
                               , quxField :: Int
                               } deriving Show

すると、読み出しや書き込みがひどく煩雑になってしまいます。とくに書き出し。そのくせ変数をまとめた意味がほとんどありません。

myMain = do
    -- module1 の foo を読み出す
    foo <- gets $ fooField . module1Vars
    -- module1 の bar に 1 を書く
    modify $ \g -> g { module1Vars = module1Vars g { barField = 1 } }

「この範囲では module1 の変数しかいじらない！」と決めるなら、以下のように書けます。

myMain = do
    -- ここから GlobalVars の世界 (get や put の対象は GlobalVars)
    -- Module1Vars を取り出す
    m1vs <- gets module1Vars
    -- ここまで GlobalVars の世界
    m1vs' <- (`execStateT` m1vs) $ do
        -- ここから Module1Vars の世界 (get や put の対象は Module1Vars)
        foo <- gets fooField              -- foo を読み出す
        modify $ \g -> g { barField = 1 } -- bar に 1 を書く
        g <- get
        liftIO $ print g                  -- グローバル変数たちを dump する
                                          -- と思ったらできない
        -- ここまで Module1Vars の世界
    -- ここから GlobalVars の世界
    -- GlobalVars 中の Module1Vars に更新結果を反映する
    modify $ \g -> g { module1Vars = m1vs' }
    -- ここまで GlobalVars の世界

しかしこの方法では、コメントにあるように、Module1Vars の世界からグローバル変数たち全部を dump することができません。Module1Vars の世界から GlobalVars を参照できないためです。ある意味隠蔽なので良い性質なのですが、世の中そんなにかっちりモジュール分けできる人間はほとんどいないと思います。なので、「デフォルトでは Module1Vars をいじるけど、特別なときだけ覗き穴経由で GlobalVars もいじれるような仕組み」が欲しいと思います。以下のようなの。

myMain = do
    localModule1 $ do
        -- ここから Module1Vars の世界 (get や put の対象は Module1Vars)
        -- foo を読み出す
        foo <- gets fooField
        -- bar に 1 を書く
        modify $ \g -> g { barField = 1 }
        -- 覗き穴を開いて GlobalVars の世界をつつく
        globalFromModule1 $ do
            -- ここだけ GlobalVars の世界
            --  (get や put の対象は GlobalVars)
            -- グローバル変数たちを dump する
            get >>= liftIO . print

上の例は小さいのでありがたみが見えないかもしれませんが、規模が大きくなればありがたみが感じられると思います。まだ自分でも使ったことないのでわかりませんが。さて、これをどうやって実現するかというと、以下のように自分でモナドとかをインスタンス化します。コンパイルには -fglasgow-exts をつけてください。

-- Module1Vars の世界を表すモナドを作る型
newtype Module1T m a = Module1T { runModule1T :: m a }

localModule1 = runModule1T
globalFromModule1 = Module1T

instance Monad (Module1T GlobalM) where
    return = globalFromModule1 . return
    m >>= k = globalFromModule1 $ localModule1 m >>= localModule1 . k

instance MonadState Module1Vars (Module1T GlobalM) where
    put v = globalFromModule1 . modify $ \d -> d { module1Vars = v }
    get = globalFromModule1 $ gets module1Vars

instance MonadIO (Module1T GlobalM) where
    liftIO = globalFromModule1 . liftIO

Functor とかもインスタンス化したほうがいいのかもしれませんが、とりあえずこれで望みの挙動が得られました。でも、これと同じ物を Module2Vars に対しても書かないといけません。Module3Vars が増えたらまた書かないといけません。こういうところは最小化したいです。そこで次のようなものを書きました (本題) 。コンパイルには -fallow-undecidable-instances をつけてください *1 。

class Scope v t | v -> t, t -> v where
    global  :: GlobalM x -> t GlobalM x
    local   :: t GlobalM x -> GlobalM x
    update  :: v -> GlobalVars -> GlobalVars
    extract :: GlobalVars -> v

instance Scope v t => Monad (t GlobalM) where
    return = global . return
    m >>= k = global $ local m >>= (local . k)

instance Scope v t => MonadState v (t GlobalM) where
    put = global . modify . update
    get = global $ gets extract

instance Scope v t => MonadIO (t GlobalM) where
    liftIO = global . liftIO

以下のようにするだけ (というほど少なくないけど) で localModule1 と localModule2 と global が使えるようになりました。

newtype Module1T m a = Module1T { runModule1T :: m a }
instance Scope Mod1Vars Module1T where
    global  = Module1T
    local   = runModule1T
    update v w = w { Mod1Vars = v }
    extract = Mod1Vars
localModule1 = local :: Module1T GlobalM x -> GlobalM x

newtype Module2T m a = Module2T { runModule2T :: m a }
instance Scope Mod2Vars Module2T where
    global  = Module2T
    local   = runModule2T
    update v w = w { Mod2Vars = v }
    extract = Mod2Vars
localModule2 = local :: Module2T GlobalM x -> GlobalM x

localModule1 などをいちいち型注釈つけて定義しているのは、オーバーロードが解決できないといってコンパイラが泣くからです。globalFromModule1 なんかはコンパイラが解決してくれるので global だけでいいです。


以上、試行錯誤してたらたまたまコンパイルが通ったコードを晒してみました。functional dependency？なにそれ、おいしい？
こんなことぐだぐだ考えずに IORef 使ったり unsafePerformIO 使ったり implicit parameter 使ったりする方がいいのかもしれません。実行速度も速そうだし。


ほんのちょっとだけ調べた先人の記録。


最後に全部のコード。

{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}

module Main(main) where

import Control.Monad.State

data GlobalVars = GlobalVars { Mod1Vars :: Mod1Vars, Mod2Vars :: Mod2Vars } deriving Show
data Mod1Vars = Mod1Vars { mod1Field1 :: Int, mod1Field2 :: Int } deriving Show
data Mod2Vars = Mod2Vars { mod2Field1 :: Int, mod2Field2 :: Int } deriving Show

type GlobalM = StateT GlobalVars IO

class Scope v t | v -> t, t -> v where
    global  :: GlobalM x -> t GlobalM x
    local   :: t GlobalM x -> GlobalM x
    update  :: v -> GlobalVars -> GlobalVars
    extract :: GlobalVars -> v

instance Scope v t => Monad (t GlobalM) where
    return = global . return
    m >>= k = global $ local m >>= (local . k)

instance Scope v t => MonadState v (t GlobalM) where
    put = global . modify . update
    get = global $ gets extract

instance Scope v t => MonadIO (t GlobalM) where
    liftIO = global . liftIO


newtype Module1T m a = Module1T { runModule1T :: m a }
newtype Module2T m a = Module2T { runModule2T :: m a }

instance Scope Mod1Vars Module1T where
    global  = Module1T
    local   = runModule1T
    update v w = w { Mod1Vars = v }
    extract = Mod1Vars
instance Scope Mod2Vars Module2T where
    global  = Module2T
    local   = runModule2T
    update v w = w { Mod2Vars = v }
    extract = Mod2Vars

localMod1 = local :: Module1T GlobalM x -> GlobalM x
localMod2 = local :: Module2T GlobalM x -> GlobalM x

sampleGlobalVars = GlobalVars sampleMod1Vars sampleMod2Vars
sampleMod1Vars = Mod1Vars 1 2
sampleMod2Vars = Mod2Vars 3 4

main :: IO ()
main = do
    (`evalStateT` sampleGlobalVars) $ do
        localMod1 $ do
            modify $ \d -> d { mod1Field1 = mod1Field1 d + 10 }
            global $ do
                get >>= liftIO . print
                modify $ \d -> let d2 = Mod2Vars d in d { Mod2Vars = d2 { mod2Field1 = mod2Field1 d2 + 20 } }
        localMod2 $ do
            modify $ \d -> d { mod2Field2 = mod2Field2 d + 30 }
        get >>= liftIO . print

*1:って、undecidable とかどんな影響があるんでしょう。よくわかんないので自己責任で。