{-# LANGUAGE ExistentialQuantification #-}

-- | QuickReadShow is designed for the rapid manufacture of read/show
-- instances.  To create such an instance you need to (a) instance
-- quickRead; (b) instance Read/Show using a particular template.
-- (Before April 2004 (b) was not part of the code; it now has to
-- be added to deal with tougher GHC restrictions on overlapping instances.)
module Util.QuickReadShow(
   WrapRead(WrapRead),
   QuickRead(quickRead),
   qRead,

   WrapShow(WrapShow),
   QuickShow(quickShow),
   qShow
   ) where

data WrapRead toRead = forall read . Read read => WrapRead (read -> toRead)

class QuickRead toRead where
   quickRead :: WrapRead toRead

mkReadsPrec :: WrapRead toRead -> Int -> ReadS toRead
mkReadsPrec :: WrapRead toRead -> Int -> ReadS toRead
mkReadsPrec (WrapRead read -> toRead
convFn) Int
prec String
str =
   let
      parses :: [(read, String)]
parses = Int -> ReadS read
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
str
   in
      ((read, String) -> (toRead, String))
-> [(read, String)] -> [(toRead, String)]
forall a b. (a -> b) -> [a] -> [b]
map
         (\ (read
result,String
rest) -> (read -> toRead
convFn read
result,String
rest))
         [(read, String)]
parses

qRead :: QuickRead toRead => Int -> String -> [(toRead, String)]
qRead :: Int -> String -> [(toRead, String)]
qRead = WrapRead toRead -> Int -> String -> [(toRead, String)]
forall toRead. WrapRead toRead -> Int -> ReadS toRead
mkReadsPrec WrapRead toRead
forall toRead. QuickRead toRead => WrapRead toRead
quickRead

{- Example instance

instance Read ExampleType where
   readsPrec = qRead
   -}

data WrapShow toShow = forall show . Show show => WrapShow (toShow -> show)

class QuickShow toShow where
   quickShow :: WrapShow toShow

mkShowsPrec :: WrapShow toShow -> Int -> toShow -> ShowS
mkShowsPrec :: WrapShow toShow -> Int -> toShow -> ShowS
mkShowsPrec (WrapShow toShow -> show
convFn) Int
prec toShow
value String
acc =
   Int -> show -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
prec (toShow -> show
convFn toShow
value) String
acc

qShow :: QuickShow toShow => Int -> toShow -> String -> String
qShow :: Int -> toShow -> ShowS
qShow = WrapShow toShow -> Int -> toShow -> ShowS
forall toShow. WrapShow toShow -> Int -> toShow -> ShowS
mkShowsPrec WrapShow toShow
forall toShow. QuickShow toShow => WrapShow toShow
quickShow

{- Example instance

instance Show ExampleType where
   showsPrec = qShow
   -}