{-# LANGUAGE ScopedTypeVariables #-}

module Hedgehog.Classes.ShowRead (showReadLaws) where

import Hedgehog
import Hedgehog.Classes.Common

import Text.Read (readListDefault, readMaybe)
import Text.Show (showListWith)

-- | Tests the following 'Show' / 'Read' laws:
--
-- [__Partial Isomorphism: show/read__]: @'readMaybe' '.' 'show'@ ≡ @'Just'@
-- [__Partial Isomorphism: show/read with initial space__]: @'readMaybe' '.' (\" \" '++') '.' 'show'@ ≡ @'Just'@
-- [__Partial Isomorphism: showsPrec/readPrec__]: @(a,\"\") `elem` 'readsPrec' p ('showsPrec' p a \"\")@ ≡ @'True'@
-- [__Partial Isomorphism: showList/readList__]: @(as,\"\") `elem` 'readList' ('showList' as \"\")@ ≡ @'True'@
-- [__Partial Isomorphism: showListWith shows/readListDefault__]: @(as,\"\") `elem` 'readListDefault' ('showListWith' 'shows' as \"\")@ ≡ @'True'@
showReadLaws :: (Eq a, Read a, Show a) => Gen a -> Laws
showReadLaws :: forall a. (Eq a, Read a, Show a) => Gen a -> Laws
showReadLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Show/Read"
  [ (String
"Partial Isomorphism: show/read", forall a. (Eq a, Read a, Show a) => Gen a -> Property
showReadPartialIsomorphism Gen a
gen)
  , (String
"Partial Isomorphism: show/read with initial space", forall a. (Eq a, Read a, Show a) => Gen a -> Property
showReadSpacePartialIsomorphism Gen a
gen)
  , (String
"Partial Isomorphism: showsPrec/readsPrec", forall a. (Eq a, Read a, Show a) => Gen a -> Property
showsPrecReadsPrecPartialIsomorphism Gen a
gen)
  , (String
"Partial Isomorphism: showList/readList", forall a. (Eq a, Read a, Show a) => Gen a -> Property
showListReadListPartialIsomorphism Gen a
gen)
  , (String
"Partial Isomorphism: showListWith shows/readListDefault", forall a. (Eq a, Read a, Show a) => Gen a -> Property
showListWithShowsReadListDefaultPartialIsomorphism Gen a
gen)
  ]

showReadPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showReadPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showReadPartialIsomorphism Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  let lhs :: Maybe a
lhs = forall a. Read a => String -> Maybe a
readMaybe (forall a. Show a => a -> String
show a
a)
  let rhs :: Maybe a
rhs = forall a. a -> Maybe a
Just a
a
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"Show/Read Partial Isomorphism", lawContextTcName :: String
lawContextTcName = String
"Show/Read"
        , lawContextLawBody :: String
lawContextLawBody = String
"readMaybe . show" String -> String -> String
`congruency` String
"Just"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Maybe a
lhs Maybe a
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showA :: String
showA = forall a. Show a => a -> String
show a
a;
            in [String] -> String
lawWhere
              [ String
"readMaybe . show $ a" String -> String -> String
`congruency` String
"Just a, where"
              , String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
              ]
        } 
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Maybe a
lhs Maybe a
rhs Context
ctx

showReadSpacePartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showReadSpacePartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showReadSpacePartialIsomorphism Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  let lhs :: Maybe a
lhs = forall a. Read a => String -> Maybe a
readMaybe (String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a)
  let rhs :: Maybe a
rhs = forall a. a -> Maybe a
Just a
a
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"Show/Read Partial Isomorphism With Initial Space", lawContextTcName :: String
lawContextTcName = String
"Show/Read"
        , lawContextLawBody :: String
lawContextLawBody = String
"readMaybe . (\" \" ++) . show" String -> String -> String
`congruency` String
"Just"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Maybe a
lhs Maybe a
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showA :: String
showA = forall a. Show a => a -> String
show a
a;
            in [String] -> String
lawWhere
              [ String
"readMaybe . (\" \" ++) . show $ a" String -> String -> String
`congruency` String
"Just a, where"
              , String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
              ]
        }
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Maybe a
lhs Maybe a
rhs Context
ctx

showsPrecReadsPrecPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showsPrecReadsPrecPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showsPrecReadsPrecPartialIsomorphism Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
  Int
p <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen Int
genShowReadPrecedence
  let lhs :: Bool
lhs = (a
a,String
"") forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Read a => Int -> ReadS a
readsPrec Int
p (forall a. Show a => Int -> a -> String -> String
showsPrec Int
p a
a String
"")
  let rhs :: Bool
rhs = Bool
True
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"ShowsPrec/ReadsPrec partial isomorphism", lawContextTcName :: String
lawContextTcName = String
"Show/Read"
        , lawContextLawBody :: String
lawContextLawBody = String
"(a,\"\") `elem` readsPrec p (showsPrec p a \"\")" String -> String -> String
`congruency` String
"True"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Bool
lhs Bool
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showA :: String
showA = forall a. Show a => a -> String
show a
a; showP :: String
showP = forall a. Show a => a -> String
show Int
p
            in [String] -> String
lawWhere
              [ String
"(a,\"\") `elem` readsPrec p (showsPrec p a \"\")" String -> String -> String
`congruency` String
"True, where"
              , String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
              , String
"p = " forall a. [a] -> [a] -> [a]
++ String
showP
              ]
        }  
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Bool
lhs Bool
rhs Context
ctx

showListReadListPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showListReadListPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showListReadListPartialIsomorphism Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  [a]
as <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genSmallList Gen a
gen
  let lhs :: Bool
lhs = ([a]
as,String
"") forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Read a => ReadS [a]
readList (forall a. Show a => [a] -> String -> String
showList [a]
as String
"")
  let rhs :: Bool
rhs = Bool
True
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"ShowsList/ReadsList partial isomorphism", lawContextTcName :: String
lawContextTcName = String
"Show/Read"
        , lawContextLawBody :: String
lawContextLawBody = String
"(as,\"\") `elem` readList (showList as \"\")" String -> String -> String
`congruency` String
"True"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Bool
lhs Bool
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showAS :: String
showAS = forall a. Show a => a -> String
show [a]
as
            in [String] -> String
lawWhere
              [ String
"(as,\"\") `elem` readList (showList as \"\")" String -> String -> String
`congruency` String
"True, where"
              , String
"as = " forall a. [a] -> [a] -> [a]
++ String
showAS
              ]
        }  
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Bool
lhs Bool
rhs Context
ctx
 
showListWithShowsReadListDefaultPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showListWithShowsReadListDefaultPartialIsomorphism :: forall a. (Eq a, Read a, Show a) => Gen a -> Property
showListWithShowsReadListDefaultPartialIsomorphism Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
  [a]
as <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genSmallList Gen a
gen
  let lhs :: Bool
lhs = ([a]
as,String
"") forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a. Read a => ReadS [a]
readListDefault (forall a. (a -> String -> String) -> [a] -> String -> String
showListWith forall a. Show a => a -> String -> String
shows [a]
as String
"")
  let rhs :: Bool
rhs = Bool
True
  let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
        { lawContextLawName :: String
lawContextLawName = String
"ShowListWith/ReadListDefault partial isomorphism", lawContextTcName :: String
lawContextTcName = String
"Show/Read"
        , lawContextLawBody :: String
lawContextLawBody = String
"(as,\"\") `elem` readListDefault (showListWith shows as \"\")" String -> String -> String
`congruency` String
"True"
        , lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced Bool
lhs Bool
rhs
        , lawContextTcProp :: String
lawContextTcProp =
            let showAS :: String
showAS = forall a. Show a => a -> String
show [a]
as
            in [String] -> String
lawWhere
              [ String
"(as,\"\") `elem` readListDefault (showListWith shows as \"\")" String -> String -> String
`congruency` String
"True, where"
              , String
"as = " forall a. [a] -> [a] -> [a]
++ String
showAS 
              ]
        } 
  forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx Bool
lhs Bool
rhs Context
ctx