コメントの抽出

下のページのコメント部分を抜き出すというお題が前から気になっていたので、書き直してシンプルにして(劣化？)みた。コアな部分はあまり変わっていないので面白くないかもしれない。
http://ls-al.jp/blog2/category_11/item_498.html

module Main(main) where
import System.Environment
import System.IO
import Char

main = getArgs >>= (\a-> openBinaryFile (a !! 0) ReadMode) >>= hGetContents >>= (return.getSrcComment) >>= (\a->openBinaryFile "./out.txt" WriteMode >>= (\h-> hPutStr h a >> hClose h))

getSrcComment::String->String
getSrcComment src = 
    concat $map trimEmpty $map getResult $ zip (tail $ scanl commentFilterHs (0,0) [(idx,src)| idx <- [0.. (length src) -1]]) src

commentFilterHs (prevFlag, ownFlag) (idx,str) 
              | prevFlag == 1 && c1 == '-' && c2 == '-' && c3 == '}' = (0,0)
              | prevFlag == 0 && c1 == '{' && c2 == '-' && c3 == '-' = (1,1)
              | prevFlag == 2 && c2 == '\n' = (0,1)
              | prevFlag == 0 && c2 == '-' && c3 == '-' = (2,1)
              | prevFlag == 9 && c2 == '"' = (0,0)
              | prevFlag == 0 && c2 == '"' = (9,0)
              | prevFlag == 9 = (9,0)
              | prevFlag == 1 = (1,1)
              | prevFlag == 2 = (2,1)
                                where
                                  c1 = if idx -1 >= 0 then str !! (idx -1) else '\NUL'
                                  c2 = str !! idx
                                  c3 = if idx +1 < length str then str !! (idx +1) else '\NUL'
commentFilterHs (prevFlag, ownFlag) (idx,str) = (0,0)

getResult ((prevFlag, ownFlag), c) 
          | ownFlag == 1 = c
getResult ((prevFlag, ownFlag), c) = chr 0

trimEmpty c |ord c == 0 = ""
trimEmpty c = c:[]

せっかくコメントを抜き出しても日本語が化けてしまうのでバイナリopenにしてみた。
パラメータの文字数3という制限をなくしたので、解析メソッドを拡張することでもっといろんなことができるかもしれない。
さらに手を加えるとするならStateを使って実装するとか。