Line Numbers

練習用 State monad 寫「為一個檔案加上行號」的程式。想法是這樣：先用 lines 把 input string 切割成 list of lines，然後把每個 string 變成 State monad 之後接成一個超大的 State monad，最後加以核算。可是結果看起來不太令人滿意（以下是用 "runghc lineno.hs < lineno.hs" 指令產生）：

 1: import Data.List
 2: import Control.Arrow
 3: import Control.Monad.State
 4: 
 5: main = getContents >>=
 6:          putStr . uncurry ($) . (id *** g) . flip runState 0 .
 7:          foldr (combine . monadise) (return (const "")) . lines
 8:   where g :: Integer -> Integer -> String
 9:         g n = (++ ": ") .
10:               until ((>= 1 + (floor . logBase 10 . fromInteger) n) . length)
11:                     (' ':) . show
12: 
13: monadise str = do State (const () &&& (1+))
14:                   n <- get
15:                   return (\g -> g n ++ str ++ "\n")
16: 
17: combine s1 s2 = do f <- s1
18:                    g <- s2
19:                    return (\h -> f h ++ g h)

無論是程式複雜度和執行速度都比兩年前寫的 Ruby script 還要慢。當然編譯過後會比 Ruby 快啦，可是拿 compiled program 和 interpreted program 比速度完全是作弊。

--
改用 StateT monad transformer 寫看看好了…

---

用 StateT 沒有比較好寫的樣子，所以只稍微把上面的版本改寫一下，好像比較順眼：

 1: import Control.Monad.State
 2: 
 3: main =
 4:   do xs <- getContents
 5:      let (ys, n) = runState (monadise n (lines xs)) 0
 6:      foldr ((>>) . putStrLn) (return ()) ys
 7: 
 8: monadise n = foldr (combine . makeLine (width n)) (return [])
 9: 
10: width = (1+) . floor . logBase 10 . fromInteger
11: 
12: makeLine w s =
13:   do modify (1+)
14:      n <- get
15:      let lineNoStr = until ((>= w) . length) (' ' :) (show n)
16:      return (lineNoStr ++ ": " ++ s)
17: 
18: combine s1 s2 = do x  <- s1
19:                    xs <- s2
20:                    return (x : xs)

--
我果然還不太會寫 Haskell…

---

果然是 imperative programs 寫太久了，看到這問題就想用 state。其實用個 zipWith 把每一行和 [1..] 的對應元素拉在一起，再做點轉換就好了。

 1: main =
 2:   do xs <- getContents
 3:      let xss = lines xs
 4:      let toPrefix = (++ ": ") . padding (width (length xss)) ' ' . show
 5:      let ys = zipWith ((++) . toPrefix) [1..] xss
 6:      foldr ((>>) . putStrLn) (return ()) ys
 7: 
 8: width = (1+) . floor . logBase 10 . fromIntegral
 9: 
10: padding w c = until ((>= w) . length) (c :)

--
有更好一點 XD。