Sorted grep in Haskell

Question

This program implements a sorted grep, that is, a specialized version of grep for sorted files. It uses binary search for the lines of a file that begin with a certain string.

You can copy and paste the code in a file and run it as:

$> runhaskell sgrep.hs "string to find" sorted_file

I'm looking for suggestions about style, efficiency, and correctness.

module Main where

import Data.List (isPrefixOf)
import Data.Maybe (isNothing, fromJust)
import System.Environment (getArgs)
import System.IO

-- Chunk of a file
data Chunk = Chunk Handle Integer Integer

-- Is char newline?
isNL :: Char -> Bool
isNL c = c == '\n'

-- Are we at the beginning of file?
isBOF :: Handle -> IO Bool
isBOF = (fmap (== 0)) . hTell

-- Go to beginning of line
goToBOL :: Handle -> IO ()
goToBOL h = do
        bof <- isBOF h
        if bof        
           then return ()
           else do 
                   eof <- hIsEOF h
                   if eof
                      then do 
                              hSeek h RelativeSeek (-2)
                              goToBOL h

                      else do    
                              c <- hGetChar h
                              if isNL c
                                 then return ()
                                 else do
                                         hSeek h RelativeSeek (-2)
                                         goToBOL h

getCurrentLine :: Handle -> IO String
getCurrentLine h = goToBOL h >> hGetLine h

getPrevLine :: Handle -> IO (Maybe String)
getPrevLine h = do
        goToBOL h
        bof <- isBOF h
        if bof
           then return Nothing
           else do
                   hSeek h RelativeSeek (-2)
                   goToBOL h
                   bof <- isBOF h
                   if bof
                      then return Nothing
                      else do
                              hSeek h RelativeSeek (-2)
                              goToBOL h
                              line <- hGetLine h
                              return $ Just line

goTo :: Handle -> Integer -> IO ()
goTo h i = do
        hSeek h AbsoluteSeek i

search :: Chunk -> String -> IO (Maybe String)
search (Chunk h start end) str
        | start >= end = return Nothing
        | otherwise = do
                if mid == (end - 1)
                   then return Nothing
                   else do
                           goTo h mid
                           midLine <- getCurrentLine h
                           prevLine <- getPrevLine h
                           --  putStrLn $ "*** " ++ show start ++ " " ++ show end ++ " " ++ show mid ++ " " ++ midLine ++ ", " ++ show prevLine
                           if str `isPrefixOf` midLine && ((isNothing prevLine) || not (str `isPrefixOf` (fromJust prevLine)))
                              then return $ Just midLine
                              else if str < midLine
                                      then search (Chunk h start mid) str
                                      else search (Chunk h mid end) str
           where mid = (start + end) `div` 2

sgrep :: Handle -> String -> IO ()
sgrep h s = do
        len <- hFileSize h
        match <- search (Chunk h 0 len) s
        --  putStrLn $ show match
        c <- hGetContents h
        putStrLn . unlines $ takeWhile (isPrefixOf s) (lines c)

main :: IO ()
main = do
        args <- getArgs
        let s = head args
        putStrLn s
        let fname = head $ tail args
        withFile fname ReadMode (\h -> sgrep h s)

Answer 1

Use your monads! Your code exhibits the walking-right antipattern. You can avoid it with when and guard. Consider goToBOL. This is how I would write it:

-- Go to beginning of line
goToBOL :: Handle -> IO ()
goToBOL h = do
        bof <- isBOF h
        when (not bof) $ do      
        eof <- hIsEOF h
        if eof then do hSeek h RelativeSeek (-2)
                       goToBOL h
               else do c <- hGetChar h
                       when (not $ isNL c) $ do
                       hSeek h RelativeSeek (-2)
                       goToBOL h

In your other functions, namely getPrevLine and search, you'd better use MaybeT IO x instead of IO (Maybe x) as you can use the monadic combinators better when you do so.

Answer 2

In addition to @FUZxxl's points:

You call sgrep only from the last line of main, and the parameters are the wrong way round. Change to

sgrep :: String -> Handle -> IO ()
sgrep s h = do
            ...

and

        ...
        withFile fname ReadMode (sgrep s)

And I'd pattern match the command line arguments (assuming you don't need the benefits of System.Console.GetOpt):

main :: IO ()
main = do
        (s : fname : _) <- getArgs
        putStrLn s
        withFile fname ReadMode (sgrep s)