From: ross Date: Mon, 26 Jul 2004 13:26:46 +0000 (+0000) Subject: [project @ 2004-07-26 13:26:41 by ross] X-Git-Tag: nhc98-1-18-release~291 X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=06bb288c8d7e2f46276f25c3ef16d091de8f3ded [project @ 2004-07-26 13:26:41 by ross] docs only --- diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 1e213b5..f8174cb 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -79,6 +79,11 @@ import GHC.Arr \begin{code} +-- | @'readParen' 'True' p@ parses what @p@ parses, but surrounded with +-- parentheses. +-- +-- @'readParen' 'False' p@ parses what @p@ parses, but optionally +-- surrounded with parentheses. readParen :: Bool -> ReadS a -> ReadS a -- A Haskell 98 function readParen b g = if b then mandatory else optional @@ -101,11 +106,82 @@ readParen b g = if b then mandatory else optional ------------------------------------------------------------------------ -- class Read +-- | Parsing of 'String's, producing values. +-- +-- Minimal complete definition: 'readsPrec' (or, for GHC only, 'readPrec') +-- +-- Derived instances of 'Read' make the following assumptions, which +-- derived instances of 'Text.Show.Show' obey: +-- +-- * If the constructor is defined to be an infix operator, then the +-- derived 'Read' instance will parse only infix applications of +-- the constructor (not the prefix form). +-- +-- * Associativity is not used to reduce the occurrence of parentheses, +-- although precedence may be. +-- +-- * If the constructor is defined using record syntax, the derived 'Read' +-- will parse only the record-syntax form, and furthermore, the fields +-- must be given in the same order as the original declaration. +-- +-- * The derived 'Read' instance allows arbitrary Haskell whitespace +-- between tokens of the input string. Extra parentheses are also +-- allowed. +-- +-- For example, given the declarations +-- +-- > infixr 5 :^: +-- > data Tree a = Leaf a | Tree a :^: Tree a +-- +-- the derived instance of 'Read' is equivalent to +-- +-- > instance (Read a) => Read (Tree a) where +-- > +-- > readsPrec d r = readParen (d > up_prec) +-- > (\r -> [(u:^:v,w) | +-- > (u,s) <- readsPrec (up_prec+1) r, +-- > (":^:",t) <- lex s, +-- > (v,w) <- readsPrec (up_prec+1) t]) r +-- > +-- > ++ readParen (d > app_prec) +-- > (\r -> [(Leaf m,t) | +-- > ("Leaf",s) <- lex r, +-- > (m,t) <- readsPrec (app_prec+1) s]) r +-- > +-- > where up_prec = 5 +-- > app_prec = 10 +-- +-- Note that right-associativity of @:^:@ is unused. + class Read a where - readsPrec :: Int -> ReadS a + -- | attempts to parse a value from the front of the string, returning + -- a list of (parsed value, remaining string) pairs. If there is no + -- successful parse, the returned list is empty. + -- + -- Derived instances of 'Read' and 'Text.Show.Show' satisfy the following: + -- + -- * @(x,\"\")@ is an element of + -- @('readsPrec' d ('Text.Show.showsPrec' d x \"\"))@. + -- + -- That is, 'readsPrec' parses the string produced by + -- 'Text.Show.showsPrec', and delivers the value that + -- 'Text.Show.showsPrec' started with. + + readsPrec :: Int -- ^ the operator precedence of the enclosing + -- context (a number from @0@ to @11@). + -- Function application has precedence @10@. + -> ReadS a + + -- | The method 'readList' is provided to allow the programmer to + -- give a specialised way of parsing lists of values. + -- For example, this is used by the predefined 'Read' instance of + -- the 'Char' type, where values of type 'String' should be are + -- expected to use double quotes, rather than square brackets. readList :: ReadS [a] + -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only). readPrec :: ReadPrec a + -- | Proposed replacement for 'readList' using new-style parsers (GHC only). readListPrec :: ReadPrec [a] @@ -128,6 +204,7 @@ readListPrecDefault = list readPrec ------------------------------------------------------------------------ -- utility functions +-- | equivalent to 'readsPrec' with a precedence of 0. reads :: Read a => ReadS a reads = readsPrec minPrec @@ -146,12 +223,29 @@ readEither s = lift P.skipSpaces return x +-- | The 'read' function reads input from a string, which must be +-- completely consumed by the input process. read :: Read a => String -> a read s = either error id (readEither s) ------------------------------------------------------------------------ -- H98 compatibility +-- | The 'lex' function reads a single lexeme from the input, discarding +-- initial white space, and returning the characters that constitute the +-- lexeme. If the input string contains only white space, 'lex' returns a +-- single successful \`lexeme\' consisting of the empty string. (Thus +-- @'lex' \"\" = [(\"\",\"\")]@.) If there is no legal lexeme at the +-- beginning of the input string, 'lex' fails (i.e. returns @[]@). +-- +-- This lexer is not completely faithful to the Haskell lexical syntax +-- in the following respects: +-- +-- * Qualified names are not handled properly +-- +-- * Octal and hexadecimal numerics are not recognized as a single token +-- +-- * Comments are not treated properly lex :: ReadS String -- As defined by H98 lex s = readP_to_S L.hsLex s diff --git a/GHC/Show.lhs b/GHC/Show.lhs index 4df4351..297764e 100644 --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -52,11 +52,92 @@ import GHC.List ( (!!), %********************************************************* \begin{code} +-- | The @shows@ functions return a function that prepends the +-- output 'String' to an existing 'String'. This allows constant-time +-- concatenation of results using function composition. type ShowS = String -> String +-- | Conversion of values to readable 'String's. +-- +-- Minimal complete definition: 'showsPrec' or 'show'. +-- +-- Derived instances of 'Show' have the following properties, which +-- are compatible with derived instances of 'Text.Read.Read': +-- +-- * The result of 'show' is a syntactically correct Haskell +-- expression containing only constants, given the fixity +-- declarations in force at the point where the type is declared. +-- It contains only the constructor names defined in the data type, +-- parentheses, and spaces. When labelled constructor fields are +-- used, braces, commas, field names, and equal signs are also used. +-- +-- * If the constructor is defined to be an infix operator, then +-- 'showsPrec' will produce infix applications of the constructor. +-- +-- * the representation will be enclosed in parentheses if the +-- precedence of the top-level constructor in @x@ is less than @d@ +-- (associativity is ignored). Thus, if @d@ is @0@ then the result +-- is never surrounded in parentheses; if @d@ is @11@ it is always +-- surrounded in parentheses, unless it is an atomic expression. +-- +-- * If the constructor is defined using record syntax, then 'show' +-- will produce the record-syntax form, with the fields given in the +-- same order as the original declaration. +-- +-- For example, given the declarations +-- +-- > infixr 5 :^: +-- > data Tree a = Leaf a | Tree a :^: Tree a +-- +-- the derived instance of 'Show' is equivalent to +-- +-- > instance (Show a) => Show (Tree a) where +-- > +-- > showsPrec d (Leaf m) = showParen (d > app_prec) $ +-- > showString "Leaf " . showsPrec (app_prec+1) m +-- > where app_prec = 10 +-- > +-- > showsPrec d (u :^: v) = showParen (d > up_prec) $ +-- > showsPrec (up_prec+1) u . +-- > showString " :^: " . +-- > showsPrec (up_prec+1) v +-- > where up_prec = 5 +-- +-- Note that right-associativity of @:^:@ is ignored. For example, +-- +-- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string +-- @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@. + class Show a where - showsPrec :: Int -> a -> ShowS + -- | Convert a value to a readable 'String'. + -- + -- 'showsPrec' should satisfy the law + -- + -- > showsPrec d x r ++ s == showsPrec d x (r ++ s) + -- + -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following: + -- + -- * @(x,\"\")@ is an element of + -- @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@. + -- + -- That is, 'Text.Read.readsPrec' parses the string produced by + -- 'showsPrec', and delivers the value that 'showsPrec' started with. + + showsPrec :: Int -- ^ the operator precedence of the enclosing + -- context (a number from @0@ to @11@). + -- Function application has precedence @10@. + -> a -- ^ the value to be converted to a 'String' + -> ShowS + + -- | A specialised variant of 'showsPrec', using precedence context + -- zero, and returning an ordinary 'String'. show :: a -> String + + -- | The method 'showList' is provided to allow the programmer to + -- give a specialised way of showing lists of values. + -- For example, this is used by the predefined 'Show' instance of + -- the 'Char' type, where values of type 'String' should be shown + -- in double quotes, rather than between square brackets. showList :: [a] -> ShowS showsPrec _ x s = show x ++ s @@ -181,15 +262,22 @@ instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where %********************************************************* \begin{code} +-- | equivalent to 'showsPrec' with a precedence of 0. shows :: (Show a) => a -> ShowS shows = showsPrec zeroInt +-- | utility function converting a 'Char' to a show function that +-- simply prepends the character unchanged. showChar :: Char -> ShowS showChar = (:) +-- | utility function converting a 'String' to a show function that +-- simply prepends the string unchanged. showString :: String -> ShowS showString = (++) +-- | utility function that surrounds the inner show function with +-- parentheses when the 'Bool' parameter is 'True'. showParen :: Bool -> ShowS -> ShowS showParen b p = if b then showChar '(' . p . showChar ')' else p diff --git a/Prelude.hs b/Prelude.hs index 1be9b4f..9de927d 100644 --- a/Prelude.hs +++ b/Prelude.hs @@ -111,11 +111,15 @@ module Prelude ( lines, words, unlines, unwords, -- * Converting to and from @String@ - ReadS, ShowS, - Read(readsPrec, readList), + -- ** Converting to @String@ + ShowS, Show(showsPrec, showList, show), - reads, shows, read, lex, - showChar, showString, readParen, showParen, + shows, + showChar, showString, showParen, + -- ** Converting from @String@ + ReadS, + Read(readsPrec, readList), + reads, readParen, read, lex, -- * Basic Input and output IO, diff --git a/System/Time.hsc b/System/Time.hsc index 91b677a..ec1c2b8 100644 --- a/System/Time.hsc +++ b/System/Time.hsc @@ -8,19 +8,16 @@ -- Stability : provisional -- Portability : portable -- --- The standard Time library. --- +-- The standard Time library, providing standard functionality for clock +-- times, including timezone information (i.e, the functionality of +-- \"@time.h@\", adapted to the Haskell environment). It follows RFC +-- 1129 in its use of Coordinated Universal Time (UTC). ----------------------------------------------------------------------------- {- Haskell 98 Time of Day Library ------------------------------ -The Time library provides standard functionality for clock times, -including timezone information (i.e, the functionality of "time.h", -adapted to the Haskell environment), It follows RFC 1129 in its use of -Coordinated Universal Time (UTC). - 2000/06/17 : RESTRICTIONS: * min./max. time diff currently is restricted to @@ -69,15 +66,16 @@ TODO: module System.Time ( - Month(..) - , Day(..) + -- * Clock times - , ClockTime(..) -- non-standard, lib. report gives this as abstract + ClockTime(..) -- non-standard, lib. report gives this as abstract -- instance Eq, Ord -- instance Show (non-standard) , getClockTime + -- * Time differences + , TimeDiff(..) , noTimeDiff -- non-standard (but useful when constructing TimeDiff vals.) , diffClockTimes @@ -87,7 +85,11 @@ module System.Time , timeDiffToString -- non-standard , formatTimeDiff -- non-standard + -- * Calendar times + , CalendarTime(..) + , Month(..) + , Day(..) , toCalendarTime , toUTCTime , toClockTime @@ -125,23 +127,31 @@ import Foreign.C -- One way to partition and give name to chunks of a year and a week: +-- | A month of the year. + data Month = January | February | March | April | May | June | July | August | September | October | November | December deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) +-- | A day of the week. + data Day = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show) --- @ClockTime@ is an abstract type, used for the internal clock time. +-- | A representation of the internal clock time. -- Clock times may be compared, converted to strings, or converted to an --- external calendar time @CalendarTime@. - -data ClockTime = TOD Integer -- Seconds since 00:00:00 on 1 Jan 1970 - Integer -- Picoseconds with the specified second +-- external calendar time 'CalendarTime' for I\/O or other manipulations. + +data ClockTime = TOD Integer Integer + -- ^ Construct a clock time. The arguments are a number + -- of seconds since 00:00:00 (UTC) on 1 January 1970, + -- and an additional number of picoseconds. + -- + -- In Haskell 98, the 'ClockTime' type is abstract. deriving (Eq, Ord) -- When a ClockTime is shown, it is converted to a CalendarTime in the current @@ -153,49 +163,47 @@ instance Show ClockTime where (unsafePerformIO (toCalendarTime t))) {- -@CalendarTime@ is a user-readable and manipulable -representation of the internal $ClockTime$ type. The -numeric fields have the following ranges. +The numeric fields have the following ranges. \begin{verbatim} Value Range Comments ----- ----- -------- year -maxInt .. maxInt [Pre-Gregorian dates are inaccurate] -mon 0 .. 11 [Jan = 0, Dec = 11] day 1 .. 31 hour 0 .. 23 min 0 .. 59 sec 0 .. 61 [Allows for two leap seconds] picosec 0 .. (10^12)-1 [This could be over-precise?] -wday 0 .. 6 [Sunday = 0, Saturday = 6] yday 0 .. 365 [364 in non-Leap years] tz -43200 .. 43200 [Variation from UTC in seconds] \end{verbatim} - -The {\em tzname} field is the name of the time zone. The {\em isdst} -field indicates whether Daylight Savings Time would be in effect. -} +-- | 'CalendarTime' is a user-readable and manipulable +-- representation of the internal 'ClockTime' type. + data CalendarTime = CalendarTime { - ctYear :: Int, - ctMonth :: Month, - ctDay :: Int, - ctHour :: Int, - ctMin :: Int, - ctSec :: Int, - ctPicosec :: Integer, - ctWDay :: Day, - ctYDay :: Int, - ctTZName :: String, - ctTZ :: Int, - ctIsDST :: Bool + ctYear :: Int -- ^ Year (pre-Gregorian dates are inaccurate) + , ctMonth :: Month -- ^ Month of the year + , ctDay :: Int -- ^ Day of the month (1 to 31) + , ctHour :: Int -- ^ Hour of the day (0 to 23) + , ctMin :: Int -- ^ Minutes (0 to 59) + , ctSec :: Int -- ^ Seconds (0 to 61, allowing for up to + -- two leap seconds) + , ctPicosec :: Integer -- ^ Picoseconds + , ctWDay :: Day -- ^ Day of the week + , ctYDay :: Int -- ^ Day of the year + -- (0 to 364, or 365 in leap years) + , ctTZName :: String -- ^ Name of the time zone + , ctTZ :: Int -- ^ Variation from UTC in seconds + , ctIsDST :: Bool -- ^ 'True' if Daylight Savings Time would + -- be in effect, and 'False' otherwise } deriving (Eq,Ord,Read,Show) --- The @TimeDiff@ type records the difference between two clock times in --- a user-readable way. +-- | records the difference between two clock times in a user-readable way. data TimeDiff = TimeDiff { @@ -209,11 +217,13 @@ data TimeDiff } deriving (Eq,Ord,Read,Show) +-- | null time difference. + noTimeDiff :: TimeDiff noTimeDiff = TimeDiff 0 0 0 0 0 0 0 -- ----------------------------------------------------------------------------- --- getClockTime returns the current time in its internal representation. +-- | returns the current time in its internal representation. getClockTime :: IO ClockTime #ifdef __HUGS__ @@ -248,10 +258,9 @@ getClockTime = do #endif -- ----------------------------------------------------------------------------- --- addToClockTime d t adds a time difference d and a --- clock time t to yield a new clock time. The difference d --- may be either positive or negative. diffClockTimes t1 t2 returns --- the difference between two clock times t1 and t2 as a TimeDiff. +-- | @'addToClockTime' d t@ adds a time difference @d@ and a +-- clock time @t@ to yield a new clock time. The difference @d@ +-- may be either positive or negative. addToClockTime :: TimeDiff -> ClockTime -> ClockTime addToClockTime (TimeDiff year mon day hour min sec psec) @@ -277,6 +286,9 @@ addToClockTime (TimeDiff year mon day hour min sec psec) in toClockTime cal{ctMonth=month', ctYear=year'} +-- | @'diffClockTimes' t1 t2@ returns the difference between two clock +-- times @t1@ and @t2@ as a 'TimeDiff'. + diffClockTimes :: ClockTime -> ClockTime -> TimeDiff -- diffClockTimes is meant to be the dual to `addToClockTime'. -- If you want to have the TimeDiff properly splitted, use @@ -290,6 +302,8 @@ diffClockTimes (TOD sa pa) (TOD sb pb) = } +-- | converts a time difference to normal form. + normalizeTimeDiff :: TimeDiff -> TimeDiff -- FIXME: handle psecs properly -- FIXME: ?should be called by formatTimeDiff automagically? @@ -386,12 +400,10 @@ gmtoff x = do #endif /* ! __HUGS__ */ -- ----------------------------------------------------------------------------- --- toCalendarTime t converts t to a local time, modified by --- the current timezone and daylight savings time settings. toUTCTime --- t converts t into UTC time. toClockTime l converts l into the --- corresponding internal ClockTime. The wday, yday, tzname, and isdst fields --- are ignored. - +-- | converts an internal clock time to a local time, modified by the +-- timezone and daylight savings time settings in force at the time +-- of conversion. Because of this dependence on the local environment, +-- 'toCalendarTime' is in the 'IO' monad. toCalendarTime :: ClockTime -> IO CalendarTime #ifdef __HUGS__ @@ -402,6 +414,9 @@ toCalendarTime = clockToCalendarTime_reentrant (throwAwayReturnPointer localtim toCalendarTime = clockToCalendarTime_static localtime False #endif +-- | converts an internal clock time into a 'CalendarTime' in standard +-- UTC format. + toUTCTime :: ClockTime -> CalendarTime #ifdef __HUGS__ toUTCTime = unsafePerformIO . toCalTime True @@ -488,6 +503,10 @@ clockToCalendarTime_aux is_utc p_tm psec = do (if is_utc then False else isdst /= 0)) #endif /* ! __HUGS__ */ +-- | converts a 'CalendarTime' into the corresponding internal +-- 'ClockTime', ignoring the contents of the 'ctWDay', 'ctYDay', +-- 'ctTZName' and 'ctIsDST' fields. + toClockTime :: CalendarTime -> ClockTime #ifdef __HUGS__ toClockTime (CalendarTime yr mon mday hour min sec psec @@ -543,9 +562,15 @@ toClockTime (CalendarTime year mon mday hour min sec psec -- ----------------------------------------------------------------------------- -- Converting time values to strings. +-- | formats calendar times using local conventions. + calendarTimeToString :: CalendarTime -> String calendarTimeToString = formatCalendarTime defaultTimeLocale "%c" +-- | formats calendar times using local conventions and a formatting string. +-- The formatting string is that understood by the ISO C @strftime()@ +-- function. + formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String formatCalendarTime l fmt (CalendarTime year mon day hour min sec _ wday yday tzname _ _) = @@ -624,9 +649,15 @@ to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h' -- Useful extensions for formatting TimeDiffs. +-- | formats time differences using local conventions. + timeDiffToString :: TimeDiff -> String timeDiffToString = formatTimeDiff defaultTimeLocale "%c" +-- | formats time differences using local conventions and a formatting string. +-- The formatting string is that understood by the ISO C @strftime()@ +-- function. + formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String formatTimeDiff l fmt td@(TimeDiff year month day hour min sec _) = doFmt fmt diff --git a/Text/ParserCombinators/ReadP.hs b/Text/ParserCombinators/ReadP.hs index 6b8475f..18f91c4 100644 --- a/Text/ParserCombinators/ReadP.hs +++ b/Text/ParserCombinators/ReadP.hs @@ -66,7 +66,10 @@ infixr 5 +++, <++ -- ReadS -- | A parser for a type @a@, represented as a function that takes a --- 'String' and returns a list of possible parses @(a,'String')@ pairs. +-- 'String' and returns a list of possible parses as @(a,'String')@ pairs. +-- +-- Note that this kind of backtracking parser is very inefficient; +-- reading a large structure may be quite slow (cf 'ReadP'). type ReadS a = String -> [(a,String)] #endif diff --git a/Text/Read.hs b/Text/Read.hs index 5ba1fcb..a7b71b4 100644 --- a/Text/Read.hs +++ b/Text/Read.hs @@ -9,6 +9,8 @@ -- Stability : provisional -- Portability : non-portable (uses Text.ParserCombinators.ReadP) -- +-- Converting strings to values. +-- -- The "Text.Read" library is the canonical library to import for -- 'Read'-class facilities. For GHC only, it offers an extended and much -- improved 'Read' class, which constitutes a proposed alternative to the diff --git a/Text/Show.hs b/Text/Show.hs index 9c2cabd..da7df9b 100644 --- a/Text/Show.hs +++ b/Text/Show.hs @@ -9,7 +9,8 @@ -- Stability : provisional -- Portability : portable -- --- The Show class and associated functions. +-- Converting values to readable strings: +-- the 'Show' class and associated functions. -- ----------------------------------------------------------------------------- @@ -31,6 +32,8 @@ module Text.Show ( import GHC.Show #endif +-- | Show a list (using square brackets and commas), given a function +-- for showing elements. showListWith :: (a -> ShowS) -> [a] -> ShowS showListWith = showList__