{-# LANGUAGE RecordWildCards #-}

module Data.Functor.Classes.ReadShowHelper where

import Data.Functor.Classes
import Text.Read

data ReadMethods a = ReadMethods { readsPrecMethod :: Int -> ReadS a, readListMethod :: ReadS [a] }
data ReadPrecMethods a = ReadPrecMethods { readPrecMethod :: ReadPrec a, readListPrecMethod :: ReadPrec [a] }
data ShowMethods a = ShowMethods { showsPrecMethod :: Int -> a -> ShowS, showListMethod :: [a] -> ShowS }

liftReadMethods :: Read1 f => ReadMethods a -> ReadMethods (f a)
liftReadMethods (ReadMethods {..}) = ReadMethods
  { readsPrecMethod = liftReadsPrec readsPrecMethod readListMethod
  , readListMethod = liftReadList readsPrecMethod readListMethod }

liftReadPrecMethods :: Read1 f => ReadPrecMethods a -> ReadPrecMethods (f a)
liftReadPrecMethods (ReadPrecMethods {..}) = ReadPrecMethods
  { readPrecMethod = liftReadPrec readPrecMethod readListPrecMethod
  , readListPrecMethod = liftReadListPrec readPrecMethod readListPrecMethod }

liftShowMethods :: Show1 f => ShowMethods a -> ShowMethods (f a)
liftShowMethods (ShowMethods {..}) = ShowMethods
  { showsPrecMethod = liftShowsPrec showsPrecMethod showListMethod
  , showListMethod = liftShowList showsPrecMethod showListMethod }

liftReadMethods2 :: Read2 f => ReadMethods a -> ReadMethods b -> ReadMethods (f a b)
liftReadMethods2 a b = ReadMethods
  { readsPrecMethod = liftReadsPrec2 (readsPrecMethod a) (readListMethod a) (readsPrecMethod b) (readListMethod b)
  , readListMethod = liftReadList2 (readsPrecMethod a) (readListMethod a) (readsPrecMethod b) (readListMethod b) }

liftReadPrecMethods2 :: Read2 f => ReadPrecMethods a -> ReadPrecMethods b -> ReadPrecMethods (f a b)
liftReadPrecMethods2 a b = ReadPrecMethods
  { readPrecMethod = liftReadPrec2 (readPrecMethod a) (readListPrecMethod a) (readPrecMethod b) (readListPrecMethod b)
  , readListPrecMethod = liftReadListPrec2 (readPrecMethod a) (readListPrecMethod a) (readPrecMethod b) (readListPrecMethod b) }

liftShowMethods2 :: Show2 f => ShowMethods a -> ShowMethods b -> ShowMethods (f a b)
liftShowMethods2 a b = ShowMethods
  { showsPrecMethod = liftShowsPrec2 (showsPrecMethod a) (showListMethod a) (showsPrecMethod b) (showListMethod b)
  , showListMethod = liftShowList2 (showsPrecMethod a) (showListMethod a) (showsPrecMethod b) (showListMethod b) }