{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wall #-}

{-| Module      : Test.QuickCheck.Classes.ShowRead
    Description : Properties for testing the interaction between the Show and Read
                  type classes.
-}
module Test.QuickCheck.Classes.ShowRead
  ( showReadLaws
  ) where

import Data.Proxy (Proxy)
import Test.QuickCheck
import Text.Read (readListDefault)
import Text.Show (showListWith)

import Test.QuickCheck.Classes.Internal (Laws(..), ShowReadPrecedence(..),
  SmallList(..), myForAllShrink,readMaybe)

-- | Tests the following properties:
--
-- [/Partial Isomorphism: 'show' \/ 'read'/]
--   @'readMaybe' ('show' a) ≡ 'Just' a@
-- [/Partial Isomorphism: 'show' \/ 'read' with initial space/]
--   @'readMaybe' (" " ++ 'show' a) ≡ 'Just' a@
-- [/Partial Isomorphism: 'showsPrec' \/ 'readsPrec'/]
--   @(a,"") \`elem\` 'readsPrec' p ('showsPrec' p a "")@
-- [/Partial Isomorphism: 'showList' \/ 'readList'/]
--   @(as,"") \`elem\` 'readList' ('showList' as "")@
-- [/Partial Isomorphism: 'showListWith' 'shows' \/ 'readListDefault'/]
--   @(as,"") \`elem\` 'readListDefault' ('showListWith' 'shows' as "")@
--
-- /Note:/ When using @base-4.5@ or older, a shim implementation
-- of 'readMaybe' is used.
--
showReadLaws :: (Show a, Read a, Eq a, Arbitrary a) => Proxy a -> Laws
showReadLaws :: Proxy a -> Laws
showReadLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Show/Read"
  [ (String
"Partial Isomorphism: show/read", Proxy a -> Property
forall a.
(Show a, Read a, Arbitrary a, Eq a) =>
Proxy a -> Property
showReadPartialIsomorphism Proxy a
p)
  , (String
"Partial Isomorphism: show/read with initial space", Proxy a -> Property
forall a.
(Show a, Read a, Arbitrary a, Eq a) =>
Proxy a -> Property
showReadSpacePartialIsomorphism Proxy a
p)
  , (String
"Partial Isomorphism: showsPrec/readsPrec", Proxy a -> Property
forall a.
(Show a, Read a, Arbitrary a, Eq a) =>
Proxy a -> Property
showsPrecReadsPrecPartialIsomorphism Proxy a
p)
  , (String
"Partial Isomorphism: showList/readList", Proxy a -> Property
forall a.
(Show a, Read a, Arbitrary a, Eq a) =>
Proxy a -> Property
showListReadListPartialIsomorphism Proxy a
p)
  , (String
"Partial Isomorphism: showListWith shows / readListDefault",
     Proxy a -> Property
forall a.
(Show a, Read a, Arbitrary a, Eq a) =>
Proxy a -> Property
showListWithShowsReadListDefaultPartialIsomorphism Proxy a
p)
  ]


showReadPartialIsomorphism :: forall a.
  (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property
showReadPartialIsomorphism :: Proxy a -> Property
showReadPartialIsomorphism Proxy a
_ =
  Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> Maybe a)
-> String
-> (a -> Maybe a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
a :: a) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a])
  (String
"readMaybe (show a)")
  (\a
a -> String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (a -> String
forall a. Show a => a -> String
show a
a))
  (String
"Just a")
  (\a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a)

showReadSpacePartialIsomorphism :: forall a.
  (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property
showReadSpacePartialIsomorphism :: Proxy a -> Property
showReadSpacePartialIsomorphism Proxy a
_ =
  Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> Maybe a)
-> String
-> (a -> Maybe a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
  (\(a
a :: a) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a])
  (String
"readMaybe (\" \" ++ show a)")
  (\a
a -> String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a))
  (String
"Just a")
  (\a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a)

showsPrecReadsPrecPartialIsomorphism :: forall a.
  (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property
showsPrecReadsPrecPartialIsomorphism :: Proxy a -> Property
showsPrecReadsPrecPartialIsomorphism Proxy a
_ =
  (a -> ShowReadPrecedence -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> ShowReadPrecedence -> Bool) -> Property)
-> (a -> ShowReadPrecedence -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a :: a) (ShowReadPrecedence Int
p) ->
    (a
a,String
"") (a, String) -> [(a, String)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
p (Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
p a
a String
"")

showListReadListPartialIsomorphism :: forall a.
  (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property
showListReadListPartialIsomorphism :: Proxy a -> Property
showListReadListPartialIsomorphism Proxy a
_ =
  (SmallList a -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((SmallList a -> Bool) -> Property)
-> (SmallList a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(SmallList ([a]
as :: [a])) ->
    ([a]
as,String
"") ([a], String) -> [([a], String)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ReadS [a]
forall a. Read a => ReadS [a]
readList ([a] -> String -> String
forall a. Show a => [a] -> String -> String
showList [a]
as String
"")

showListWithShowsReadListDefaultPartialIsomorphism :: forall a.
  (Show a, Read a, Arbitrary a, Eq a) => Proxy a -> Property
showListWithShowsReadListDefaultPartialIsomorphism :: Proxy a -> Property
showListWithShowsReadListDefaultPartialIsomorphism Proxy a
_ =
  (SmallList a -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((SmallList a -> Bool) -> Property)
-> (SmallList a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(SmallList ([a]
as :: [a])) ->
    ([a]
as,String
"") ([a], String) -> [([a], String)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ReadS [a]
forall a. Read a => ReadS [a]
readListDefault ((a -> String -> String) -> [a] -> String -> String
forall a. (a -> String -> String) -> [a] -> String -> String
showListWith a -> String -> String
forall a. Show a => a -> String -> String
shows [a]
as String
"")