cabal sandbox環境のpackage DBを参照する

Haskell

cabal-install-1.18 がきた．全国のHaskeller待望のcabal sandboxが使える．cabal-devさん今までありがとう．さようなら．


この記事は余計なことをしている可能性があります！


さて，テスト時にプログラムをビルドする必要があるとする．これは*.cabalファイルに設定したtest-suiteのプログラムのことではなく，test-suiteのプログラム内からさらにghcを呼び出してビルドするようなケースだ．たとえば，gracefulパッケージなどは「特定のsignalを受けて何かするプロセス」を作るためのパッケージなので，テストの中でそのプロセスをビルドして立ち上げている．他にもTemplateHaskell系のパッケージだとビルドそのものができるかというテスト書く必要とかもあるのでは？

この際，package DB(以前はpackage conf)が指定されていなければ，*.cabalに設定されたbuild-dependsが取れないので，通常は-package-db(もしくは-package-conf)オプションに"dist/package.conf.inplace"を渡す必要がある．

$ ghc --make Foo.hs -package-db "dist/package.conf.inplace"

しかし，cabal/cabal-devまでの世界であればconfig dist prefixは大体"dist"固定で考えていればよかった(debを作ろうとすると"dist-ghc"とか違う名前を設定したりするみたいだけど)が，cabal sandboxではそうもいかなくなった．sandbox環境ではconfig dist prefixが"dist/dist-sandbox-[HEX8桁]"という名前になる．このHEX8桁部分はどの設定ファイルにも吐き出されてないみたいなので，sandbox環境でも同様にテストを流すためには自分で構成してあげなければならない．

で，どうやらこのHEX8桁部分はJenkins hash functionで".cabal-sandbox"ディレクトリのフルパスをハッシュしたものらしい．たとえば，*.cabalファイルの置かれているディレクトリが"/home/notogawa/work/somepackage"で，この環境をsandbox化すると"/home/notogawa/work/somepackage/.cabal-sandbox"ができ，この環境では"/home/notogawa/work/somepackage/dist/dist-sandbox-975dcfa2"がconfig dist prefixになる．

結局，sandbox環境でもそうでなくとも適切にpackage DBを設定して*.cabalのbuild-dependsを反映させてビルドするためのコードはたとえば次のようになる．

packageOption :: String
#if __GLASGOW_HASKELL__ < 706
packageOption = "-package-conf"
#else
packageOption = "-package-db"
#endif

build :: FilePath -> IO ()
build file = do
  conf <- packageConf
  (code, _out, _err) <- readProcessWithExitCode "ghc"
                        [ "--make", file
                        , packageOption, conf
                        ] ""
  code `shouldBe` ExitSuccess

packageConf :: IO FilePath
packageConf = maybe "dist/package.conf.inplace" id `fmap`
              sandboxPackageConf

sandboxPackageConf :: IO (Maybe FilePath)
sandboxPackageConf = do
  cd <- getCurrentDirectory
  let prefix = cd ++ "/.cabal-sandbox"
  let confDistDir = "dist/dist-sandbox-" ++ showHex (jenkins prefix) ""
  let conf = confDistDir ++ "/package.conf.inplace"
  putStrLn conf
  exist <- doesFileExist conf
  return $ if exist then Just conf else Nothing

jenkins :: String -> Word32
jenkins str = loop_finish $ foldl' loop 0 str
  where
    loop :: Word32 -> Char -> Word32
    loop hash key_i' = hash'''
      where
        key_i   = toEnum . ord $ key_i'
        hash'   = hash + key_i
        hash''  = hash' + shiftL hash' 10
        hash''' = hash'' `xor` shiftR hash'' 6
    loop_finish :: Word32 -> Word32
    loop_finish hash = hash'''
      where
        hash'   = hash + shiftL hash 3
        hash''  = hash' `xor` shiftR hash' 11
        hash''' = hash'' + shiftL hash'' 15