view release on metacpan or  search on metacpan

hugs98-Nov2003/libraries/Hugs/Prelude.hs  view on Meta::CPAN

instance Show ArrayException where
  showsPrec _ (IndexOutOfBounds s) =
    showException "array index out of range" s
  showsPrec _ (UndefinedElement s) =
    showException "undefined array element" s

data AsyncException
  = StackOverflow
  | HeapOverflow
  | ThreadKilled
  deriving (Eq, Ord)

instance Show AsyncException where
  showsPrec _ StackOverflow   = showString "stack overflow"
  showsPrec _ HeapOverflow    = showString "heap overflow"
  showsPrec _ ThreadKilled    = showString "thread killed"

showException :: String -> String -> ShowS
showException tag msg =
  showString tag . (if null msg then id else showString ": " . showString msg)

data ExitCode = ExitSuccess | ExitFailure Int
                deriving (Eq, Ord, Read, Show)

-- data type describing IOErrors / exceptions.
type IOError = IOException

data IOException
  = IOError
      { ioe_handle      :: Maybe Handle   -- the handle used by the action
					  -- flagging the error
      , ioe_type        :: IOErrorType    -- what kind of (std) error
      , ioe_location    :: String         -- location of the error
      , ioe_description :: String         -- error-specific string
      , ioe_filename    :: Maybe FilePath -- the resource involved.
      } 
      deriving (Eq)

data IOErrorType
  = AlreadyExists
  | NoSuchThing
  | ResourceBusy
  | ResourceExhausted
  | EOF
  | IllegalOperation
  | PermissionDenied
  | UserError
     -- GHC compatibility
  | UnsupportedOperation
  | OtherError
     -- DOTNET only
  | DotNetException
    deriving (Eq)

instance Show IOErrorType where
  show x = 
    case x of
      AlreadyExists     -> "already exists"
      NoSuchThing       -> "does not exist"
      ResourceBusy      -> "resource busy"
      ResourceExhausted -> "resource exhausted"
      EOF               -> "end of file"
      IllegalOperation  -> "illegal operation"
      PermissionDenied  -> "permission denied"
      UserError         -> "user error"
      UnsupportedOperation -> "unsupported operation"
      OtherError        -> "failed"
      DotNetException   -> ".NET exception"

instance Show IOException where
  showsPrec p (IOError hdl iot loc s fn) =
    (case fn of
       Nothing -> case hdl of
		      Nothing -> id
		      Just h  -> showsPrec p h . showString ": "
       Just name -> showString name . showString ": ") .
    (case loc of
       "" -> id
       _  -> showString loc . showString ": ") .
    showsPrec p iot .
    (case s of
       "" -> id
       _  -> showString " (" . showString s . showString ")")

-- Monadic I/O: --------------------------------------------------------------

--data IO a             -- builtin datatype of IO actions

type FilePath = String  -- file pathnames are represented by strings

primitive primbindIO		 :: IO a -> (a -> IO b) -> IO b
primitive primretIO		 :: a -> IO a
primitive putChar		 :: Char -> IO ()
primitive putStr		 :: String -> IO ()
primitive getChar   		 :: IO Char

ioError :: IOError -> IO a
ioError e = IO (\ s -> throw (IOException e))

userError :: String -> IOError
userError str = IOError Nothing UserError "" str Nothing

catch :: IO a -> (IOError -> IO a) -> IO a
catch m h = catchException m $ \e -> case e of
		IOException err -> h err
		_ -> throw e

print     :: Show a => a -> IO ()
print      = putStrLn . show

putStrLn  :: String -> IO ()
putStrLn s = do putStr s
		putChar '\n'

getLine :: IO String
getLine  = do 
  c <- getChar
  if c=='\n' 
   then return ""
   else do