Sorry for the mix-up. I mean associativity, not fixity!
2019년 1월 6일 (일) 오전 9:06, Dannyu NDos
For the following code as an example:
{-# LANGUAGE TypeOperators #-}
infixr 5 :.
data List a = Null | a :. List a deriving (Eq, Ord, Show, Read)
The Show instance and the Read instance are inaware of the fixity of (:.):
*Main> 2 :. 3 :. Null 2 :. (3 :. Null) *Main> read "2 :. 3 :. Null" :: List Int *** Exception: Prelude.read: no parse *Main> read "2 :. (3 :. Null)" :: List Int 2 :. (3 :. Null)
The derived instances should be:
instance Show a => Show (List a) where showsPrec p Null = showParen (11 <= p) (showString "Null") showsPrec p (x :. xs) = showParen (5 <= p) (go p (x :. xs)) where go _ Null = showString "Null" go p (x :. xs) = showsPrec p x . showString " :. " . go p xs
instance Read a => Read (List a) where readPrec = parens $ do Ident "Null" <- lexP return Null +++ (do x <- readPrec Symbol ":." <- lexP xs <- readPrec return (x :. xs) )