1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835
|
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, StandaloneDeriving, ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Read
-- Copyright : (c) The University of Glasgow, 1994-2002
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- The 'Read' class and instances for basic data types.
--
-----------------------------------------------------------------------------
module GHC.Read
( Read(..) -- class
-- ReadS type
, ReadS
-- H2010 compatibility
, lex
, lexLitChar
, readLitChar
, lexDigits
-- defining readers
, lexP, expectP
, paren
, parens
, list
, choose
, readListDefault, readListPrecDefault
, readNumber
, readField
, readFieldHash
, readSymField
-- Temporary
, readParen
)
where
#include "MachDeps.h"
import qualified Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadP
( ReadS
, readP_to_S
)
import qualified Text.Read.Lex as L
-- Lex exports 'lex', which is also defined here,
-- hence the qualified import.
-- We can't import *anything* unqualified, because that
-- confuses Haddock.
import Text.ParserCombinators.ReadPrec
import Data.Maybe
import GHC.Unicode
import GHC.Num
import GHC.Real
import GHC.Float
import GHC.Show
import GHC.Base
import GHC.Arr
import GHC.Word
import GHC.List (filter)
import GHC.Tuple (Solo (..))
-- | @'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 2010 function
readParen b g = if b then mandatory else optional
where optional r = g r ++ mandatory r
mandatory r = do
("(",s) <- lex r
(x,t) <- optional s
(")",u) <- lex t
return (x,u)
-- | Parsing of 'String's, producing values.
--
-- 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' in Haskell 2010 is equivalent to
--
-- > instance (Read a) => Read (Tree a) where
-- >
-- > readsPrec d r = readParen (d > app_prec)
-- > (\r -> [(Leaf m,t) |
-- > ("Leaf",s) <- lex r,
-- > (m,t) <- readsPrec (app_prec+1) s]) 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
-- >
-- > where app_prec = 10
-- > up_prec = 5
--
-- Note that right-associativity of @:^:@ is unused.
--
-- The derived instance in GHC is equivalent to
--
-- > instance (Read a) => Read (Tree a) where
-- >
-- > readPrec = parens $ (prec app_prec $ do
-- > Ident "Leaf" <- lexP
-- > m <- step readPrec
-- > return (Leaf m))
-- >
-- > +++ (prec up_prec $ do
-- > u <- step readPrec
-- > Symbol ":^:" <- lexP
-- > v <- step readPrec
-- > return (u :^: v))
-- >
-- > where app_prec = 10
-- > up_prec = 5
-- >
-- > readListPrec = readListPrecDefault
--
-- Why do both 'readsPrec' and 'readPrec' exist, and why does GHC opt to
-- implement 'readPrec' in derived 'Read' instances instead of 'readsPrec'?
-- The reason is that 'readsPrec' is based on the 'ReadS' type, and although
-- 'ReadS' is mentioned in the Haskell 2010 Report, it is not a very efficient
-- parser data structure.
--
-- 'readPrec', on the other hand, is based on a much more efficient 'ReadPrec'
-- datatype (a.k.a \"new-style parsers\"), but its definition relies on the use
-- of the @RankNTypes@ language extension. Therefore, 'readPrec' (and its
-- cousin, 'readListPrec') are marked as GHC-only. Nevertheless, it is
-- recommended to use 'readPrec' instead of 'readsPrec' whenever possible
-- for the efficiency improvements it brings.
--
-- As mentioned above, derived 'Read' instances in GHC will implement
-- 'readPrec' instead of 'readsPrec'. The default implementations of
-- 'readsPrec' (and its cousin, 'readList') will simply use 'readPrec' under
-- the hood. If you are writing a 'Read' instance by hand, it is recommended
-- to write it like so:
--
-- @
-- instance 'Read' T where
-- 'readPrec' = ...
-- 'readListPrec' = 'readListPrecDefault'
-- @
class Read a where
{-# MINIMAL readsPrec | readPrec #-}
-- | 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).
-- The default definition uses 'readList'. Instances that define 'readPrec'
-- should also define 'readListPrec' as 'readListPrecDefault'.
readListPrec :: ReadPrec [a]
-- default definitions
readsPrec = readPrec_to_S readPrec
readList = readPrec_to_S (list readPrec) 0
readPrec = readS_to_Prec readsPrec
readListPrec = readS_to_Prec (\_ -> readList)
readListDefault :: Read a => ReadS [a]
-- ^ A possible replacement definition for the 'readList' method (GHC only).
-- This is only needed for GHC, and even then only for 'Read' instances
-- where 'readListPrec' isn't defined as 'readListPrecDefault'.
readListDefault = readPrec_to_S readListPrec 0
readListPrecDefault :: Read a => ReadPrec [a]
-- ^ A possible replacement definition for the 'readListPrec' method,
-- defined using 'readPrec' (GHC only).
readListPrecDefault = list readPrec
------------------------------------------------------------------------
-- H2010 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 H2010
lex s = readP_to_S L.hsLex s
-- | Read a string representation of a character, using Haskell
-- source-language escape conventions. For example:
--
-- > lexLitChar "\\nHello" = [("\\n", "Hello")]
--
lexLitChar :: ReadS String -- As defined by H2010
lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ;
let s' = removeNulls s in
return s' })
where
-- remove nulls from end of the character if they exist
removeNulls [] = []
removeNulls ('\\':'&':xs) = removeNulls xs
removeNulls (first:rest) = first : removeNulls rest
-- There was a skipSpaces before the P.gather L.lexChar,
-- but that seems inconsistent with readLitChar
-- | Read a string representation of a character, using Haskell
-- source-language escape conventions, and convert it to the character
-- that it encodes. For example:
--
-- > readLitChar "\\nHello" = [('\n', "Hello")]
--
readLitChar :: ReadS Char -- As defined by H2010
readLitChar = readP_to_S L.lexChar
-- | Reads a non-empty string of decimal digits.
lexDigits :: ReadS String
lexDigits = readP_to_S (P.munch1 isDigit)
------------------------------------------------------------------------
-- utility parsers
lexP :: ReadPrec L.Lexeme
-- ^ Parse a single lexeme
lexP = lift L.lex
expectP :: L.Lexeme -> ReadPrec ()
expectP lexeme = lift (L.expect lexeme)
expectCharP :: Char -> ReadPrec a -> ReadPrec a
expectCharP c a = do
q <- get
if q == c
then a
else pfail
{-# INLINE expectCharP #-}
skipSpacesThenP :: ReadPrec a -> ReadPrec a
skipSpacesThenP m =
do s <- look
skip s
where
skip (c:s) | isSpace c = get *> skip s
skip _ = m
paren :: ReadPrec a -> ReadPrec a
-- ^ @(paren p)@ parses \"(P0)\"
-- where @p@ parses \"P0\" in precedence context zero
paren p = skipSpacesThenP (paren' p)
paren' :: ReadPrec a -> ReadPrec a
paren' p = expectCharP '(' $ reset p >>= \x ->
skipSpacesThenP (expectCharP ')' (pure x))
parens :: ReadPrec a -> ReadPrec a
-- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc,
-- where @p@ parses \"P\" in the current precedence context
-- and parses \"P0\" in precedence context zero
parens p = optional
where
optional = skipSpacesThenP (p +++ mandatory)
mandatory = paren' optional
list :: ReadPrec a -> ReadPrec [a]
-- ^ @(list p)@ parses a list of things parsed by @p@,
-- using the usual square-bracket syntax.
list readx =
parens
( do expectP (L.Punc "[")
(listRest False +++ listNext)
)
where
listRest started =
do L.Punc c <- lexP
case c of
"]" -> return []
"," | started -> listNext
_ -> pfail
listNext =
do x <- reset readx
xs <- listRest True
return (x:xs)
choose :: [(String, ReadPrec a)] -> ReadPrec a
-- ^ Parse the specified lexeme and continue as specified.
-- Esp useful for nullary constructors; e.g.
-- @choose [(\"A\", return A), (\"B\", return B)]@
-- We match both Ident and Symbol because the constructor
-- might be an operator eg @(:~:)@
choose sps = foldr ((+++) . try_one) pfail sps
where
try_one (s,p) = do { token <- lexP ;
case token of
L.Ident s' | s==s' -> p
L.Symbol s' | s==s' -> p
_other -> pfail }
-- See Note [Why readField]
-- | 'Read' parser for a record field, of the form @fieldName=value@. The
-- @fieldName@ must be an alphanumeric identifier; for symbols (operator-style)
-- field names, e.g. @(#)@, use 'readSymField'). The second argument is a
-- parser for the field value.
readField :: String -> ReadPrec a -> ReadPrec a
readField fieldName readVal = do
expectP (L.Ident fieldName)
expectP (L.Punc "=")
readVal
{-# NOINLINE readField #-}
-- See Note [Why readField]
-- | 'Read' parser for a record field, of the form @fieldName#=value@. That is,
-- an alphanumeric identifier @fieldName@ followed by the symbol @#@. The
-- second argument is a parser for the field value.
--
-- Note that 'readField' does not suffice for this purpose due to
-- <https://gitlab.haskell.org/ghc/ghc/issues/5041 #5041>.
readFieldHash :: String -> ReadPrec a -> ReadPrec a
readFieldHash fieldName readVal = do
expectP (L.Ident fieldName)
expectP (L.Symbol "#")
expectP (L.Punc "=")
readVal
{-# NOINLINE readFieldHash #-}
-- See Note [Why readField]
-- | 'Read' parser for a symbol record field, of the form @(###)=value@ (where
-- @###@ is the field name). The field name must be a symbol (operator-style),
-- e.g. @(#)@. For regular (alphanumeric) field names, use 'readField'. The
-- second argument is a parser for the field value.
readSymField :: String -> ReadPrec a -> ReadPrec a
readSymField fieldName readVal = do
expectP (L.Punc "(")
expectP (L.Symbol fieldName)
expectP (L.Punc ")")
expectP (L.Punc "=")
readVal
{-# NOINLINE readSymField #-}
-- Note [Why readField]
-- ~~~~~~~~~~~~~~~~~~~~
-- Previously, the code for automatically deriving Read instance (in
-- typecheck/GHC.Tc.Deriv.Generate.hs) would generate inline code for parsing fields;
-- this, however, turned out to produce massive amounts of intermediate code,
-- and produced a considerable performance hit in the code generator.
-- Since Read instances are not generally supposed to be performance critical,
-- the readField and readSymField functions have been factored out, and the
-- code generator now just generates calls rather than manually inlining the
-- parsers. For large record types (e.g. 500 fields), this produces a
-- significant performance boost.
--
-- See also #14364.
--------------------------------------------------------------
-- Simple instances of Read
--------------------------------------------------------------
-- | @since 2.01
deriving instance Read GeneralCategory
-- | @since 2.01
instance Read Char where
readPrec =
parens
( do L.Char c <- lexP
return c
)
readListPrec =
parens
( do L.String s <- lexP -- Looks for "foo"
return s
+++
readListPrecDefault -- Looks for ['f','o','o']
) -- (more generous than H2010 spec)
readList = readListDefault
-- | @since 2.01
instance Read Bool where
readPrec =
parens
( do L.Ident s <- lexP
case s of
"True" -> return True
"False" -> return False
_ -> pfail
)
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance Read Ordering where
readPrec =
parens
( do L.Ident s <- lexP
case s of
"LT" -> return LT
"EQ" -> return EQ
"GT" -> return GT
_ -> pfail
)
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 4.11.0.0
deriving instance Read a => Read (NonEmpty a)
--------------------------------------------------------------
-- Structure instances of Read: Maybe, List etc
--------------------------------------------------------------
{-
For structured instances of Read we start using the precedences. The
idea is then that 'parens (prec k p)' will fail immediately when trying
to parse it in a context with a higher precedence level than k. But if
there is one parenthesis parsed, then the required precedence level
drops to 0 again, and parsing inside p may succeed.
'appPrec' is just the precedence level of function application. So,
if we are parsing function application, we'd better require the
precedence level to be at least 'appPrec'. Otherwise, we have to put
parentheses around it.
'step' is used to increase the precedence levels inside a
parser, and can be used to express left- or right- associativity. For
example, % is defined to be left associative, so we only increase
precedence on the right hand side.
Note how step is used in for example the Maybe parser to increase the
precedence beyond appPrec, so that basically only literals and
parenthesis-like objects such as (...) and [...] can be an argument to
'Just'.
-}
-- | @since 2.01
instance Read a => Read (Maybe a) where
readPrec =
parens
(do expectP (L.Ident "Nothing")
return Nothing
+++
prec appPrec (
do expectP (L.Ident "Just")
x <- step readPrec
return (Just x))
)
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance Read a => Read [a] where
{-# SPECIALISE instance Read [String] #-}
{-# SPECIALISE instance Read [Char] #-}
{-# SPECIALISE instance Read [Int] #-}
readPrec = readListPrec
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Ix a, Read a, Read b) => Read (Array a b) where
readPrec = parens $ prec appPrec $
do expectP (L.Ident "array")
theBounds <- step readPrec
vals <- step readPrec
return (array theBounds vals)
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance Read L.Lexeme where
readPrec = lexP
readListPrec = readListPrecDefault
readList = readListDefault
--------------------------------------------------------------
-- Numeric instances of Read
--------------------------------------------------------------
readNumber :: Num a => (L.Lexeme -> ReadPrec a) -> ReadPrec a
-- Read a signed number
readNumber convert =
parens
( do x <- lexP
case x of
L.Symbol "-" -> do y <- lexP
n <- convert y
return (negate n)
_ -> convert x
)
convertInt :: Num a => L.Lexeme -> ReadPrec a
convertInt (L.Number n)
| Just i <- L.numberToInteger n = return (fromInteger i)
convertInt _ = pfail
convertFrac :: forall a . RealFloat a => L.Lexeme -> ReadPrec a
convertFrac (L.Ident "NaN") = return (0 / 0)
convertFrac (L.Ident "Infinity") = return (1 / 0)
convertFrac (L.Number n) = let resRange = floatRange (undefined :: a)
in case L.numberToRangedRational resRange n of
Nothing -> return (1 / 0)
Just rat -> return $ fromRational rat
convertFrac _ = pfail
-- | @since 2.01
instance Read Int where
readPrec = readNumber convertInt
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 4.5.0.0
instance Read Word where
readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
-- | @since 2.01
instance Read Word8 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
-- | @since 2.01
instance Read Word16 where
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
-- | @since 2.01
instance Read Word32 where
#if WORD_SIZE_IN_BITS < 33
readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
#else
readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
#endif
-- | @since 2.01
instance Read Word64 where
readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
-- | @since 2.01
instance Read Integer where
readPrec = readNumber convertInt
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 4.8.0.0
instance Read Natural where
readsPrec d = map (\(n, s) -> (fromInteger n, s))
. filter ((>= 0) . (\(x,_)->x)) . readsPrec d
-- | @since 2.01
instance Read Float where
readPrec = readNumber convertFrac
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance Read Double where
readPrec = readNumber convertFrac
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Integral a, Read a) => Read (Ratio a) where
readPrec =
parens
( prec ratioPrec
( do x <- step readPrec
expectP (L.Symbol "%")
y <- step readPrec
return (x % y)
)
)
readListPrec = readListPrecDefault
readList = readListDefault
------------------------------------------------------------------------
-- Tuple instances of Read, up to size 15
------------------------------------------------------------------------
-- | Reading a 'Void' value is always a parse error, considering
-- 'Void' as a data type with no constructors.
--
-- @since 4.8.0.0
deriving instance Read Void
-- | @since 2.01
instance Read () where
readPrec =
parens
( paren
( return ()
)
)
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 4.15
deriving instance Read a => Read (Solo a)
-- | @since 2.01
instance (Read a, Read b) => Read (a,b) where
readPrec = wrap_tup read_tup2
readListPrec = readListPrecDefault
readList = readListDefault
wrap_tup :: ReadPrec a -> ReadPrec a
wrap_tup p = parens (paren p)
read_comma :: ReadPrec ()
read_comma = expectP (L.Punc ",")
read_tup2 :: (Read a, Read b) => ReadPrec (a,b)
-- Reads "a , b" no parens!
read_tup2 = do x <- readPrec
read_comma
y <- readPrec
return (x,y)
read_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d)
read_tup4 = do (a,b) <- read_tup2
read_comma
(c,d) <- read_tup2
return (a,b,c,d)
read_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)
=> ReadPrec (a,b,c,d,e,f,g,h)
read_tup8 = do (a,b,c,d) <- read_tup4
read_comma
(e,f,g,h) <- read_tup4
return (a,b,c,d,e,f,g,h)
-- | @since 2.01
instance (Read a, Read b, Read c) => Read (a, b, c) where
readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma
; c <- readPrec
; return (a,b,c) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where
readPrec = wrap_tup read_tup4
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where
readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma
; e <- readPrec
; return (a,b,c,d,e) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f)
=> Read (a, b, c, d, e, f) where
readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma
; (e,f) <- read_tup2
; return (a,b,c,d,e,f) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g)
=> Read (a, b, c, d, e, f, g) where
readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma
; (e,f) <- read_tup2; read_comma
; g <- readPrec
; return (a,b,c,d,e,f,g) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h)
=> Read (a, b, c, d, e, f, g, h) where
readPrec = wrap_tup read_tup8
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i)
=> Read (a, b, c, d, e, f, g, h, i) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; i <- readPrec
; return (a,b,c,d,e,f,g,h,i) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i, Read j)
=> Read (a, b, c, d, e, f, g, h, i, j) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; (i,j) <- read_tup2
; return (a,b,c,d,e,f,g,h,i,j) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i, Read j, Read k)
=> Read (a, b, c, d, e, f, g, h, i, j, k) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; (i,j) <- read_tup2; read_comma
; k <- readPrec
; return (a,b,c,d,e,f,g,h,i,j,k) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i, Read j, Read k, Read l)
=> Read (a, b, c, d, e, f, g, h, i, j, k, l) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; (i,j,k,l) <- read_tup4
; return (a,b,c,d,e,f,g,h,i,j,k,l) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i, Read j, Read k, Read l, Read m)
=> Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; (i,j,k,l) <- read_tup4; read_comma
; m <- readPrec
; return (a,b,c,d,e,f,g,h,i,j,k,l,m) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i, Read j, Read k, Read l, Read m, Read n)
=> Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; (i,j,k,l) <- read_tup4; read_comma
; (m,n) <- read_tup2
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) })
readListPrec = readListPrecDefault
readList = readListDefault
-- | @since 2.01
instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h,
Read i, Read j, Read k, Read l, Read m, Read n, Read o)
=> Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where
readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma
; (i,j,k,l) <- read_tup4; read_comma
; (m,n) <- read_tup2; read_comma
; o <- readPrec
; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) })
readListPrec = readListPrecDefault
readList = readListDefault
|