[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:48:36 UTC 2010
The following commit has been merged in the master branch:
commit aba1155cfff42723591f3973b2ff852413c6a358
Author: John Goerzen <jgoerzen at complete.org>
Date: Tue Nov 30 22:05:43 2004 +0100
Checkpointing
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-119)
diff --git a/ChangeLog b/ChangeLog
index 772f160..ed286e0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,24 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
#
+2004-11-30 15:05:43 GMT John Goerzen <jgoerzen at complete.org> patch-119
+
+ Summary:
+ Checkpointing
+ Revision:
+ missingh--head--0.5--patch-119
+
+
+ new files:
+ cpexample1.hs
+
+ modified files:
+ ChangeLog libsrc/MissingH/ConfigParser.hs
+ libsrc/MissingH/ConfigParser/Parser.hs
+ libsrc/MissingH/ConfigParser/Types.hs
+ libsrc/MissingH/Either.hs
+
+
2004-11-30 04:31:06 GMT John Goerzen <jgoerzen at complete.org> patch-118
Summary:
diff --git a/cpexample1.hs b/cpexample1.hs
new file mode 100644
index 0000000..4ca7543
--- /dev/null
+++ b/cpexample1.hs
@@ -0,0 +1,19 @@
+-- arch-tag: ConfigParser example 1 to integrate into docs
+import MissingH.ConfigParser
+import Control.Monad.Error
+
+main = do
+ --let d = readfile empty "/etc/passwd"
+ rv <- runErrorT $
+ do
+ cp <- liftIO $ readfile empty "/etc/passwd"
+ x <- cp
+ liftIO $ putStrLn "In the test"
+ --cp <- d
+ --liftIO $ print (sections cp)
+ nb <- get x "DEFAULT" "nobody"
+ liftIO $ putStrLn nb
+ foo <- get x "DEFAULT" "foo"
+ liftIO $ putStrLn foo
+ return "done"
+ print rv
diff --git a/libsrc/MissingH/ConfigParser.hs b/libsrc/MissingH/ConfigParser.hs
index 94dea21..f4efe49 100644
--- a/libsrc/MissingH/ConfigParser.hs
+++ b/libsrc/MissingH/ConfigParser.hs
@@ -110,12 +110,8 @@ does not convey those options.
May return an error if there is a syntax error. May raise an exception if the file could not be accessed.
-}
-
-retdata :: ConfigParser -> CPResult ParseOutput -> CPResult ConfigParser
-retdata cp x = do d <- x
- return $ readutil cp d
-
-readfile :: ConfigParser -> FilePath ->IO (CPResult ConfigParser)
+--readfile :: ConfigParser -> FilePath ->IO (CPResult ConfigParser)
+readfile :: MonadError CPError m => ConfigParser -> FilePath -> IO (m ConfigParser)
{-
readfile cp fp = do n <- parse_file fp
return $ do y <- n
@@ -124,6 +120,9 @@ readfile cp fp = do n <- parse_file fp
readfile cp fp = do n <- parse_file fp
return $ retdata cp n
+retdata :: ConfigParser -> CPResult ParseOutput -> CPResult ConfigParser
+retdata cp x = do d <- x
+ return $ readutil cp d
{- | Like 'readfile', but uses an already-open handle. You should
use 'readfile' instead of this if possible, since it will be able to
@@ -131,7 +130,8 @@ generate better error messages.
Errors would be returned on a syntax error.
-}
-readhandle :: ConfigParser -> Handle -> IO (CPResult ConfigParser)
+--readhandle :: ConfigParser -> Handle -> IO (CPResult ConfigParser)
+readhandle :: MonadError CPError m => ConfigParser -> Handle -> IO (m ConfigParser)
readhandle cp h = do n <- parse_handle h
return $ n >>= (return . (readutil cp))
@@ -314,4 +314,4 @@ A common idiom for loading a new object from stratch is:
Note the use of 'empty'; this will essentially cause the file's data
to be merged with the empty 'ConfigParser'.
--}
\ No newline at end of file
+-}
diff --git a/libsrc/MissingH/ConfigParser/Parser.hs b/libsrc/MissingH/ConfigParser/Parser.hs
index e5532c0..3760654 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -38,6 +38,7 @@ module MissingH.ConfigParser.Parser
--main
) where
import Text.ParserCombinators.Parsec
+import Control.Monad.Error(throwError, MonadError)
import MissingH.Str
import MissingH.ConfigParser.Lexer
import System.IO(Handle, hGetContents)
@@ -52,12 +53,14 @@ parse_string :: String -> CPResult ParseOutput
parse_string s =
detokenize "(string)" $ parse loken "(string)" s
-parse_file :: FilePath -> IO (CPResult ParseOutput)
+--parse_file :: FilePath -> IO (CPResult ParseOutput)
+parse_file :: MonadError CPError m => FilePath -> IO (m ParseOutput)
parse_file f =
do o <- parseFromFile loken f
return $ detokenize f o
-parse_handle :: Handle -> IO (CPResult ParseOutput)
+--parse_handle :: Handle -> IO (CPResult ParseOutput)
+parse_handle :: MonadError CPError m => Handle -> IO (m ParseOutput)
parse_handle h =
do s <- hGetContents h
let o = parse loken (show h) s
@@ -67,8 +70,8 @@ parse_handle h =
-- Private funcs
----------------------------------------------------------------------
detokenize fp l =
- let conv msg (Left err) = Left $ (ParseError (msg ++ (show err)), msg)
- conv msg (Right val) = Right val
+ let conv msg (Left err) = throwError $ (ParseError (msg ++ (show err)), msg)
+ conv msg (Right val) = return val
in do r <- conv "lexer" l
conv "parser" $ runParser main () fp r
diff --git a/libsrc/MissingH/ConfigParser/Types.hs b/libsrc/MissingH/ConfigParser/Types.hs
index 8f08719..b68595f 100644
--- a/libsrc/MissingH/ConfigParser/Types.hs
+++ b/libsrc/MissingH/ConfigParser/Types.hs
@@ -78,7 +78,7 @@ instance Error CPError where
{- | Basic ConfigParser error handling. The Left value indicates
an error, while a Right value indicates success. -}
-type CPResult = Either CPError
+type CPResult a = MonadError CPError m => m a
{- | This is the main record that is used by 'MissingH.ConfigParser'.
-}
@@ -129,7 +129,7 @@ defdefaulthandler cp sect opt =
trydefault :: CPError -> CPResult String
trydefault e = if (usedefault cp)
then lookup "DEFAULT" opt
- else Left e
+ else throwError e
in
lookup sect opt `catchError` trydefault
diff --git a/libsrc/MissingH/Either.hs b/libsrc/MissingH/Either.hs
index 19e2700..c2014b8 100644
--- a/libsrc/MissingH/Either.hs
+++ b/libsrc/MissingH/Either.hs
@@ -34,11 +34,19 @@ module MissingH.Either
(
maybeToEither
) where
+import Control.Monad.Error
{- | Converts a Maybe value to an Either value, using the supplied parameter
-as the Left value if the Maybe is Nothing. -}
-maybeToEither :: e -- ^ (Left e) will be returned if the Maybe value is Nothing
+as the Left value if the Maybe is Nothing.
+
+This function can be interpreted as:
+
+ at matbeToEither :: e -> Maybe a -> Either e a
+
+-}
+maybeToEither :: MonadError e m =>
+ e -- ^ (Left e) will be returned if the Maybe value is Nothing
-> Maybe a -- ^ (Right a) will be returned if this is (Just a)
- -> Either e a
-maybeToEither errorval Nothing = Left errorval
-maybetoEither _ (Just normalval) = Right normalval
+ -> m a
+maybeToEither errorval Nothing = throwError errorval
+maybeToEither _ (Just normalval) = return normalval
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list