summaryrefslogtreecommitdiff
path: root/libraries/base/tests/T22816.hs
blob: 0105a18c9d9c0c38a8abf4a8c412a76c3fae5005 (plain)
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
module Main (main) where

import Data.Functor.Classes
import Data.Functor.Compose
import Text.ParserCombinators.ReadP as P
import Text.ParserCombinators.ReadPrec (ReadPrec, lift, minPrec, readPrec_to_S)

readEither' :: ReadPrec a -> String -> Either String a
readEither' rp s =
  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
    [x] -> Right x
    []  -> Left "read1: no parse"
    _   -> Left "read1: ambiguous parse"
 where
  read' =
    do x <- rp
       lift P.skipSpaces
       return x

-- | Like 'read', but tailored to 'Read1'.
read1 :: (Read1 f, Read a) => String -> f a
read1 s = either errorWithoutStackTrace id (readEither' readPrec1 s)

exRead, exRead1 :: Compose Maybe Maybe Int
exRead  = read  "Compose Nothing"
exRead1 = read1 "Compose Nothing"

main :: IO ()
main = do
  putStrLn $ showsPrec  0 exRead  ""
  putStrLn $ showsPrec1 0 exRead1 ""