A problem about hGetContents -- with another question

[Dean Herington]

I was unhappy with the use of `error` in my first solution, so I wrote a
second solution that's more robust.  It also demonstrates monadic style.  
The new solution is at the bottom.

Dean


On Thu, 23 Jan 2003, Dean Herington wrote:

> On Sun, 19 Jan 2003, Nick Name wrote:
> 
> > I got another trouble: I need to build a record type like
> > 
> > Package { name :: String, version :: Int , mantainer :: String ... other
> > fields ... }
> > 
> > from a list of string of the form
> > 
> > ["Package: ..." , "Mantainer: ..." , "Version: ..." , ... ]
> > 
> > where the fields are not bound to be in a particular order, except for
> > Package wich is always the first of a record.
> > 
> > The natural solution in this case seems to be a mutable record, and an
> > iteration over the list. Has someone got ideas? This appear to be a
> > particularly difficult problem in haskell and it should not be.
> > 
> > V.
> 
> 
> Here's one way to do it:
> 
> 
> module ReadRecord where
> 
> import Maybe (isJust)
> 
> data Package = Package { name       :: Maybe String,
>                          version    :: Maybe Int,
>                          maintainer :: Maybe String }
>   deriving Show
> 
> parsePackage :: [String] -> Package
> parsePackage = foldl (parseItem trials) (Package Nothing Nothing Nothing)
>  where
>   parseItem (f:fs) p s = maybe (parseItem fs p s) id (f p s)
>   parseItem []     _ s = error $ "can't match " ++ show s
> 
>   trials = [
>    try "Package"    (ij.name)       (\ p v -> p{name = Just v}),
>    try "Version"    (ij.version)    (\ p v -> p{version = Just $ read v}),
>    try "Maintainer" (ij.maintainer) (\ p v -> p{maintainer = Just v}) ]
> 
>   try key tester setter pkg str = fmap parse $ match (key ++ ": ") str
>    where parse text = if tester pkg
>                         then error $ "duplicate field: " ++ key
>                         else setter pkg text
> 
>   match want str = if want == pre then Just post else Nothing
>    where (pre, post) = splitAt (length want) str
> 
>   ij = isJust
> 
> 
> main = mapM_ try goods
> try = print . parsePackage
> 
> goods = [
>   [],
>   ["Package: p1", "Version: 1", "Maintainer: m1"],
>   ["Maintainer: m2", "Package: p2"]
>  ]
> 
> bad1 = ["Version: v-b1", "Foo: foo-b1"]
> bad2 = ["Maintainer: me", "Maintainer: me"]
> bad3 = ["Version: foo"]
> 
> 
> -- Dean


module ReadRecord where

import Maybe (isJust)
import Monad
import Control.Monad
import Control.Monad.Error

data Package = Package { name       :: Maybe String,
                         version    :: Maybe Int,
                         maintainer :: Maybe String }
  deriving Show

parsePackage :: [String] -> Either String Package
parsePackage = foldM parseItem (Package Nothing Nothing Nothing)
 where
  parseItem p s = join $ msum [ trial p s | trial <- trials ]

  trials = [
   try "Package"               (isJust . name)
       (\ p t ->                return p{name       = Just t}),
   try "Version"               (isJust . version)
       (\ p t -> do v <- int t; return p{version    = Just v}),
   try "Maintainer"            (isJust . maintainer)
       (\ p t ->                return p{maintainer = Just t}),
   \ _ str -> return $ fail $ "can't match " ++ show str ]

  try fld full set p s = match (fld ++ ": ") s >>= return . parse
   where parse t = if full p then fail $ "duplicate field: " ++ fld
                             else set p t

  match want str = do guard (want == pre); return post
   where (pre, post) = splitAt (length want) str

  int text = case reads text of [(val,"")] -> return val
                                _ -> fail $ "invalid Int: " ++ text


main = mapM_ try trials
try = print . parsePackage

trials = goods ++ bads

goods = [
  [],
  ["Package: p1", "Version: 1", "Maintainer: m1"],
  ["Maintainer: m2", "Package: p2"]]

bads = [bad1, bad2, bad3]

bad1 = ["Package: b1", "Foo: foo-b1"]
bad2 = ["Maintainer: me1", "Maintainer: me2"]
bad3 = ["Version: foo"]