[Haskell-cafe] Literate haskell format unclear (implementation and specification inconsistencies)

[Ian Lynagh]

On Sat, Mar 03, 2007 at 12:18:44PM -0500, Isaac Dupree wrote:
> 
> Here are some (String -> Bool) to test lines during parsing.

I haven't looked at your definitions in detail, but I think they might
be easier to follow (and, ultimately, include in the report) if they
were written in a BNF style like the one used in the report.

I also think it would be good to have a Haskell spec (a testsuite would
also be good, but not in the report itself). I've had a quick go at
hacking one up (attached) - entirely untested, but ghci -Wall is happy.
If I'm lucky it might even match my answers earlier in the thread. It
should be easy to alter if we decide to use different answers instead.


Thanks
Ian

-------------- next part --------------

import Data.Char

main :: IO ()
main = do xs <- getContents
          putStr $ unlines $ unlit BirdAllowed $ lines xs

data State = InCode | InBird | BirdAllowed | BirdNotAllowed
data LineType = BeginCode | EndCode | BirdTrack String | Blank | Normal

unlit :: State -> [String] -> [String]
unlit InCode [] = error "File ended in a code block"
unlit _      [] = []
unlit s (x:xs)
 = case (lineType x, s) of
   -- First deal with code blocks
   (BeginCode,    InCode)         -> error "Can't nest code blocks"
   (BeginCode,    _)              -> unlit InCode              xs
   (EndCode,      InCode)         -> unlit BirdAllowed         xs
   (EndCode,      _)              -> error "Closing non-existent code block"
   (_,            InCode)         -> x  : unlit InCode         xs
   -- Now deal with bird tracks
   (BirdTrack _,  BirdNotAllowed) -> error "Bird track next to stuff"
   (BirdTrack x', _)              -> x' : unlit InBird         xs
   (Normal,       InBird)         -> error "Bird track next to stuff"
   (Normal,       _)              ->      unlit BirdNotAllowed xs
   (Blank,        _)              ->      unlit BirdAllowed    xs

lineType :: String -> LineType
lineType x
 | x `starts` "\\begin{code}" = BeginCode
 | x `starts` "\\end{code}" = EndCode
 | otherwise = case x of
                   ('>':x') -> BirdTrack (' ':x')
                   _ | all isSpace x -> Blank
                     | otherwise     -> Normal

starts :: String -> String -> Bool
x `starts` pref = case x `stripPrefix` pref of
                  Just s
                   | all isSpace s -> True
                   | otherwise -> error ("Trailing characters after " ++ pref)
                  Nothing -> False

-- I really need to get around to proposing this for the standard libraries
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
xs `stripPrefix` [] = Just xs
[] `stripPrefix` _ = Nothing
(x:xs) `stripPrefix` (y:ys)
 | x == y = xs `stripPrefix` ys
 | otherwise = Nothing