如何修复以下 Read1 实例?

How to fix the following Read1 instance?

考虑以下程序。

import Data.Functor.Classes
import Control.Monad.Identity

readsNullaryWith :: String -> t -> String -> ReadS t
readsNullaryWith name cons kw s = [(cons, s) | kw == name]

data ListM m a = Cons a (MList m a) | Null
type MList m a = m (ListM m a)

instance Read1 m => Read1 (ListM m) where
    liftReadsPrec rp rl = readsData $
        readsBinaryWith rp (liftReadsPrec rp' rl') "Cons" Cons <>
        readsNullaryWith "Null" Null where
            rp' = liftReadsPrec rp rl
            rl' = liftReadList rp rl

instance Show1 m => Show1 (ListM m) where
    liftShowsPrec sp sl d (Cons x xs) =
        showsBinaryWith sp (liftShowsPrec sp' sl') "Cons" d x xs where
            sp' = liftShowsPrec sp sl
            sl' = liftShowList sp sl
    liftShowsPrec _ _ _ Null =
        showString "Null"

instance (Read1 m, Read a) => Read (ListM m a) where readsPrec = readsPrec1
instance (Show1 m, Show a) => Show (ListM m a) where showsPrec = showsPrec1

main :: IO ()
main = do
    print (read "Identity (Null)" :: MList Identity Int)
    print (read "Identity Null" :: MList Identity Int) -- Exception: Prelude.read: no parse

我为 ListM m a 定义了 ReadShow 实例。他们两个都是类型检查。表达式 read "Identity (Null)" :: MList Identity Int 按预期工作。但是,表达式 read "Identity Null" :: MList Identity Int 抛出解析异常。我如何修复此 Read1 实例,使其不需要用括号括起空构造函数?

修复了程序。

import Data.Functor.Classes
import Control.Monad.Identity

readsNullaryWith :: String -> t -> ReadS t
readsNullaryWith name cons s = [(cons, t) | (kw, t) <- lex s, kw == name]

data ListM m a = Cons a (MList m a) | Null
type MList m a = m (ListM m a)

instance Read1 m => Read1 (ListM m) where
    liftReadsPrec rp rl =
        readsData (readsBinaryWith rp (liftReadsPrec rp' rl') "Cons" Cons) <>
        const (readParen False $ readsNullaryWith "Null" Null) where
            rp' = liftReadsPrec rp rl
            rl' = liftReadList rp rl

instance Show1 m => Show1 (ListM m) where
    liftShowsPrec sp sl d (Cons x xs) =
        showsBinaryWith sp (liftShowsPrec sp' sl') "Cons" d x xs where
            sp' = liftShowsPrec sp sl
            sl' = liftShowList sp sl
    liftShowsPrec _ _ _ Null =
        showString "Null"

instance (Read1 m, Read a) => Read (ListM m a) where readsPrec = readsPrec1
instance (Show1 m, Show a) => Show (ListM m a) where showsPrec = showsPrec1

main :: IO ()
main = do
    print (read "Identity (Null)" :: MList Identity Int)
    print (read "Identity Null" :: MList Identity Int)

如果 readsData 解析器失败,那么我们会尝试将空构造函数与 optional 括号匹配。