generic-accessors-0.4.0: tests/Tests.hs

{-# OPTIONS_GHC -Wall #-}
{-# Language DeriveGeneric #-}

module Main where

import GHC.Generics ( Generic )

import Data.Monoid ( mempty )
import Text.Printf ( printf )
import Test.Framework ( ColorMode(..), RunnerOptions'(..), TestOptions'(..), defaultMainWithOpts )
import qualified Test.HUnit.Base as HUnit
import Test.Framework ( Test, testGroup )
import Test.Framework.Providers.HUnit ( testCase )

import Accessors

main :: IO ()
main = do
  defaultMainWithOpts
    [ accessorTests
    ]
    opts

opts :: RunnerOptions' Maybe
opts = mempty { ropt_color_mode = Just ColorAlways
              , ropt_threads = Just 1
              , ropt_test_options = Just my_test_opts
              }

my_test_opts :: TestOptions' Maybe
my_test_opts = mempty { topt_timeout = Just (Just 2000000) }


data Xyz a = Xyz { xx :: Int
                 , yy :: Double
                 , zz :: Float
                 , ww :: a
                 } deriving (Generic)
data One = MkOne { one :: Double } deriving (Generic)
data Foo = MkFoo { aaa :: Int
                 , bbb :: Xyz Int
                 , lol :: Bool
                 , notlol :: Bool
                 , yoyo :: Xyz (Xyz Double)
                 , ccc :: One
                 } deriving (Generic)
instance Lookup One
instance Lookup a => Lookup (Xyz a)
instance Lookup Foo

yo :: Xyz (Xyz Double)
yo = Xyz 42 45 2000 (Xyz 2 3 4 5)

foo :: Foo
foo = MkFoo 2 (Xyz 6 7 8 9) True False yo (MkOne 17)

yup :: AccessorTree Foo
yup = accessors foo


accessorTests :: Test
accessorTests =
  testGroup "accessors"
  [ testCase "showTree" treeTest
  , testCase "showFlat" flatTest
  , testCase "showFlat (aligned)" flatTestAligned
  ]

assertEqualString :: String -> String -> HUnit.Assertion
assertEqualString x y = HUnit.assertBool msg (x == y)
  where
    msg = "------------------ expected: ------------------\n" ++
          x ++
          "\n------------------ but got: -------------------\n" ++
          y ++
          "\n-----------------------------------------------"

treeTest :: HUnit.Assertion
treeTest = assertEqualString x y
  where
    x = init $ unlines
        [ "MkFoo"
        , "{ aaa = 2"
        , ", bbb = Xyz"
        , "        { xx = 6"
        , "        , yy = 7.00e0"
        , "        , zz = 8.00e0"
        , "        , ww = 9"
        , "        }"
        , ", lol = True"
        , ", notlol = False"
        , ", yoyo = Xyz"
        , "         { xx = 42"
        , "         , yy = 4.50e1"
        , "         , zz = 2.00e3"
        , "         , ww = Xyz"
        , "                { xx = 2"
        , "                , yy = 3.00e0"
        , "                , zz = 4.00e0"
        , "                , ww = 5.00e0"
        , "                }"
        , "         }"
        , ", ccc = MkOne"
        , "        { one = 1.70e1"
        , "        }"
        , "}"
        ]
    y = showTree yup (printf "%.2e") foo

flatTest :: HUnit.Assertion
flatTest = assertEqualString x y
  where
    x = init $ unlines
        [ "aaa = 2"
        , "bbb.xx = 6"
        , "bbb.yy = 7.00e0"
        , "bbb.zz = 8.00e0"
        , "bbb.ww = 9"
        , "lol = True"
        , "notlol = False"
        , "yoyo.xx = 42"
        , "yoyo.yy = 4.50e1"
        , "yoyo.zz = 2.00e3"
        , "yoyo.ww.xx = 2"
        , "yoyo.ww.yy = 3.00e0"
        , "yoyo.ww.zz = 4.00e0"
        , "yoyo.ww.ww = 5.00e0"
        , "ccc.one = 1.70e1"
        ]
    y = showFlat yup False (printf "%.2e") foo

flatTestAligned :: HUnit.Assertion
flatTestAligned = assertEqualString x y
  where
    x = init $ unlines
        [ "aaa        = 2"
        , "bbb.xx     = 6"
        , "bbb.yy     = 7.00e0"
        , "bbb.zz     = 8.00e0"
        , "bbb.ww     = 9"
        , "lol        = True"
        , "notlol     = False"
        , "yoyo.xx    = 42"
        , "yoyo.yy    = 4.50e1"
        , "yoyo.zz    = 2.00e3"
        , "yoyo.ww.xx = 2"
        , "yoyo.ww.yy = 3.00e0"
        , "yoyo.ww.zz = 4.00e0"
        , "yoyo.ww.ww = 5.00e0"
        , "ccc.one    = 1.70e1"
        ]
    y = showFlat yup True (printf "%.2e") foo