[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:49:09 UTC 2010
The following commit has been merged in the master branch:
commit 490efcb082e5da489ea71d91e1b918ee0beb2baa
Author: John Goerzen <jgoerzen at complete.org>
Date: Fri Dec 3 03:28:03 2004 +0100
Final, ugly, annoying changes to make ConfigParser work with Hugs
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-143)
diff --git a/ChangeLog b/ChangeLog
index 363abd3..e1baecf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,22 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
#
+2004-12-02 20:28:03 GMT John Goerzen <jgoerzen at complete.org> patch-143
+
+ Summary:
+ Final, ugly, annoying changes to make ConfigParser work with Hugs
+ Revision:
+ missingh--head--0.5--patch-143
+
+
+ modified files:
+ ChangeLog README debian/changelog
+ libsrc/MissingH/ConfigParser.hs
+ libsrc/MissingH/ConfigParser/Parser.hs
+ libsrc/MissingH/ConfigParser/Types.hs
+ libsrc/MissingH/Either.hs
+
+
2004-12-02 18:54:22 GMT John Goerzen <jgoerzen at complete.org> patch-142
Summary:
diff --git a/README b/README
index bacbe59..64b1001 100644
--- a/README
+++ b/README
@@ -21,6 +21,7 @@ Major Features
+ FTP client library
+ E-mail client library
+ MIME types library to determine MIME types from files or URLs
+ + Configuration file parser/generator
* IO utilities make it easier to work with line-based text files
and binary files
@@ -37,6 +38,8 @@ Major Features
* Printf utilities for formatting strings
+ * Hundreds of unit tests to verify proper functionality
+
The following modules are are provided at this time, and more are
likely to follow:
@@ -44,6 +47,12 @@ MissingH.Bits * Obtain individual bytes from a bitfield
MissingH.Cmd * Trap errors during calls to external programs
+MissingH.ConfigParser * Configuration file parser
+ * Interpolation supported
+ * Compatible with Python and OCaml ConfigParsers
+
+MissingH.Either * Utilities for the Either type/Error monad
+
MissingH.FiniteMap * Flip a finite map
MissingH.Hsemail * E-mail parsers
diff --git a/debian/changelog b/debian/changelog
index 06ce333..74e7e9d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,7 +4,7 @@ missingh (0.7.0) unstable; urgency=low
* Rewrote unit tests to use hunit more effectively.
* Other new modules: MissingH.Either.
- -- John Goerzen <jgoerzen at complete.org> Tue, 30 Nov 2004 12:37:14 -0600
+ -- John Goerzen <jgoerzen at complete.org> Thu, 02 Dec 2004 19:37:14 -0600
missingh (0.6.2) unstable; urgency=low
diff --git a/libsrc/MissingH/ConfigParser.hs b/libsrc/MissingH/ConfigParser.hs
index 668a36a..ad1e2b3 100644
--- a/libsrc/MissingH/ConfigParser.hs
+++ b/libsrc/MissingH/ConfigParser.hs
@@ -71,8 +71,9 @@ module MissingH.ConfigParser
-- $usageerroriomonad
-- * Types
+ -- $types
SectionSpec, OptionSpec, ConfigParser(..),
- CPErrorData(..), CPError, CPResult,
+ CPErrorData(..), CPError,
-- * Initialization
-- $initialization
emptyCP,
@@ -151,7 +152,8 @@ fromAL origal =
foldl conv emptyFM origal
{- | Default (non-interpolating) access function -}
-simpleAccess :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
+simpleAccess :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> OptionSpec -> m String
simpleAccess cp s o = defdefaulthandler cp s (optionxform cp $ o)
{- | Interpolating access function. Please see the Interpolation section
@@ -195,11 +197,12 @@ Here is how you might enable interpolation:
The @cp2@ object will now support interpolation with a maximum depth of 10.
-}
-interpolatingAccess :: Int ->
+interpolatingAccess :: MonadError CPError m =>
+ Int ->
ConfigParser -> SectionSpec -> OptionSpec
- -> CPResult String
+ -> m String
interpolatingAccess maxdepth cp s o =
- let lookupfunc :: (String -> CPResult String)
+ let lookupfunc :: MonadError CPError m => String -> m String
lookupfunc = interpolatingAccess (maxdepth - 1) cp s
error2str :: ParseError -> String
error2str = messageString . head . errorMessages
@@ -220,14 +223,16 @@ interpolatingAccess maxdepth cp s o =
Right y -> return y
-- internal function: default handler
-defdefaulthandler :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
+defdefaulthandler :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> OptionSpec -> m String
defdefaulthandler cp sect opt =
let fm = content cp
- lookup :: SectionSpec -> OptionSpec -> CPResult String
+ lookup :: MonadError CPError m =>
+ SectionSpec -> OptionSpec -> m String
lookup s o = do sect <- maybeToEither (NoSection s, "get") $ lookupFM fm s
maybeToEither (NoOption o, "get") $ lookupFM sect o
- trydefault :: CPError -> CPResult String
+ trydefault :: MonadError CPError m => CPError -> m String
trydefault e = if (usedefault cp)
then
lookup "DEFAULT" opt
@@ -306,7 +311,8 @@ better error messages.
Errors would be returned on a syntax error.
-}
-readstring :: ConfigParser -> String -> CPResult ConfigParser
+readstring :: MonadError CPError m =>
+ ConfigParser -> String -> m ConfigParser
readstring cp s = do
n <- parse_string s
return $ readutil cp n
@@ -326,7 +332,8 @@ has_section cp x = elemFM x (content cp)
'SectionAlreadyExists' error if the
section was already present. Otherwise, returns the new
'ConfigParser' object.-}
-add_section :: ConfigParser -> SectionSpec -> CPResult ConfigParser
+add_section :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> m ConfigParser
add_section cp s =
if has_section cp s
then throwError $ (SectionAlreadyExists s, "add_section")
@@ -339,7 +346,8 @@ object.
This call may not be used to remove the @DEFAULT@ section. Attempting to do
so will always cause a 'NoSection' error.
-}
-remove_section :: ConfigParser -> SectionSpec -> CPResult ConfigParser
+remove_section :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> m ConfigParser
remove_section _ "DEFAULT" = throwError $ (NoSection "DEFAULT", "remove_section")
remove_section cp s =
if has_section cp s
@@ -350,7 +358,8 @@ remove_section cp s =
section does not exist and a 'NoOption' error if the option does not
exist. Otherwise, returns the new 'ConfigParser' object.
-}
-remove_option :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult ConfigParser
+remove_option :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> OptionSpec -> m ConfigParser
remove_option cp s passedo =
do sectmap <- maybeToEither (NoSection s, "remove_option") $ lookupFM (content cp) s
let o = (optionxform cp) passedo
@@ -365,7 +374,8 @@ given section.
Returns an error if the given section does not exist.
-}
-options :: ConfigParser -> SectionSpec -> CPResult [OptionSpec]
+options :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> m [OptionSpec]
options cp x = maybeToEither (NoSection x, "options") $
do
o <- lookupFM (content cp) x
@@ -390,14 +400,20 @@ has_option cp s o =
Returns an error if no such section\/option could be found.
-}
-get :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
-get cp = (accessfunc cp) cp
+get :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> OptionSpec -> m String
+-- used to be:
+-- get cp = (accessfunc cp) cp
+-- but I had to change the type of the accessfunc to return an Either,
+-- so we now do this.
+get cp s o = eitherToMonadError $ (accessfunc cp) cp s o
{- | Retrieves a string from the configuration file and attempts to parse it
as a number. Returns an error if no such option could be found.
An exception may be raised if it
could not be parsed as the destination number. -}
-getnum :: (Read a, Num a) => ConfigParser -> SectionSpec -> OptionSpec -> CPResult a
+getnum :: (Read a, Num a, MonadError CPError m) =>
+ ConfigParser -> SectionSpec -> OptionSpec -> m a
getnum cp s o = get cp s o >>= return . read
{- | Retrieves a string from the configuration file and attempts to parse
@@ -433,7 +449,8 @@ The following will produce a False value:
*false
-}
-getbool :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult Bool
+getbool :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> OptionSpec -> m Bool
getbool cp s o =
do val <- get cp s o
case map toLower . strip $ val of
@@ -452,14 +469,16 @@ getbool cp s o =
{- | Returns a list of @(optionname, value)@ pairs representing the content
of the given section. Returns an error the section is invalid. -}
-items :: ConfigParser -> SectionSpec -> CPResult [(OptionSpec, String)]
+items :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> m [(OptionSpec, String)]
items cp s = do fm <- maybeToEither (NoSection s, "items") $ lookupFM (content cp) s
return $ fmToList fm
{- | Sets the option to a new value, replacing an existing one if it exists.
Returns an error if the section does not exist. -}
-set :: ConfigParser -> SectionSpec -> OptionSpec -> String -> CPResult ConfigParser
+set :: MonadError CPError m =>
+ ConfigParser -> SectionSpec -> OptionSpec -> String -> m ConfigParser
set cp s passedo val =
do sectmap <- maybeToEither (NoSection s, "set") $ lookupFM (content cp) s
let o = (optionxform cp) passedo
@@ -472,7 +491,8 @@ It requires only a showable value as its parameter.
This can be used with bool values, as well as numeric ones.
Returns an error if the section does not exist. -}
-setshow :: Show a => ConfigParser -> SectionSpec -> OptionSpec -> a -> CPResult ConfigParser
+setshow :: (Show a, MonadError CPError m) =>
+ ConfigParser -> SectionSpec -> OptionSpec -> a -> m ConfigParser
setshow cp s o val = set cp s o (show val)
{- | Converts the 'ConfigParser' to a string representation that could be
@@ -696,11 +716,10 @@ Let's take a look at some basic use cases.
-}
{- $usagenomonad
-You'll notice that many functions in this module return a 'CPResult' over some
-type. Although its definition is not this simple, you can consider this to
-hold:
-
- at type 'CPResult' a = Either 'CPError' a@
+You'll notice that many functions in this module return a
+ at MonadError 'CPError'@ over some
+type. Although its definition is not this simple, you can consider this to be
+the same as returning @Either CPError a at .
That is, these functions will return @Left error@ if there's a problem
or @Right result@ if things are fine. The documentation for individual
@@ -719,7 +738,8 @@ You can transform errors into exceptions in your code by using
> putStrLn $ forceEither $ get cp "sect1" "opt1"
In short, you can just put @forceEither $@ in front of every call that returns
-a 'CPResult'. This is still a pure functional call, so it can be used outside
+something that is a MonadError.
+This is still a pure functional call, so it can be used outside
of the IO monads. The exception, however, can only be caught in the IO
monad.
@@ -728,7 +748,7 @@ If you don't want to bother with 'forceEither', you can use the error monad. It
{- $usageerrormonad
-The 'CPResult' type is actually defined in terms of the Error monad, which is
+The return type is actually defined in terms of the Error monad, which is
itself based on the Either data type.
Here's a neat example of chaining together calls to build up a 'ConfigParser'
@@ -851,3 +871,21 @@ A common idiom for loading a new object from stratch is:
Note the use of 'emptyCP'; this will essentially cause the file's data
to be merged with the empty 'ConfigParser'.
-}
+
+{- $types
+
+The code used to say this:
+
+>type CPResult a = MonadError CPError m => m a
+>simpleAccess :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
+
+But Hugs did not support that type declaration. Therefore, types are now
+given like this:
+
+>simpleAccess :: MonadError CPError m =>
+> ConfigParser -> SectionSpec -> OptionSpec -> m String
+
+Although it looks more confusing than before, it still means the same.
+The return value can still be treated as @Either CPError String@ if you so
+desire.
+-}
\ No newline at end of file
diff --git a/libsrc/MissingH/ConfigParser/Parser.hs b/libsrc/MissingH/ConfigParser/Parser.hs
index ba9b88d..7684c26 100644
--- a/libsrc/MissingH/ConfigParser/Parser.hs
+++ b/libsrc/MissingH/ConfigParser/Parser.hs
@@ -49,7 +49,8 @@ import MissingH.ConfigParser.Types
-- Exported funcs
----------------------------------------------------------------------
-parse_string :: String -> CPResult ParseOutput
+parse_string :: MonadError CPError m =>
+ String -> m ParseOutput
parse_string s =
detokenize "(string)" $ parse loken "(string)" s
@@ -148,7 +149,7 @@ interpother = do
c <- noneOf "%"
return [c]
-interptok :: (String -> CPResult String) -> Parser String
+interptok :: (String -> Either CPError String) -> Parser String
interptok lookupfunc = (try percentval)
<|> interpother
<|> do s <- interpval
@@ -158,7 +159,7 @@ interptok lookupfunc = (try percentval)
Right x -> return x
-interpmain :: (String -> CPResult String) -> Parser String
+interpmain :: (String -> Either CPError String) -> Parser String
interpmain lookupfunc =
do r <- manyTill (interptok lookupfunc) eof
return $ concat r
diff --git a/libsrc/MissingH/ConfigParser/Types.hs b/libsrc/MissingH/ConfigParser/Types.hs
index d362073..bf7f37f 100644
--- a/libsrc/MissingH/ConfigParser/Types.hs
+++ b/libsrc/MissingH/ConfigParser/Types.hs
@@ -34,7 +34,7 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
module MissingH.ConfigParser.Types (
CPOptions, CPData,
- CPErrorData(..), CPError, CPResult,
+ CPErrorData(..), CPError, {-CPResult,-}
ConfigParser(..),
SectionSpec,
OptionSpec,
@@ -84,9 +84,12 @@ instance Error CPError where
noMsg = (OtherProblem "", "")
strMsg x = (OtherProblem x, "")
-{- | Basic ConfigParser error handling. The Left value indicates
-an error, while a Right value indicates success. -}
-type CPResult a = forall m. MonadError CPError m => m a
+{- Removed due to Hugs incompatibility.
+
+| Basic ConfigParser error handling. The Left value indicates
+an error, while a Right value indicates success.
+type CPResult a = MonadError CPError m => m a
+-}
{- | This is the main record that is used by 'MissingH.ConfigParser'.
-}
@@ -98,7 +101,7 @@ data ConfigParser = ConfigParser
-- | Function to look up an option, considering a default value
-- if 'usedefault' is True; or ignoring a default value otherwise.
-- The option specification is assumed to be already transformed.
- defaulthandler :: (ConfigParser -> SectionSpec -> OptionSpec -> CPResult String),
+ defaulthandler :: ConfigParser -> SectionSpec -> OptionSpec -> Either CPError String,
-- | Whether or not to seek out a default action when no match
-- is found.
usedefault :: Bool,
@@ -106,7 +109,7 @@ data ConfigParser = ConfigParser
-- interpolation, etc. It is assumed that accessfunc
-- will internally call defaulthandler to do the underlying lookup.
-- The option value is not assumed to be transformed.
- accessfunc :: (ConfigParser -> SectionSpec -> OptionSpec -> CPResult String)
+ accessfunc :: (ConfigParser -> SectionSpec -> OptionSpec -> Either CPError String)
}
diff --git a/libsrc/MissingH/Either.hs b/libsrc/MissingH/Either.hs
index ba37f04..4664bcb 100644
--- a/libsrc/MissingH/Either.hs
+++ b/libsrc/MissingH/Either.hs
@@ -33,7 +33,8 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
module MissingH.Either
(
maybeToEither,
- forceEither
+ forceEither,
+ eitherToMonadError
) where
import Control.Monad.Error
@@ -59,3 +60,9 @@ Left, raises an exception with "error". -}
forceEither :: Show e => Either e a -> a
forceEither (Left x) = error (show x)
forceEither (Right x) = x
+
+{- | Takes an either and transforms it into something of the more generic
+MonadError class. -}
+eitherToMonadError :: MonadError e m => Either e a -> m a
+eitherToMonadError (Left x) = throwError x
+eitherToMonadError (Right x) = return x
\ No newline at end of file
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list