[Haskell-beginners] Maybe, Either

Michael Mossey mpm at alumni.caltech.edu
Tue Sep 15 09:45:14 EDT 2009


As a beginner, I'm not directly following the usefulness of these
alternative implementations. I thought I would give some example code.
Here I am trying to handle errors with Either String.

You can read it here or in hpaste.org:
<http://hpaste.org/fastcgi/hpaste.fcgi/view?id=9393#a9393>

import Data.Ratio
import qualified Data.Map as Map

-- An elemental music object such as note, rest, dynamic mark, etc.
data MusicObject = MusicObject ...

-- A composition has several "streams". A stream could be a continuous
-- melody that appears on a single staff, or other types of data that
-- are arranged serially in time.
data Time = Rational
data StreamId = StreamId ...
data MusicStream = (StreadId, Map.Map Time MusicObject)
data Comp = [MusicStream]

-- A cursor is a concept used to "point to" a note or generalized location
-- in the composition so that editing can be done at that point. For now,
-- all we need is to point to the stream and time.
data Cursor = Cursor { getCurId :: StreamId
                     , getCurTime :: Time }

-- Utility to make it easier to annotate an Either monad with a function
-- that catches an error message, prepends a context message, and rethrows.
ce :: String -> Either String a -> Either String a
ce c = (flip catchError) (\s -> throwError (c ++ "\n" ++ s))

-- Utility to replace an item in an assoc list, inside the Either String
-- monad.
replaceAlist :: Eq a => a -> b -> [(a,b)] -> Either String [(a,b)]
replaceAlist _ _ [] = throwError "Item not found in alist."
replaceAlist iid obj (x:xs) = if fst x == iid
                              then return $ (iid,obj) : xs
                              else do rem <- replaceAlist iid obj xs
                                      return $ x : rem

...

-- Delete a note from a composition. Deleting the last note in a stream is
-- an error condition.
--
-- Conditions that will cause an error:
--   - cursor stream id doesn't exist in the composition
--   - there is no note at the given cursor
--   - there is only one note in the stream (so deleting it would delete
--     the last note)
compDeleteNote :: Cursor -> Comp -> Either String Comp
compDeleteNote cur comp = ce "In compeDeleteNote:" $ do
  let Cursor { getCurId=iid, getCurTime=t } = cur
  -- First internal error might occur if no stream with the cursor's id
  -- occurs in the Comp.
  oldMap <- maybe (Left "no such stream") Right (lookup iid comp)
  -- Second internal error: no music object is found at the cursor's time.
  moAtCur <- maybe (Left "no m.o. at cursor") Right (Map.lookup t oldMap)
  let durAtCur = getDur moAtCur
      (l,r) = Map.split t oldMap
      r' = Map.mapKeys (\k -> k - durAtCur) r
      joined = Map.union l r'
  -- Third error condition: this action deleted the last note.
  if Map.null joined then (Left "deleted last note") else Right ()
  replaceAlist iid joined comp





More information about the Beginners mailing list