ref: 96f8e2409a5485655f531868d01482e57101e18d
parent: d17977027b1ba039d0b78791d4a1ffe7017d73e1
author: Lennart Augustsson <lennart@augustsson.net>
date: Sat Sep 21 09:40:32 EDT 2024
Re-enable Read stuff.
--- a/lib/Data/Functor/Classes.hs
+++ b/lib/Data/Functor/Classes.hs
@@ -4,18 +4,18 @@
Eq1(..), eq1,
Ord1(..), compare1,
Read1(..), -- readsPrec1, readPrec1,
--- liftReadListDefault, liftReadListPrecDefault,
+ liftReadListDefault, liftReadListPrecDefault,
Show1(..), showsPrec1,
-- ** For binary constructors
Eq2(..), eq2,
Ord2(..), compare2,
Read2(..), -- readsPrec2, readPrec2,
--- liftReadList2Default, liftReadListPrec2Default,
+ liftReadList2Default, liftReadListPrec2Default,
Show2(..), showsPrec2,
-- * Helper functions
--- readsData, readData,
--- readsUnaryWith, readUnaryWith,
--- readsBinaryWith, readBinaryWith,
+ readsData, readData,
+ readsUnaryWith, readUnaryWith,
+ readsBinaryWith, readBinaryWith,
showsUnaryWith,
showsBinaryWith,
) where
@@ -28,13 +28,8 @@
import Data.Complex (Complex((:+)))
import Data.Tuple (Solo (..))
-{-
-import GHC.Read (expectP, list, paren)
-import Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec)
-import Text.Read (Read(..), parens, prec, step)
-import Text.Read.Lex (Lexeme(..))
--}
import Text.Read
+import Text.Read.Internal
import Text.Show (showListWith)
class Eq1 f where
@@ -50,7 +45,6 @@
compare1 = liftCompare compare
class Read1 f where
-{-
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec rp rl = readPrec_to_S $
liftReadPrec (readS_to_Prec rp) (readS_to_Prec (const rl))
@@ -80,7 +74,6 @@
liftReadListPrecDefault :: Read1 f => ReadPrec a -> ReadPrec [a]
-> ReadPrec [f a]
liftReadListPrecDefault rp rl = list (liftReadPrec rp rl)
--}
class Show1 f where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
@@ -106,7 +99,6 @@
compare2 = liftCompare2 compare compare
class Read2 f where
-{-
liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] ->
(Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (f a b)
liftReadsPrec2 rp1 rl1 rp2 rl2 = readPrec_to_S $
@@ -146,7 +138,6 @@
liftReadListPrec2Default :: Read2 f => ReadPrec a -> ReadPrec [a] ->
ReadPrec b -> ReadPrec [b] -> ReadPrec [f a b]
liftReadListPrec2Default rp1 rl1 rp2 rl2 = list (liftReadPrec2 rp1 rl1 rp2 rl2)
--}
class Show2 f where
liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) ->
@@ -172,7 +163,6 @@
liftCompare _ (Just _) Nothing = GT
liftCompare comp (Just x) (Just y) = comp x y
-{-
instance Read1 Maybe where
liftReadPrec rp _ =
parens (expectP (Ident "Nothing") *> pure Nothing)
@@ -181,7 +171,6 @@
liftReadListPrec = liftReadListPrecDefault
liftReadList = liftReadListDefault
--}
instance Show1 Maybe where
liftShowsPrec _ _ _ Nothing = showString "Nothing"
@@ -199,12 +188,10 @@
liftCompare _ (_:_) [] = GT
liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys
-{-
instance Read1 [] where
liftReadPrec _ rl = rl
liftReadListPrec = liftReadListPrecDefault
liftReadList = liftReadListDefault
--}
instance Show1 [] where
liftShowsPrec _ sl _ = sl
@@ -215,7 +202,6 @@
instance Ord1 NonEmpty where
liftCompare cmp (a :| as) (b :| bs) = cmp a b `mappend` liftCompare cmp as bs
-{-
instance Read1 NonEmpty where
liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do
(a, s'') <- rdP 6 s'
@@ -222,7 +208,6 @@
(":|", s''') <- lex s''
(as, s'''') <- rdL s'''
return (a :| as, s'''')) s
--}
instance Show1 NonEmpty where
liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $
@@ -235,7 +220,6 @@
liftCompare2 comp1 comp2 (x1, y1) (x2, y2) =
comp1 x1 x2 `mappend` comp2 y1 y2
-{-
instance Read2 (,) where
liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
x <- rp1
@@ -245,7 +229,6 @@
liftReadListPrec2 = liftReadListPrec2Default
liftReadList2 = liftReadList2Default
--}
instance Show2 (,) where
liftShowsPrec2 sp1 _ sp2 _ _ (x, y) =
@@ -263,9 +246,8 @@
instance (Ord a) => Ord1 ((,) a) where
liftCompare = liftCompare2 compare
-{-
instance Read1 Solo where
- liftReadPrec rp _ = readData (readUnaryWith rp "Solo" Solo)
+ liftReadPrec rp _ = readData (readUnaryWith rp "Solo" MkSolo)
liftReadListPrec = liftReadListPrecDefault
liftReadList = liftReadListDefault
@@ -275,7 +257,6 @@
liftReadListPrec = liftReadListPrecDefault
liftReadList = liftReadListDefault
--}
instance Show1 Solo where
liftShowsPrec sp _ d (MkSolo x) = showsUnaryWith sp "MkSolo" d x
@@ -293,7 +274,6 @@
compare u1 v1 `mappend`
comp1 x1 x2 `mappend` comp2 y1 y2
-{-
instance Read a => Read2 ((,,) a) where
liftReadPrec2 rp1 _ rp2 _ = parens $ paren $ do
x1 <- readPrec
@@ -305,7 +285,6 @@
liftReadListPrec2 = liftReadListPrec2Default
liftReadList2 = liftReadList2Default
--}
instance Show a => Show2 ((,,) a) where
liftShowsPrec2 sp1 _ sp2 _ _ (x1,y1,y2)
@@ -320,18 +299,15 @@
instance (Ord a, Ord b) => Ord1 ((,,) a b) where
liftCompare = liftCompare2 compare
-{-
instance (Read a, Read b) => Read1 ((,,) a b) where
liftReadPrec = liftReadPrec2 readPrec readListPrec
liftReadListPrec = liftReadListPrecDefault
liftReadList = liftReadListDefault
--}
instance (Show a, Show b) => Show1 ((,,) a b) where
liftShowsPrec = liftShowsPrec2 showsPrec showList
-{-
instance (Eq a, Eq b) => Eq2 ((,,,) a b) where
liftEq2 e1 e2 (u1, u2, x1, y1) (v1, v2, x2, y2) =
u1 == v1 &&
@@ -381,6 +357,7 @@
instance (Show a, Show b, Show c) => Show1 ((,,,) a b c) where
liftShowsPrec = liftShowsPrec2 showsPrec showList
+{-
instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where
liftEq :: (a1 -> a2 -> Bool) -> (Generically1 f a1 -> Generically1 f a2 -> Bool)
liftEq (===) (Generically1 as1) (Generically1 as2) = liftEq (===) (from1 as1) (from1 as2)
@@ -546,7 +523,6 @@
where
complexPrec = 6
-{-
readsData :: (String -> ReadS a) -> Int -> ReadS a
readsData reader d =
readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s]
@@ -576,7 +552,6 @@
x <- step rp1
y <- step rp2
return $ cons x y
--}
showsUnaryWith :: (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith sp name d x = showParen (d > 10) $
--
⑨