[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:33 UTC 2010
The following commit has been merged in the master branch:
commit 2ea7a416980086ae760ad50145479ba72da99fe6
Author: John Goerzen <jgoerzen at complete.org>
Date: Mon Nov 29 23:55:59 2004 +0100
Checkpointing switch to Either-based computing
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-113)
diff --git a/ChangeLog b/ChangeLog
index a3732bd..06a8737 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,22 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
#
+2004-11-29 16:55:59 GMT John Goerzen <jgoerzen at complete.org> patch-113
+
+ Summary:
+ Checkpointing switch to Either-based computing
+ Revision:
+ missingh--head--0.5--patch-113
+
+
+ new files:
+ libsrc/MissingH/Either.hs
+
+ modified files:
+ ChangeLog TODO libsrc/MissingH/ConfigParser.hs
+ libsrc/MissingH/ConfigParser/Types.hs
+
+
2004-11-22 22:57:20 GMT John Goerzen <jgoerzen at complete.org> patch-112
Summary:
diff --git a/TODO b/TODO
index 8943eb6..e2888d9 100644
--- a/TODO
+++ b/TODO
@@ -9,4 +9,6 @@ test configparser:
* with various default options
* exception system
+test Either.hs
+
tests for new Parsec stuff
diff --git a/libsrc/MissingH/ConfigParser.hs b/libsrc/MissingH/ConfigParser.hs
index 75e895e..f52fb98 100644
--- a/libsrc/MissingH/ConfigParser.hs
+++ b/libsrc/MissingH/ConfigParser.hs
@@ -34,6 +34,7 @@ module MissingH.ConfigParser
(
-- * Types
SectionSpec, OptionSpec, ConfigParser(..),
+ CPError, CPResult,
-- * Initialization
-- $initialization
empty,
@@ -59,12 +60,14 @@ module MissingH.ConfigParser
import MissingH.ConfigParser.Types
import MissingH.ConfigParser.Parser
import MissingH.FiniteMap
+import MissingH.Either
import MissingH.Str
import Data.FiniteMap
import Data.List
import System.IO(Handle)
import Data.Char
+
{- | Combines two 'ConfigParser's into one.
Any duplicate options are resolved to contain the value specified in
@@ -144,18 +147,22 @@ has_section cp x = elemFM x (content cp)
{- | Adds the specified section name. Raises an exception if the
section was already present. Otherwise, returns the new
'ConfigParser' object.-}
-add_section :: ConfigParser -> SectionSpec -> ConfigParser
+add_section :: ConfigParser -> SectionSpec -> CPResult ConfigParser
add_section cp s =
if has_section cp s
- then error ("add_section: section " ++ s ++ " already exists")
- else cp {content = addToFM (content cp) s emptyFM}
+ then throwError $ SectionAlreadyExists ("add_section: section " ++ s ++ " already exists")
+ else return $ cp {content = addToFM (content cp) s emptyFM}
{- | Returns a list of the names of all the options present in the
given section.
-Could raise an exception if the given section does not exist. -}
-options :: ConfigParser -> SectionSpec -> [OptionSpec]
-options cp x = keysFM (forceLookupFM "ConfigParser.options" (content cp) x)
+Returns an error if the given section does not exist.
+-}
+options :: ConfigParser -> SectionSpec -> CPResult [OptionSpec]
+options cp x = maybeToEither (NoSection x) $
+ do
+ o <- lookupFM (content cp) x
+ keysFM o (content cp) x
{- | Indicates whether the given option is present. Returns True
only if the given section is present AND the given option is present
@@ -165,61 +172,68 @@ exception could be raised.
has_option :: ConfigParser -> SectionSpec -> OptionSpec -> Bool
has_option cp s o =
let c = content cp in
- has_section cp s &&
- elemFM (optionxform cp $ o)
- (forceLookupFM "ConfigParser.has_option" c s)
+ v = do secthash <- lookupFM c s
+ return $ elemFM (optionxform cp $ o) secthash
+ case v of
+ Nothing -> False
+ Just x -> x
-{- | Retrieves a string from the configuration file. Raises an exception if
-no such option could be found. -}
-get :: ConfigParser -> SectionSpec -> OptionSpec -> String
-get cp s o =
- case (accessfunc cp) cp s o of
- Nothing -> error $ "get: no option " ++ s ++ "/" ++ o
- Just x -> x
+{- | Retrieves a string from the configuration file.
+
+Returns an error if no such section/option could be found.
+-}
+get :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
+get cp = (accessfunc cp) cp
{- | Retrieves a string from the configuration file and attempts to parse it
as a number. Raises an exception if no such option could be found or if it
could not be parsed as the destination number. -}
-getnum :: (Read a, Num a) => ConfigParser -> SectionSpec -> OptionSpec -> a
-getnum cp s o = read $ get cp s o
+getnum :: (Read a, Num a) => ConfigParser -> SectionSpec -> OptionSpec -> CPResult a
+getnum cp s o = get cp s o >>= return . read
{- | Retrieves a string from the configuration file and attempts to parse
-it as a boolean. Raises an exception if no such option could be found or
+it as a boolean.
+
+Returns an error if no such option could be found or
if it could not be parsed as a boolean. -}
-getbool :: ConfigParser -> SectionSpec -> OptionSpec -> Bool
+getbool :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult Bool
getbool cp s o =
- case map toLower . strip . get cp s $ o of
- "1" -> True
- "yes" -> True
- "on" -> True
- "enabled" -> True
- "0" -> False
- "no" -> False
- "off" -> False
- "disabled" -> False
- _ -> error ("getbool: couldn't parse " ++ get cp s o ++ " from " ++
- s ++ "/" ++ o)
+ do val <- get cp s o
+ case map toLower . strip $ val of
+ "1" -> return True
+ "yes" -> return True
+ "on" -> return True
+ "enabled" -> return True
+ "0" -> return False
+ "no" -> return False
+ "off" -> return False
+ "disabled" -> return False
+ _ -> throwError (ParseError "getbool: couldn't parse " ++
+ val ++ " from " ++ s ++ "/" ++ o)
{- | Returns a list of @(optionname, value)@ pairs representing the content
-of the given section. Raises an error if the section is invalid. -}
-items :: ConfigParser -> SectionSpec -> [(OptionSpec, String)]
-items cp s = fmToList (forceLookupFM "ConfigParser.items" (content cp) s)
+of the given section. Returns an error the section is invalid. -}
+items :: ConfigParser -> SectionSpec -> CPResult [(OptionSpec, String)]
+items cp s = do fm <- maybeToEither (NoSection s) $ lookupFM (content cp) s
+ return $ fmToList fm
{- | Sets the option to a new value, replacing an existing one if it exists.
-Raises an error if the section does not exist. -}
-set :: ConfigParser -> SectionSpec -> OptionSpec -> String -> ConfigParser
+
+Returns an error if the section does not exist. -}
+set :: ConfigParser -> SectionSpec -> OptionSpec -> String -> CPResult ConfigParser
set cp s passedo val =
- cp { content = newmap}
- where newmap = addToFM (content cp) s newsect
- newsect = addToFM sectmap o val
- sectmap = forceLookupFM "ConfigParser.set" (content cp) s
- o = (optionxform cp) passedo
+ do sectmap <- maybeToEither (NoSection s) $ lookupFM (content cp) s
+ let o = (optionxform cp) passedo
+ let newsect = addToFM sectmap o val
+ let newmap = addToFM (content cp) s newsect
+ return $ cp { content = newmap}
{- | Sets the option to a new value, replacing an existing one if it exists.
It requires only a showable value as its parameter.
-This can be used with bool values, as well as numeric ones. Raises
-an error if the section does not exist. -}
-setshow :: Show a => ConfigParser -> SectionSpec -> OptionSpec -> a -> ConfigParser
+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 cp s o val = set cp s o (show val)
{- | Converts the 'ConfigParser' to a string representation that could be
diff --git a/libsrc/MissingH/ConfigParser/Types.hs b/libsrc/MissingH/ConfigParser/Types.hs
index 989b47d..947b3ab 100644
--- a/libsrc/MissingH/ConfigParser/Types.hs
+++ b/libsrc/MissingH/ConfigParser/Types.hs
@@ -34,13 +34,16 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
module MissingH.ConfigParser.Types (
CPOptions, CPData,
+ CPError, CPResult,
ConfigParser(..), empty,
fromAL, SectionSpec,
OptionSpec,
) where
import Data.FiniteMap
import Data.Char
+import Control.Monad.Error
import MissingH.ConfigParser.Parser
+import MissingH.Either
{- | Names of sections -}
type SectionSpec = String
@@ -54,6 +57,18 @@ type CPOptions = FiniteMap OptionSpec String
{- | The main data storage type (storage of sections). -}
type CPData = FiniteMap SectionSpec CPOptions
+{- | Possible ConfigParser errors. -}
+data CPError = ParseError String -- ^ Parse error
+ | SectionAlreadyExists String -- ^ Attempt to create an already-existing ection
+ | NoSection SectionSpec -- ^ The section does not exist
+ | NoOption OptionSpec -- ^ The option does not exist
+ deriving (Eq, Ord, Show)
+
+{- | Basic ConfigParser error handling. The Left value indicates
+an error, while a Right value indicates success. -}
+type CPResult = Either CPError
+
+
{- | This is the main record that is used by 'MissingH.ConfigParser'.
-}
data ConfigParser = ConfigParser
@@ -64,13 +79,13 @@ 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 -> Maybe String),
+ defaulthandler :: (ConfigParser -> SectionSpec -> OptionSpec -> CPResult String),
-- | Whether or not to seek out a default action when no match
-- is found.
usedefault :: Bool,
-- | Function that is used to perform lookups, do optional
-- interpolation, etc.
- accessfunc :: (ConfigParser -> SectionSpec -> OptionSpec -> Maybe String)
+ accessfunc :: (ConfigParser -> SectionSpec -> OptionSpec -> CPResult String)
}
{- | The default empty 'MissingH.ConfigParser' object.
@@ -89,11 +104,23 @@ empty = ConfigParser { content = fromAL [("DEFAULT", [])],
accessfunc = defaccessfunc}
-- internal function: default access function
-defaccessfunc :: ConfigParser -> SectionSpec -> OptionSpec -> Maybe String
+defaccessfunc :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
defaccessfunc cp s o = defdefaulthandler cp s (optionxform cp $ o)
-- internal function: default handler
-defdefaulthandler :: ConfigParser -> SectionSpec -> OptionSpec -> Maybe String
+defdefaulthandler :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String
+
+defdefaulthandler cp sect opt =
+ let fm = content cp
+ lookup s o = do sect <- maybeToEither (NoSection s) $ lookupFM fm s
+ maybeToEither (NoOption o) $ lookupFM sect o
+ trydefault e = if (usedefault cp)
+ then lookup "DEFAULT" opt
+ else e
+ in
+ lookup sect opt `catchError` trydefault
+
+{-
defdefaulthandler cp sect opt =
let fm = content cp
lookup s o =
@@ -108,6 +135,8 @@ defdefaulthandler cp sect opt =
Nothing -> if (usedefault cp)
then lookup "DEFAULT" opt
else Nothing
+-}
+
{- | Low-level tool to convert a parsed object into a 'CPData'
representation. Performs no option conversions or special handling
diff --git a/libsrc/MissingH/Path.hs b/libsrc/MissingH/Either.hs
similarity index 54%
copy from libsrc/MissingH/Path.hs
copy to libsrc/MissingH/Either.hs
index 7e7e0aa..19e2700 100644
--- a/libsrc/MissingH/Path.hs
+++ b/libsrc/MissingH/Either.hs
@@ -1,4 +1,4 @@
-{- arch-tag: Path utilities main file
+{- arch-tag: Euither utilities
Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
This program is free software; you can redistribute it and/or modify
@@ -17,7 +17,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
- Module : MissingH.Path
+ Module : MissingH.Either
Copyright : Copyright (C) 2004 John Goerzen
License : GNU GPL, version 2 or above
@@ -26,26 +26,19 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Stability : provisional
Portability: portable
-This module provides various helpful utilities for dealing with path and file
-names.
+Utilities for working with the Either data type
-Written by John Goerzen, jgoerzen\@complete.org
+Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
-}
-
-module MissingH.Path(splitExt
- )
-where
-import Data.List
-import MissingH.List
-
-{- | Splits a pathname into a tuple representing the root of the name and
-the extension. The extension is considered to be all characters from the last
-dot after the last slash to the end. Either returned string may be empty. -}
-splitExt :: String -> (String, String)
-splitExt path =
- let dotindex = alwaysElemRIndex '.' path
- slashindex = alwaysElemRIndex '/' path
- in
- if dotindex <= slashindex
- then (path, "")
- else ((take dotindex path), (drop dotindex path))
+module MissingH.Either
+ (
+ maybeToEither
+) where
+
+{- | 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
+ -> 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
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list