-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- Note: This extension is enabled because it allows better representation of tests
-- with @BinBase@. These tests require special representation behavior because 'show' works
-- incorrect with non-decimal base.
{-# LANGUAGE HexFloatLiterals #-}

-- | Tests for custom arithmetic datatypes, added to Lorentz
module Test.Lorentz.CustomArith
  ( test_fixedArith
  , test_NFixedArith
  ) where

import Prelude hiding (div)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))

import Lorentz


test_fixedArith :: TestTree
test_fixedArith =
  testGroup "Arithmetic operations on Fixed values"
    [ testGroup "Arithmetics"
      [ testGroup "Decimal base"
        [ testCase "Fixed add" do
            add -$ initialStorageDec
              @?= (2.2 :: Fixed (DecBase 3))
        , testCase "Fixed sub" do
            sub -$ initialStorageDec
              @?= (0 :: Fixed (DecBase 3))
        , testCase "Fixed mul" do
            mul -$ initialStorageDec
              @?= (1.21 :: Fixed (DecBase 6))
        , testCase "Fixed ediv 1" do
            ediv -$ (123.456 :: Fixed (DecBase 3), 100 :: Integer)
              @?= Just (1, 23.456 :: (NFixed (DecBase 3)))
        , testCase "Fixed ediv 2" do
            ediv -$ (2 :: Fixed (DecBase 3), 100 :: Integer)
              @?= Just (0, 2 :: (NFixed (DecBase 3)))
        ]
      , testGroup "Binary base"
        [ testCase "Fixed add" do
            add -$ initialStorageBin
              @?= (2.2 :: Fixed (BinBase 1))
        , testCase "Fixed sub" do
            sub -$ initialStorageBin
              @?= (0 :: Fixed (BinBase 1))
        , testCase "Fixed mul" do
            mul -$ initialStorageBin
              @?= (1.21 :: Fixed (BinBase 2))
        ]
      ]
    , testGroup "Rounding"
        [ testGroup "Rounding with decimal base"
            [ testCase "Round up Fixed with decimal base 1" do
                round_ -$ (1.23456 :: (Fixed (DecBase 6)))
                  @?= (1.235 :: Fixed (DecBase 3))
            , testCase "Round up Fixed with decimal base 2" do
                round_ -$ (1.23446 :: (Fixed (DecBase 6)))
                  @?= (1.234 :: Fixed (DecBase 3))
            , testCase "Round up Fixed with decimal base 3" do
                round_ -$ (0.177 :: (Fixed (DecBase 3)))
                  @?= (0.18 :: Fixed (DecBase 2))
            , testCase "Round up Fixed with decimal base 4" do
                round_ -$ (0.173 :: (Fixed (DecBase 3)))
                  @?= (0.17 :: Fixed (DecBase 2))
            , testCase "Round up Fixed with decimal base 5" do
                round_ -$ (1.230 :: (Fixed (DecBase 3)))
                  @?= (1.23 :: Fixed (DecBase 2))
            , testCase "Ceil 1" do
                ceil_ -$ (0.177 :: (Fixed (DecBase 3)))
                  @?= (0.18 :: Fixed (DecBase 2))
            , testCase "Ceil 2" do
                ceil_ -$ (0.173 :: (Fixed (DecBase 3)))
                  @?= (0.18 :: Fixed (DecBase 2))
            , testCase "Ceil 3" do
                ceil_ -$ (1.230 :: (Fixed (DecBase 3)))
                  @?= (1.23 :: Fixed (DecBase 2))
            , testCase "Floor 1" do
                floor_ -$ (0.177 :: (Fixed (DecBase 3)))
                  @?= (0.17 :: Fixed (DecBase 2))
            , testCase "Floor 2" do
                floor_ -$ (0.173 :: (Fixed (DecBase 3)))
                  @?= (0.17 :: Fixed (DecBase 2))
            , testCase "Floor 3" do
                floor_ -$ (1.230 :: (Fixed (DecBase 3)))
                  @?= (1.23 :: Fixed (DecBase 2))
            , testCase "Round down" do
                round_ -$ (1.234 :: Fixed (DecBase 3))
                  @?= (1.23400 :: (Fixed (DecBase 6)))
            ]
        , testGroup "Rounding with Binary Base"
            [ testCase "Round up Fixed with binary base 1" do
                round_ -$ (0x1.23456 :: (Fixed (BinBase 6)))
                  @?= (0x1.235 :: Fixed (BinBase 3))
            , testCase "Round up Fixed with binary base 2" do
                round_ -$ (0x1.23446 :: (Fixed (BinBase 6)))
                  @?= (0x1.234 :: Fixed (BinBase 3))
            , testCase "Round up Fixed with binary base 3" do
                round_ -$ (0x0.177 :: (Fixed (BinBase 3)))
                  @?= (0x0.18 :: Fixed (BinBase 2))
            , testCase "Round up Fixed with binary base 4" do
                round_ -$ (0x0.173 :: (Fixed (BinBase 3)))
                  @?= (0x0.17 :: Fixed (BinBase 2))
            , testCase "Round up Fixed with binary base 5" do
                round_ -$ (0x1.230 :: (Fixed (BinBase 3)))
                  @?= (0x1.23 :: Fixed (BinBase 2))
            , testCase "Ceil 1" do
                ceil_ -$ (0x0.177 :: (Fixed (BinBase 3)))
                  @?= (0x0.18 :: Fixed (BinBase 2))
            , testCase "Ceil 2" do
                ceil_ -$ (0x0.173 :: (Fixed (BinBase 3)))
                  @?= (0x0.18 :: Fixed (BinBase 2))
            , testCase "Ceil 3" do
                ceil_ -$ (0x1.230 :: (Fixed (BinBase 12)))
                  @?= (0x1.23 :: Fixed (BinBase 8

                  ))
            , testCase "Floor 1" do
                floor_ -$ (0x0.177 :: (Fixed (BinBase 3)))
                  @?= (0x0.17 :: Fixed (BinBase 2))
            , testCase "Floor 2" do
                floor_ -$ (0x0.173 :: (Fixed (BinBase 3)))
                  @?= (0x0.17 :: Fixed (BinBase 2))
            , testCase "Floor 3" do
                floor_ -$ (0x1.230 :: (Fixed (BinBase 3)))
                  @?= (0x1.23 :: Fixed (BinBase 2))
            ]
        , testGroup "Casts"
          [ testCase "Cast to Integer" do
              fromFixed @(Fixed (DecBase 6)) -$ (1.23456 :: (Fixed (DecBase 6)))
                @?= 1
          , testCase "Cast Integer to Fixed" do
              toFixed @(Fixed (DecBase 6)) -$ (123456 :: Integer)
                @?= (123456 :: (Fixed (DecBase 6)))
          , testCase "Cast to Integer (Binary base)" do
              fromFixed @(Fixed (BinBase 6)) -$ (1.23456 :: (Fixed (BinBase 6)))
                @?= 1
          , testCase "Cast Integer to Fixed (Binary base)" do
              toFixed @(Fixed (BinBase 6)) -$ (123456 :: Integer)
                @?= (123456.00 :: (Fixed (BinBase 6)))
          ]
        ]
    , testGroup "Division"
        [ testCase "Divide big Fixed(Dec) to small Fixed(Dec)" do
            div @(Maybe (Fixed (DecBase 8))) -$ (625.123 :: Fixed (DecBase 3), 123.23 :: Fixed (DecBase 2))
              @?= Just (5.07281506 :: Fixed (DecBase 8))
        , testCase "Divide small Fixed(Dec) to big Fixed(Dec)" do
            div @(Maybe (Fixed (DecBase 8))) -$ (123.23 :: Fixed (DecBase 3), 625.123 :: Fixed (DecBase 2))
              @?= Just (0.19713015 :: Fixed (DecBase 8))
        , testCase "Divide big Fixed(Bin) to small Fixed(Bin)" do
            div @(Maybe (Fixed (BinBase 8))) -$ (625.123 :: Fixed (BinBase 3), 123.23 :: Fixed (BinBase 2))
              @?= (Just (5.079 :: Fixed (BinBase 8)))
        , testCase "Divide small Fixed(Bin) to big Fixed(Bin)" do
            div @(Maybe (Fixed (BinBase 8))) -$ (123.23 :: Fixed (BinBase 3), 625.123 :: Fixed (BinBase 2))
              @?= (Just (0.19713015 :: Fixed (BinBase 8)))
        , testCase "Divide by zero" do
            div @(Maybe (Fixed (BinBase 8))) -$ (123.23 :: Fixed (BinBase 3), 0 :: Fixed (BinBase 2))
              @?= (Nothing)
        ]
    ]
  where
    initialStorageDec =
      (1.1 :: Fixed (DecBase 3), 1.1 :: Fixed (DecBase 3))

    initialStorageBin =
      (1.1 :: Fixed (BinBase 1), 1.1 :: Fixed (BinBase 1))

test_NFixedArith :: TestTree
test_NFixedArith =
  testGroup "Arithmetic operations on NFixed values"
    [ testGroup "NFixed to Fixed"
        [ testCase "Cast NFixed to Fixed 1" do
            castNFixedToFixed -$ (1.23456 :: NFixed (DecBase 6))
              @?= (1.23456 :: Fixed (DecBase 6))
        , testCase "Cast NFixed to Fixed 2" do
            castNFixedToFixed -$ (0 :: NFixed (DecBase 6))
              @?= (0 :: Fixed (DecBase 6))
        , testCase "Cast NFixed to Fixed 3" do
            castNFixedToFixed -$ (0.12 :: NFixed (DecBase 2))
              @?= (0.12 :: Fixed (DecBase 2))
        ]
    , testGroup "Fixed to NFixed"
        [ testCase "Cast Fixed to NFixed 1" do
            castFixedToNFixed -$ (1.23456 :: Fixed (DecBase 6))
              @?= Just (1.23456 :: NFixed (DecBase 6))
        , testCase "Cast Fixed to NFixed 2" do
            castFixedToNFixed -$ (0 :: Fixed (DecBase 6))
              @?= Just (0 :: NFixed (DecBase 6))
        , testCase "Cast Fixed to NFixed 3" do
            castFixedToNFixed -$ (0.12 :: Fixed (DecBase 2))
              @?= Just (0.12 :: NFixed (DecBase 2))
        ]
    , testGroup "Decimal base"
        [ testCase "NFixed add" do
            add -$ initialStorageDec
              @?= (2.2 :: NFixed (DecBase 3))
        , testCase "NFixed sub" do
            sub -$ initialStorageDec
              @?= (0 :: Fixed (DecBase 3))
        , testCase "NFixed mul" do
            mul -$ initialStorageDec
              @?= (1.21 :: NFixed (DecBase 6))
        , testCase "NFixed ediv 1" do
            ediv -$ (123.456 :: NFixed (DecBase 3), 100 :: Integer)
              @?= Just (1, 23.456 :: (NFixed (DecBase 3)))
        , testCase "NFixed ediv 2" do
            ediv -$ (2 :: NFixed (DecBase 3), 100 :: Integer)
              @?= Just (0, 2 :: (NFixed (DecBase 3)))
        ]
    , testGroup "Binary base"
        [ testCase "NFixed add" do
            add -$ initialStorageBin
              @?= (2.2 :: NFixed (BinBase 1))
        , testCase "NFixed sub" do
            sub -$ initialStorageBin
              @?= (0 :: Fixed (BinBase 1))
        , testCase "NFixed mul" do
            mul -$ initialStorageBin
              @?= (1.21 :: NFixed (BinBase 2))
        ]
    , testGroup "Rounding"
        [ testGroup "Rounding with decimal base"
            [ testCase "Round up NFixed with decimal base 1" do
                round_ -$ (1.23456 :: (NFixed (DecBase 6)))
                  @?= (1.235 :: NFixed (DecBase 3))
            , testCase "Round up NFixed with decimal base 2" do
                round_ -$ (1.23446 :: (NFixed (DecBase 6)))
                  @?= (1.234 :: NFixed (DecBase 3))
            , testCase "Round up NFixed with decimal base 3" do
                round_ -$ (0.177 :: (NFixed (DecBase 3)))
                  @?= (0.18 :: NFixed (DecBase 2))
            , testCase "Round up NFixed with decimal base 4" do
                round_ -$ (0.173 :: (NFixed (DecBase 3)))
                  @?= (0.17 :: NFixed (DecBase 2))
            , testCase "Round up NFixed with decimal base 5" do
                round_ -$ (1.230 :: (NFixed (DecBase 3)))
                  @?= (1.23 :: NFixed (DecBase 2))
            , testCase "Ceil 1" do
                ceil_ -$ (0.177 :: (NFixed (DecBase 3)))
                  @?= (0.18 :: NFixed (DecBase 2))
            , testCase "Ceil 2" do
                ceil_ -$ (0.173 :: (NFixed (DecBase 3)))
                  @?= (0.18 :: NFixed (DecBase 2))
            , testCase "Ceil 3" do
                ceil_ -$ (1.230 :: (NFixed (DecBase 3)))
                  @?= (1.23 :: NFixed (DecBase 2))
            , testCase "Floor 1" do
                floor_ -$ (0.177 :: (NFixed (DecBase 3)))
                  @?= (0.17 :: NFixed (DecBase 2))
            , testCase "Floor 2" do
                floor_ -$ (0.173 :: (NFixed (DecBase 3)))
                  @?= (0.17 :: NFixed (DecBase 2))
            , testCase "Floor 3" do
                floor_ -$ (1.230 :: (NFixed (DecBase 3)))
                  @?= (1.23 :: NFixed (DecBase 2))
            , testCase "Round down" do
                round_ -$ (1.234 :: NFixed (DecBase 3))
                  @?= (1.23400 :: (NFixed (DecBase 6)))
            ]
        , testGroup "Rounding with Binary Base"
            [ testCase "Round NFixed with binary base" do
                round_ -$ (0x1.23456 :: (NFixed (BinBase 6)))
                  @?= (0x1.235 :: NFixed (BinBase 3))
            , testCase "Ceil 1" do
                ceil_ -$ (0x0.177 :: (NFixed (BinBase 3)))
                  @?= (0x0.18 :: NFixed (BinBase 2))
            , testCase "Ceil 2" do
                ceil_ -$ (0x0.173 :: (NFixed (BinBase 3)))
                  @?= (0x0.18 :: NFixed (BinBase 2))
            , testCase "Ceil 3" do
                ceil_ -$ (0x1.230 :: (NFixed (BinBase 12)))
                  @?= (0x1.23 :: NFixed (BinBase 8))
            , testCase "Floor 1" do
                floor_ -$ (0x0.177 :: (NFixed (BinBase 3)))
                  @?= (0x0.17 :: NFixed (BinBase 2))
            , testCase "Floor 2" do
                floor_ -$ (0x0.173 :: (NFixed (BinBase 3)))
                  @?= (0x0.17 :: NFixed (BinBase 2))
            , testCase "Floor 3" do
                floor_ -$ (0x1.230 :: (NFixed (BinBase 3)))
                  @?= (0x1.23 :: NFixed (BinBase 2))
            ]
        , testGroup "Casts"
          [ testCase "Cast to Integer" do
              fromFixed @(NFixed (DecBase 6)) -$ (1.23456 :: (NFixed (DecBase 6)))
                @?= 1
          , testCase "Cast Integer to NFixed" do
              toFixed @(NFixed (DecBase 6)) -$ (123456 :: Integer)
                @?= (123456 :: (NFixed (DecBase 6)))
          , testCase "Cast to Integer (Binary base)" do
              fromFixed @(NFixed (BinBase 6)) -$ (1.23456 :: (NFixed (BinBase 6)))
                @?= 1
          , testCase "Cast Integer to NFixed (Binary base)" do
              toFixed @(NFixed (BinBase 6)) -$ (123456 :: Integer)
                @?= (123456 :: (NFixed (BinBase 6)))
          ]
        ]
    , testGroup "Division"
        [ testCase "Divide big NFixed(Dec) to small NFixed(Dec)" do
            div @(Maybe (NFixed (DecBase 8))) -$ (625.123 :: NFixed (DecBase 3), 123.23 :: NFixed (DecBase 2))
              @?= Just (5.07281506 :: NFixed (DecBase 8))
        , testCase "Divide small NFixed(Dec) to big NFixed(Dec)" do
            div @(Maybe (NFixed (DecBase 8))) -$ (123.23 :: NFixed (DecBase 3), 625.123 :: NFixed (DecBase 2))
              @?= Just (0.19713015 :: NFixed (DecBase 8))
        , testCase "Divide big NFixed(Bin) to small NFixed(Bin)" do
            div @(Maybe (NFixed (BinBase 8))) -$ (625.123 :: NFixed (BinBase 3), 123.23 :: NFixed (BinBase 2))
              @?= (Just (5.079 :: NFixed (BinBase 8)))
        , testCase "Divide small NFixed(Bin) to big NFixed(Bin)" do
            div @(Maybe (NFixed (BinBase 8))) -$ (123.23 :: NFixed (BinBase 3), 625.123 :: NFixed (BinBase 2))
              @?= (Just (0.19713015 :: NFixed (BinBase 8)))
        , testCase "Divide by zero" do
            div @(Maybe (NFixed (BinBase 8))) -$ (123.23 :: NFixed (BinBase 3), 0 :: NFixed (BinBase 2))
              @?= (Nothing)
        ]
    ]
  where
    initialStorageDec =
      (1.1 :: NFixed (DecBase 3), 1.1 :: NFixed (DecBase 3))

    initialStorageBin =
      (1.1 :: NFixed (BinBase 1), 1.1 :: NFixed (BinBase 1))