emgm-0.2: tests/ReadShow.hs

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}

module ReadShow (tests) where

import Prelude hiding (Read, Show, readsPrec, reads, read, show)
import qualified Prelude as P (Read, Show, read, show)
import Data.Generics (Data)
import Test.HUnit

import Generics.EMGM

import Base
import TTree

-----------------------------------------------------------------------------
-- Utility functions
-----------------------------------------------------------------------------

test_all :: (Eq a, Data a, P.Read a, P.Show a, Rep Read a, Rep Show a)
         => Bool -> a -> Test
test_all notIfxRec x =
  let expected = P.show x
      actual   = show x in
  "x = " ++ P.show x ++ " :: " ++ typeNameOf x ~:

    -- The following is conditional on whether x has an infix constructor with
    -- record syntax. That is currently broken in GHC.
    (if notIfxRec then ["P.read . show == id" ~: P.read actual ~?= x] else [])
    ++
    [ "read . P.show == id" ~: read expected ~?= Just x
    , "read . show == id"   ~: read actual ~?= Just x
    , "show == P.show"      ~: actual ~?= expected
    ]

-----------------------------------------------------------------------------
-- Test collection
-----------------------------------------------------------------------------

tests =
  "ReadShow" ~:
    [ test_all True  (42 :: Int)
    , test_all True  (9999999999999999999999999999999 :: Integer)
    , test_all True  (4.2 :: Float)
    , test_all True  (5.3 :: Double)
    , test_all True  ('\t' :: Char)
    , test_all True  (True :: Bool)
    , test_all True  (Just True :: Maybe Bool)
    , test_all True  (Left 7.8888 :: Either Float Char)
    , test_all True  (Right '2' :: Either Float Char)
    , test_all True  (Nothing :: Maybe Double)
    , test_all True  (Just 256 :: Maybe Int)
    , test_all True  (L1 5 :: TTree Int)
    , test_all True  (L1 (Just 5) :: TTree (Maybe Int))
    , test_all True  (L2 88 (L1 99) :: TTree Int)
    , test_all True  (L3 654 :: TTree Int)
    , test_all True  (Just (L3 654) :: Maybe (TTree Int))
    , test_all True  (L4 (L2 1 (L3 2)) 3 :: TTree Int)
    , test_all True  (L5 101 (L4 (L3 102) 103) 104 :: TTree Int)
    , test_all True  (L3 'g' :^: 'a' :: TTree Char)
    , test_all True  ((L3 'F' :^: 'a') :^: 'g' :: TTree Char)
    , test_all False (L1 1.1 :<>: L1 1.2 :^: 1.3 :: TTree Float)
    , test_all False (L1 (L3 8.8 :^: 9.9) :<>: L4 (L4 (L2 (L3 11.11) (L1 (L1 22.22))) (L3 33.33)) (L5 0.44 (L3 55.55) 0.66) :: TTree (TTree Float))
    , test_all True  [1,2,3,4,5 :: Int]
    , test_all True  [[5.3,3.5],[35.0],[0.53 :: Float]]
    , test_all True  "abcdefgh"
    , test_all True  (Just "abcdefgh")
    , test_all True  ()
    , test_all True  (1::Int,2::Float)
    , test_all True  (1::Int,2::Float,3::Double)
    , test_all True  (1::Int,2::Float,3::Double,'4')
    , test_all True  (1::Int,2::Float,3::Double,'4',False)
    , test_all True  (1::Int,2::Float,3::Double,'4',False,Just (6::Int))
    , test_all True  (1::Int,2::Float,3::Double,'4',False,Just (6::Int),L1 (7::Float))
    ]