tuple-classes-1.0.2: test/Spec.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GHC2021 #-}

module Main (main) where

import Control.Exception    (SomeException, catch, evaluate)
import Data.Functor.Classes
import Data.Tuple.Classes
import Text.Read            (readPrec_to_S)
#if defined(LENS)
import Control.Lens
#else
import Lens.Micro
#endif

import DocTest01 qualified
import DocTest02 qualified

main :: IO ()
main = do
    DocTest01.main
    DocTest02.main

    testUncurryNLaziness
    testTupleInsertLaziness
    testFieldN
    testShow2
    testRead2

testUncurryNLaziness :: IO ()
testUncurryNLaziness = do
    let f _ _ _ _ = putStrLn "OK"
        test method = method f $ error "not lazy enough"

    test $ uncurryN  @4
    test $ uncurryN' @4

testTupleInsertLaziness :: IO ()
testTupleInsertLaziness = do
    let test x = (True <$ evaluate x) `catch` \(_ :: SomeException) ->
            return False

    lazyConverged <- test $
        ith @2 $ tupleInsert @2 () (undefined :: Solo Int)
    if lazyConverged then putStrLn "OK" else error "too strict"

    strictConverged <- test $
        ith @2 $ tupleInsert @2 () (undefined :: Identity Int)
    if strictConverged then error "not strict enough" else putStrLn "OK"

testFieldN :: IO ()
testFieldN = putStrLn $ StrictTuple5 () () () () "OK" ^. _5

nestedS :: String
nestedS = "StrictTuple3 (StrictTuple3 1 2 3) 2 3"

nested :: StrictTuple3 (StrictTuple3 Int Int Int) Int Int
nested = StrictTuple3 (StrictTuple3 1 2 3) 2 3

testShow2 :: IO ()
testShow2 = do
    let expected = nestedS
        got = showsPrec2 0 nested ""
    if expected == got
        then putStrLn "OK"
        else error $ "expected " ++ show expected ++ "; got " ++ show got

testRead2 :: IO ()
testRead2 = do
    let expected = [(nested, "")]
        got = readPrec_to_S readPrec2 0 nestedS
    if expected == got
        then putStrLn "OK"
        else error $ "expected " ++ show expected ++ "; got " ++ show got