Local Loop Expression ภาค 2

วันนี้เห็น code การบ้าน haskell ของ Porges
ตรงส่วนของการวน loop รับ entry ของ user
โดย user ต้องเลือก choice ว่าอยากให้โปรแกรมเป็น c(client) หรือ s(server)
โดย code มีหน้าตาแบบนี้

main = withSocketsDo $ do -- enable sockets under windows
        putStrLn "Welcome to One-Way Chat version 1.0"
        ...
        input <- untilM   -- get input of 'c' or 's'
                (\x -> (not $ null x) && toLower (head x) `elem` "cs")
                (putStr "Client or server? " >> getLine)
        ...

ประเด็นที่ผมสนใจ ก็คือ การวนลูป รับค่าจาก user และตรวจสอบว่าเป็นค่าที่ถูกต้องไหม
ตรงนี้เขา define function ที่ชื่อ untilM เข้ามาช่วย
หน้าตาของ untilM

-- monadic `until`
untilM p x = x >>= (\y -> if p y then return y else untilM p x) 

จะเห็นว่า untilM รับ arguments 2 ตัวคือ p(predicate) กับ x
โดยมันจะทำ x ก่อน
ผลลัพท์ที่ได้จะถูก test ด้วย p
ถ้าผ่าน ก็จะ return กลับมา ถ้าไม่ผ่านก็ recursive รับค่าต่อไป

เห็นแล้วก็นึกถึง Local loop expression ที่เคยเขียนถึง
ก็เลยลองจับ untilM มาเขียนใหม่ด้วย fix ได้หน้าตาแบบนี้ออกมา

import Control.Monad.Fix

main = do ...
          ...
          input <- fix (\loop -> 
                         do putStr "Client or server? "
                            l <- getLine 
                            if head(l) `elem` "cs" then return l else loop)
          ...

ดูแล้วก็ยังไม่สวยถูกใจเท่าไรนัก