Stateモナドを利用して、gifヘッダの解析をやってみた

Stateモナドで状態を引き回す

とりあえず暇だったので、GIF画像のヘッダ情報を解析するコードをHaskellで書いてみました。

GIFヘッダは

• Gif Header
• Image Block
• Graphic Control Extension
• Comment Extention
• Plain Text Extention
• Application Extention

というように、分かれていますが、今回は「Gif Header」だけに限って解析してみました。

まずperlのgifcat.plを利用して情報を見てみる

あの有名なperlスクリプト、gifcat.plスクリプトを利用してヘッダ情報を確認してみる、
こんな感じのラッパースクリプトを作成して確認。
もちろん、gifcat.plは別途用意してください。

#!/usr/bin/perl

require "gifcat.pl";
@files = ("ai.gif");          # 解析したいGIF画像
print &gifcat'gifcat(@files);

このスクリプトを実行しますと、この様にヘッダ情報が確認できます。

cuomo@karky7 ~ $ perl checkGifHead.pl
=====================================
GifHeader
=====================================
Signature:                     GIF
Version:                       89a
Logical Screen Width:          300
Logical Screen Height:         423
Global Color Table Flag:       1
Color Resolution:              7
Sort Flag:                     0
Size of Global Color Table:    256 * 3
Background Color Index:        255
Pixel Aspect Ratio:            0
Global Color Table:
  10 0F 04 1B 15 05 24 15 06 32 18 0C 33 16 1F 26
  1E 0C 2E 1E 0D 39 1D 09 52 14 19 27 20 28 26 20
  2F 35 20 09 2E 23 08 32 22 09 6E 13 1D 2C 26 33
  4E 1D 2E 33 28 11 33 29 0A 39 27 0E 27 2A 33 4E
  22 12 2C 28 3C 65 18 36 3A 28 18 41 26 1B 39 26
  35 44 27 12 4B 25 12 49 29 0C 3A 2B 2B 41 2D 0C
  40 2D 13 3B 2F 10 46 2D 06 4D 25 45 56 2D 12 55
  2D 1A 62 2A 14 59 2C 1B 44 34 12 5C 2D 16 39 34
  40 50 31 1A 49 34 1A 43 36 19 53 32 15 4D 34 14
  4F 32 26 35 36 50 48 35 2B 96 21 27 4A 3A 17 A3
  1F 1E 8A 29 34 9C 23 3B 52 3F 16 5A 3D 1C 50 41
  1E 89 2C 48 6B 3A 17 54 40 20 50 40 2C 6F 38 20
  62 3C 1F 75 37 1F 69 3B 20 61 3D 26 67 3B 29 5C
  40 2E 5C 41 26 82 31 58 C5 24 2E 56 47 23 6A 3D
  4F 62 45 24 5C 47 24 5A 47 2C 5F 40 63 50 44 72
  43 4A 63 4E 49 51 7D 43 19 5C 4A 44 88 41 2B 62
  4D 2A C7 2D 40 3F 50 76 7F 45 2B 84 44 2A 6B 4C
  2B 7B 48 24 73 4B 2C 7A 49 2D 74 4D 1C 78 4A 37
  6F 4D 34 BA 37 3E 6D 4E 3D 63 52 3C C7 33 52 BA
  3D 52 BB 3B 65 92 50 35 8E 52 38 99 4F 36 8D 56
  32 8A 58 3C 88 58 44 82 5B 3A A8 4C 6A AE 4D 4F
  80 5C 42 7C 5D 4B A9 56 31 93 5E 2F B3 55 30 4F
  69 93 A2 5B 32 8F 5C 6F 7A 60 88 5E 69 82 75 68
  66 A2 5E 45 96 63 47 AA 5E 45 9F 64 40 E2 4E 5D
  93 6A 49 8C 6B 59 99 68 52 91 6B 51 9F 6A 4D D0
  66 3B D4 63 66 A5 74 57 B8 70 51 C3 6F 46 E1 61
  7C AD 74 5C B5 74 47 AB 77 54 D1 69 7B 9E 7B 5F
  9E 7D 51 A7 79 61 C8 74 3B C6 72 68 C0 72 94 C5
  73 7D AE 7D 5F 67 8A B3 8D 88 7F A5 83 74 B2 83
  4F B9 7D 79 A6 83 8C 81 8D A4 B3 85 6D C4 80 6D
  B6 85 66 CC 81 62 CE 82 58 BE 85 6D BC 87 63 B2
  8B 62 C7 86 57 B4 8E 6F BD 8C 6D AA 8C AB BC 8E
  74 E1 89 57 D9 8A 68 E8 84 7E D6 8D 79 C2 95 74
  E0 90 4F C9 93 79 DC 8F 73 C3 96 7C D2 94 68 D4
  92 7B DA 94 5F CF 96 73 EB 8C 95 C1 9A 8C CA 9B
  74 D4 9A 63 D2 9B 80 CA 9E 84 CD 9E 7D E5 96 AD
  E6 9D 8B CF A7 75 9C AE C8 B1 AC AB D1 A2 B0 DB
  A4 86 DF A5 77 DF A3 8B D1 A7 8D D9 A6 80 EA A3
  6D F0 A3 65 F3 A3 60 D6 A9 87 DC A7 8F C7 AD 9B
  E6 AA 72 D3 AC 9C CF B0 90 D9 AF 94 EA B2 95 F0
  B4 7F E6 B6 98 F8 B4 77 ED B3 B0 DE B9 A2 E1 BA
  9B E5 B8 A4 EA BB 93 DA BD B0 D5 C2 9A E3 C0 85
  EF B9 CA D7 C3 AE B9 C8 D9 F6 BE 89 E6 C2 A9 E4
  C4 B0 F5 C3 95 E7 CB 96 E4 C6 D1 FA C6 91 CD D0
  D5 F7 C9 A0 F3 CC A9 EF CD B3 EA D0 AB ED CE B9
  EF CD C3 FA C9 CB F3 CD CB EA D3 BB EF D3 C4 EB
  D7 C6 E4 D9 C8 F4 DE CD F6 E0 B8 F5 E3 D8 F3 E6
  D2 DF EC E5 F4 EA DD FE F2 E5 F8 F4 E4 F5 F7 EF
...
...
...
cuomo@karky7 ~ $

今度は、haskellでやってみる

まずは、解析したいGIF画像を選ぶのですが、私は「篠崎愛ちゃん」のファンでしたが、最近は心境の変化により若干趣味思考が変わってきたのでサヨナラの意味も込めて、「篠崎愛ちゃん」のGIFヘッダを解析して、心の区切りをつけようと思います。

デスから、画像はこれ、

これをGIFに変換したものを利用します。
で、コードはこちら、Stateモナドを利用してGIFのバイトデータを1バイトづつ解析しています。

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy as L
import System.Environment (getArgs)
import Control.Applicative ((<$>))
import Control.Monad.State
import Data.Bits ((.&.), shiftR)
import Data.Int
import Data.Word
import Data.Char
import Text.Printf


data GifHeader = GifHeader {
  signature        :: L8.ByteString,     -- GIF for 3bytes
  version          :: L8.ByteString,     -- Version 3bytes
  log_sc_width     :: Word16,            -- Logical Screen width 2bytes
  log_sc_height    :: Word16,            -- Logical Screen height 2bytes
  packfeild        :: Word8,             -- Image info 1byte
  bgcol_idx        :: Word8,             -- Background color index 1byte
  pix_asp_ratio    :: Word8,
  global_col_tbl   :: L8.ByteString      -- Global Color table
} deriving (Show)


data StateBuffer = StateBuffer {
  buffer :: L8.ByteString,
  offset :: Int64
} deriving(Show)


type StateBuff a = State StateBuffer a


parseBytes :: Int64 -> StateBuff L.ByteString
parseBytes n = get >>= \st ->
  case L.splitAt n (buffer st) of
    (bs, remainder) -> put new_state >>= \_ -> return bs
      where new_state = StateBuffer { buffer = remainder,
                                  offset = new_offset }
            new_offset = offset st + n


settpl :: L.ByteString -> [(Word8, Int)]
settpl v = zip v' [1 .. length v']
           where v' = L.unpack v


toWord8 :: (Enum a) => a -> Word8
toWord8 = toEnum . fromEnum


toWord16 :: (Enum a) => a -> Word16
toWord16 = toEnum . fromEnum


sumWord8 :: Enum a => (a, Int) -> Word16 -> Word16
sumWord8 (w, v) b = (toWord16 w) * (toWord16 v ^ 8) + b


getWord :: Int64 -> StateBuff [(Word8, Int)]
getWord n = settpl <$> parseBytes n


parseW8 :: StateBuff Word8
parseW8 = head . L.unpack <$> parseBytes 1


parseW16toInt :: StateBuff Word16
parseW16toInt = foldr sumWord8 0 <$> getWord 2


sizeOfGCT :: Word8 -> Int64
sizeOfGCT feild
  | (f /= 0) = 3 * 2 ^ ((feild .&. 0x07) + 1)
  | otherwise = 0
  where f = (feild .&. 0x80)


sizeOfSGCT :: Word8 -> Int
sizeOfSGCT bf = 2 ^ ((bf .&. 0x07) + 1)


readGifHeader :: StateBuff GifHeader
readGifHeader = parseBytes 3 >>= \sig ->
  parseBytes 3 >>= \ver ->
  parseW16toInt >>= \lw ->
  parseW16toInt >>= \lh ->
  parseW8       >>= \pf ->
  parseW8       >>= \bgi ->
  parseW8       >>= \pixar ->
  parseBytes (sizeOfGCT pf) >>= \gct ->
  return GifHeader { signature = sig,
                     version = ver,
                     log_sc_width = lw,
                     log_sc_height = lh,
                     packfeild = pf,
                     bgcol_idx = bgi,
                     pix_asp_ratio = pixar,
                     global_col_tbl = gct }


readGifFile :: FilePath -> IO L.ByteString
readGifFile filename = L.readFile filename


wordToChar :: Word8 -> Char
wordToChar = chr . fromIntegral


toWordsToChar :: L.ByteString -> [Char]
toWordsToChar = (map wordToChar) . L.unpack


isColTableFlag :: Word8 -> Int
isColTableFlag bf
  | f /= 0 = 1
  | otherwise = 0
     where f = bf .&. 0x80


getColResolusion :: Word8 -> Word8
getColResolusion bf = (bf `shiftR` 4) .&. 0x07 + 1


getSortFlag :: Word8 -> Word8
getSortFlag bf = (bf `shiftR` 3) .&. 0x01


putGifHeader :: GifHeader -> IO ()
putGifHeader v = do
    putStr $ "====================\n" ++
           "GifHeader \n" ++
           "====================\n" ++
           "Signature:                     " ++ toWordsToChar (signature v) ++ "\n" ++ 
           "Version:                       " ++ toWordsToChar (version v) ++ "\n" ++
           "Logical Screen Width:          " ++ show (log_sc_width v) ++ "\n" ++
           "Logical Screen Height:         " ++ show (log_sc_height v) ++ "\n" ++
           "Global Color Table Flag:       " ++ show (packfeild v) ++ "(" ++ show (isColTableFlag $ packfeild v) ++ ")" ++ "\n" ++
           "Color Resolution:              " ++ show (getColResolusion $ packfeild v) ++ "\n" ++
           "Sort Flag:                     " ++ show (getSortFlag $ packfeild v) ++ "\n" ++
           "Size of Global Color Table:    " ++ show (sizeOfGCT $ packfeild v) ++ "(" ++ show (sizeOfSGCT (packfeild v)) ++ " * 3)" ++ "\n" ++
           "Background Color Index:        " ++ show (bgcol_idx v) ++ "\n" ++
           "Pixel Aspect Ratio:            " ++ show (pix_asp_ratio v) ++ "\n" ++
           "Global Color Table:             \n"
    putStr $ dump (L.unpack $ global_col_tbl v)


printByte :: Word8 -> String
printByte = printf "%02X "


dump ::  [Word8] -> String
dump = dump' 0


dump' :: Int64 -> [Word8] -> String
dump' _ [] = "\n"
dump' i (b:xs)
  | (i `mod` 16 == 0) = "  " ++ printByte b ++ dump' (i+1) xs
  | (i `mod` 16 == 15) = printByte b ++ "\n" ++ dump' (i+1) xs
  | otherwise = printByte b ++ dump' (i+1) xs


putRemainState :: StateBuffer -> IO ()
putRemainState s = do
    let buff = buffer s
        off = offset s
    putStr $ "-------------------\n" ++
           "StateBuffer \n" ++
           "-------------------\n" ++
           "offset:      " ++ show(off) ++ "\n" ++
           "Remain buffer:\n"
    putStr $ dump (L.unpack buff)


initStateBuffer :: L8.ByteString -> StateBuffer
initStateBuffer buff = StateBuffer { buffer = buff, offset = 0 }


main :: IO()
main = do
  args <- getArgs
  buff <- readGifFile $ head args
  let (h, s) = runState readGifHeader $ initStateBuffer buff
  putGifHeader h
  putRemainState s

実行してみると、

cuomo@karky7 ~ $ runghc gifcat2.hs ai.gif
====================
GifHeader
====================
Signature:                     GIF
Version:                       89a
Logical Screen Width:          300
Logical Screen Height:         423
Global Color Table Flag:       231(1)
Color Resolution:              7
Sort Flag:                     0
Size of Global Color Table:    768(256 * 3)
Background Color Index:        255
Pixel Aspect Ratio:            0
Global Color Table:
  10 0F 04 1B 15 05 24 15 06 32 18 0C 33 16 1F 26
  1E 0C 2E 1E 0D 39 1D 09 52 14 19 27 20 28 26 20
  2F 35 20 09 2E 23 08 32 22 09 6E 13 1D 2C 26 33
  4E 1D 2E 33 28 11 33 29 0A 39 27 0E 27 2A 33 4E
  22 12 2C 28 3C 65 18 36 3A 28 18 41 26 1B 39 26
  35 44 27 12 4B 25 12 49 29 0C 3A 2B 2B 41 2D 0C
  40 2D 13 3B 2F 10 46 2D 06 4D 25 45 56 2D 12 55
  2D 1A 62 2A 14 59 2C 1B 44 34 12 5C 2D 16 39 34
  40 50 31 1A 49 34 1A 43 36 19 53 32 15 4D 34 14
  4F 32 26 35 36 50 48 35 2B 96 21 27 4A 3A 17 A3
  1F 1E 8A 29 34 9C 23 3B 52 3F 16 5A 3D 1C 50 41
  1E 89 2C 48 6B 3A 17 54 40 20 50 40 2C 6F 38 20
  62 3C 1F 75 37 1F 69 3B 20 61 3D 26 67 3B 29 5C
  40 2E 5C 41 26 82 31 58 C5 24 2E 56 47 23 6A 3D
  4F 62 45 24 5C 47 24 5A 47 2C 5F 40 63 50 44 72
  43 4A 63 4E 49 51 7D 43 19 5C 4A 44 88 41 2B 62
  4D 2A C7 2D 40 3F 50 76 7F 45 2B 84 44 2A 6B 4C
  2B 7B 48 24 73 4B 2C 7A 49 2D 74 4D 1C 78 4A 37
  6F 4D 34 BA 37 3E 6D 4E 3D 63 52 3C C7 33 52 BA
  3D 52 BB 3B 65 92 50 35 8E 52 38 99 4F 36 8D 56
  32 8A 58 3C 88 58 44 82 5B 3A A8 4C 6A AE 4D 4F
  80 5C 42 7C 5D 4B A9 56 31 93 5E 2F B3 55 30 4F
  69 93 A2 5B 32 8F 5C 6F 7A 60 88 5E 69 82 75 68
  66 A2 5E 45 96 63 47 AA 5E 45 9F 64 40 E2 4E 5D
  93 6A 49 8C 6B 59 99 68 52 91 6B 51 9F 6A 4D D0
  66 3B D4 63 66 A5 74 57 B8 70 51 C3 6F 46 E1 61
  7C AD 74 5C B5 74 47 AB 77 54 D1 69 7B 9E 7B 5F
  9E 7D 51 A7 79 61 C8 74 3B C6 72 68 C0 72 94 C5
  73 7D AE 7D 5F 67 8A B3 8D 88 7F A5 83 74 B2 83
  4F B9 7D 79 A6 83 8C 81 8D A4 B3 85 6D C4 80 6D
  B6 85 66 CC 81 62 CE 82 58 BE 85 6D BC 87 63 B2
  8B 62 C7 86 57 B4 8E 6F BD 8C 6D AA 8C AB BC 8E
  74 E1 89 57 D9 8A 68 E8 84 7E D6 8D 79 C2 95 74
  E0 90 4F C9 93 79 DC 8F 73 C3 96 7C D2 94 68 D4
  92 7B DA 94 5F CF 96 73 EB 8C 95 C1 9A 8C CA 9B
  74 D4 9A 63 D2 9B 80 CA 9E 84 CD 9E 7D E5 96 AD
  E6 9D 8B CF A7 75 9C AE C8 B1 AC AB D1 A2 B0 DB
  A4 86 DF A5 77 DF A3 8B D1 A7 8D D9 A6 80 EA A3
  6D F0 A3 65 F3 A3 60 D6 A9 87 DC A7 8F C7 AD 9B
  E6 AA 72 D3 AC 9C CF B0 90 D9 AF 94 EA B2 95 F0
  B4 7F E6 B6 98 F8 B4 77 ED B3 B0 DE B9 A2 E1 BA
  9B E5 B8 A4 EA BB 93 DA BD B0 D5 C2 9A E3 C0 85
  EF B9 CA D7 C3 AE B9 C8 D9 F6 BE 89 E6 C2 A9 E4
  C4 B0 F5 C3 95 E7 CB 96 E4 C6 D1 FA C6 91 CD D0
  D5 F7 C9 A0 F3 CC A9 EF CD B3 EA D0 AB ED CE B9
  EF CD C3 FA C9 CB F3 CD CB EA D3 BB EF D3 C4 EB
  D7 C6 E4 D9 C8 F4 DE CD F6 E0 B8 F5 E3 D8 F3 E6
  D2 DF EC E5 F4 EA DD FE F2 E5 F8 F4 E4 F5 F7 EF

-------------------
StateBuffer
-------------------
offset:      781
Remain buffer:
  21 FE 11 43 72 65 61 74 65 64 20 77 69 74 68 20
  47 49 4D 50 00 2C 00 00 00 00 2C 01 A7 01 00 08
  FE 00 B5 B1 1B 48 90 1D 37 2F 2E 56 28 64 C1 62
  C5 86 87 10 1F 82 58 40 71 82 C5 09 11 22 48 08
  C1 31 84 84 8F 12 22 30 10 C9 60 64 49 92 23 51
  96 5C C9 B2 A5 4B 06 05 5E 96 04 39 73 A6 04 06
  0D 24 34 D8 C9 12 E4 C7 10 20 72 B8 68 E3 02 0C
  18 17 42 81 2C 21 E1 A2 83 C3 40 07 38 38 3C 70
  60 81 01 01 02 00 68 D5 1A 20 00 06 01 18 AE 1A
  28 00 A0 EB D6 B2 01 B8 16 28 90 F6 AC DB B7 70
  E3 CA 95 DB 16 2D DA AE 6B 33 5A 04 C1 B7 2F DF
  10 2D 5A A0 08 8C A2 30 C7 16 1D 13 2B F6 B9 B1
  E3 CD 8C 1A 43 92 6C B0 F6 AA 00 81 05 07 72 23
  BA 90 61 43 85 11 1F 52 5C 70 11 A3 46 C5 1E 21
  AB 26 29 92 B5 CC D7 2F D7 CA 64 CC E0 E6 47 9C
  3A 79 D6 66 0C 94 45 8E 36 6D 80 18 75 01 A4 B8
  8B A6 2E 86 04 82 B1 02 48 07 AA 03 BE 66 AD 5B
  36 82 81 B0 60 B3 0A A0 BE 35 C0 5A B3 DC E7 FE
  8A 1F 4F FE EE 5D EF 05 22 EC 9C E0 B7 2F E0 C0
  82 0B A3 08 31 FF 30 6A C7 1E 41 7A 4C 0D F9 A3
  46 92 6B 61 25 00 39 99 0D B4 0E 24 09 AD E0 D9
  67 A1 89 56 D1 45 19 6D 24 A1 4F AD AD 94 91 85
  26 C1 A6 21 4B 31 CD 56 DB 4A 37 D5 96 D3 4E 39
  D9 A6 5F 0B 20 14 91 C3 20 5A 14 05 06 17 4B B8
  40 02 10 4C 81 21 06 1C 1C 0C D1 D4 06 03 64 80
  15 77 E9 C9 80 9D 0C 58 B1 D5 5D 5B 02 7C C7 55
  79 4C 36 39 57 5A 5D 45 99 9E 7A EC B5 07 02 7D
  82 11 56 1F 7D F7 DD 37 E1 7E 92 45 28 52 48 38
  05 88 15 66 99 1D ...
  ....

これで、「愛ちゃん」ヘッダ情報があらわになりました、StateBufferの項目は、まだ解析されていない残りのgifデータが格納されています...裸も同然です。

haskellでやる良さ

だいたい手続き型の言語でバッファのデータを消費していくようなコードを書くと、バッファにインデックスでアクセスしていくようなループ処理になると思いますが、機能別に関数に分けたりすると、関数別にインデックスを進めるような感じのコードになりがちで、いまいち綺麗じゃありませんよね。まぁもうちょい頭を使えば綺麗にはなるとは思いますが...適当に書くとこんな感じかと。 適当に考えたコード

main()
{
    int cnt;
    Byte buff = read("ai.gif");
    cnt = func1(&buff, 0);
    cnt = func2(&buff, cnt);
    ...
    ...
}

int func1(Byte *buff, int start_index)
{
 int cnt = 0;
 ...
 // 消費したバイト数をかえす
 return start_index + cnt;
}

int func2(Byte *buff, int start_index)
{
 int cnt = 0;
 ...
 return start_index + cnt;
}
...
...

haskell版のコードの場合、その辺の細々した詳細をStateモナドが隠してくれているので、実際のヘッダ解析の処理にバッファのインデックスを操作する処理が見えないところが、余計な事を考えず処理を書くことに集中させてくれます。
さらに、parseBytesの引数に与えた取得したいバイト数しか、インデックスが進む事がないので、間違いが起こりにくい所なんかいいんではないでしょうか。
もし間違いがあるとすれば、readGifHeader関数で(>>=)で繋いでる関数に問題があるのがほぼ確定的に分かります。
それと、状態関数を走らせた後の結果に、直接別の関数を適用させる、ファンクターのfmapなんかすごくコードをシンプルしてくれます。

Stateモナドは、状態を持ち回る関数をコンビネータとしてつないで書いといて、初期状態を与えることによってつないである関数を走らせる、という難解なもののうちの１種だと私は思いますが、理解すると「これだ！」って感じにさせてくれるのが、私にとってのhaskellで、止められません...

「大人の表情(かお)をしたキミに、鼓動が高鳴る」とか言われたらアウトでしょ....