STRef.hs

-- SPDX-FileCopyrightText: Copyright Preetham Gujjula
-- SPDX-License-Identifier: BSD-3-Clause

module Test.Data.DoublyLinkedList.STRef (tests) where

import Control.Monad (void)
import Control.Monad.ST (runST)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.DoublyLinkedList.STRef
  ( cons,
    delete,
    empty,
    fromList,
    head,
    last,
    next,
    null,
    toList,
    value,
  )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.ExpectedFailure (ignoreTest)
import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))
import Prelude hiding (head, last, null)

tests :: TestTree
tests =
  testGroup
    "Data.DoublyLinkedList.STRef"
    [ constructionTests,
      traversalTests,
      queryTests,
      insertionTests,
      deletionTests,
      listConversionTests,
      integrationTests
    ]

unimplemented :: Assertion
unimplemented = assertFailure "unimplemented"

-- Construction
constructionTests :: TestTree
constructionTests =
  testGroup
    "Construction"
    [ emptyTests,
      fromListTests
    ]

emptyTests :: TestTree
emptyTests = testCase "empty" (pure ())

fromListTests :: TestTree
fromListTests = testCase "fromList" (pure ())

-- Traversal
traversalTests :: TestTree
traversalTests =
  testGroup "Traversal" [headTests, lastTests, nextTests, prevTests]

headTests :: TestTree
headTests =
  testGroup
    "head"
    [ testCase "head of empty list" $ do
        -- Construct empty list using empty
        let firstNodeValue1 :: Maybe Int
            firstNodeValue1 = runST $ do
              list <- empty
              firstNode <- head list
              pure (value <$> firstNode)
        firstNodeValue1 @?= Nothing

        -- Construct empty list using fromList
        let firstNodeValue2 :: Maybe Int
            firstNodeValue2 = runST $ do
              list <- fromList []
              firstNode <- head list
              pure (value <$> firstNode)
        firstNodeValue2 @?= Nothing,
      testCase "head of non-empty lists" $ do
        let firstNodeValue1 :: Maybe Int
            firstNodeValue1 = runST $ do
              list <- fromList [1]
              firstNode <- head list
              pure (value <$> firstNode)
        firstNodeValue1 @?= Just 1
        let firstNodeValue2 :: Maybe Int
            firstNodeValue2 = runST $ do
              list <- fromList [2, 1]
              firstNode <- head list
              pure (value <$> firstNode)
        firstNodeValue2 @?= Just 2
        let firstNodeValue3 :: Maybe Int
            firstNodeValue3 = runST $ do
              list <- fromList [3, 2, 1]
              firstNode <- head list
              pure (value <$> firstNode)
        firstNodeValue3 @?= Just 3
    ]

lastTests :: TestTree
lastTests =
  testGroup
    "last"
    [ testCase "last of empty list" $ do
        -- Construct empty list using empty
        let lastNodeValue1 :: Maybe Int
            lastNodeValue1 = runST $ do
              list <- empty
              lastNode <- last list
              pure (value <$> lastNode)
        lastNodeValue1 @?= Nothing

        -- Construct empty list using fromList
        let lastNodeValue2 :: Maybe Int
            lastNodeValue2 = runST $ do
              list <- fromList []
              lastNode <- last list
              pure (value <$> lastNode)
        lastNodeValue2 @?= Nothing,
      testCase "last of non-empty lists" $ do
        let lastNodeValue1 :: Maybe Int
            lastNodeValue1 = runST $ do
              list <- fromList [1]
              lastNode <- last list
              pure (value <$> lastNode)
        lastNodeValue1 @?= Just 1
        let lastNodeValue2 :: Maybe Int
            lastNodeValue2 = runST $ do
              list <- fromList [1, 2]
              lastNode <- last list
              pure (value <$> lastNode)
        lastNodeValue2 @?= Just 2
        let lastNodeValue3 :: Maybe Int
            lastNodeValue3 = runST $ do
              list <- fromList [1, 2, 3]
              lastNode <- last list
              pure (value <$> lastNode)
        lastNodeValue3 @?= Just 3
    ]

nextTests :: TestTree
nextTests =
  ignoreTest $
    testGroup
      "next"
      [ testCase "next on empty list" unimplemented,
        testCase "next on [1]" unimplemented,
        testCase "next on [3, 2, 1]" unimplemented,
        testCase "next on [1, 1, 1, 1, 1]" unimplemented
      ]

prevTests :: TestTree
prevTests =
  ignoreTest $
    testGroup
      "prev"
      [ testCase "prev on empty list" unimplemented,
        testCase "prev on [1]" unimplemented,
        testCase "prev on [3, 2, 1]" unimplemented,
        testCase "prev on [1, 1, 1, 1, 1]" unimplemented
      ]

-- Query
queryTests :: TestTree
queryTests = testGroup "Query" [nullTests, valueTests]

nullTests :: TestTree
nullTests =
  testGroup
    "null"
    [ testCase "null of empty list" $ do
        -- Construct empty list using empty
        let isNull1 :: Bool
            isNull1 = runST (empty >>= null)
        assertBool "empty list is null" isNull1

        -- Construct empty list using fromList
        let isNull2 :: Bool
            isNull2 = runST (fromList [] >>= null)
        assertBool "empty list is null" isNull2,
      testCase "null of non-empty list" $ do
        let isNull1 :: Bool
            isNull1 = runST (fromList [1 :: Int] >>= null)
        assertBool "non-empty list is not null" (not isNull1)
        let isNull2 :: Bool
            isNull2 = runST (fromList [1 :: Int, 2] >>= null)
        assertBool "non-empty list is not null" (not isNull2)
        let isNull3 :: Bool
            isNull3 = runST (fromList [1 :: Int, 2, 3] >>= null)
        assertBool "non-empty list is not null" (not isNull3)
    ]

valueTests :: TestTree
valueTests = testCase "value" (pure ())

-- Insertion
insertionTests :: TestTree
insertionTests =
  testGroup
    "Insertion"
    [ consTests,
      snocTests,
      insertBeforeTests,
      insertAfterTests,
      insertBeforeAfterTests
    ]

consTests :: TestTree
consTests =
  testGroup
    "cons"
    [ testCase "Create [1] with cons" $
        let xs :: [Int]
            xs = runST $ do
              ys <- empty
              void (cons ys 1)
              toList ys
         in xs @?= [1],
      testCase "Create [1, 2] with cons" $
        let xs :: [Int]
            xs = runST $ do
              ys <- empty
              void (cons ys 2)
              void (cons ys 1)
              toList ys
         in xs @?= [1, 2],
      testCase "Create [1, 2, 3] with cons" $
        let xs :: [Int]
            xs = runST $ do
              ys <- empty
              void (cons ys 3)
              void (cons ys 2)
              void (cons ys 1)
              toList ys
         in xs @?= [1, 2, 3]
    ]

snocTests :: TestTree
snocTests =
  testGroup
    "snoc"
    [ ignoreTest $ testCase "Create [1] with snoc" unimplemented,
      ignoreTest $ testCase "Create [1, 2] with snoc" unimplemented,
      ignoreTest $ testCase "Create [1, 2, 3] with snoc" unimplemented
    ]

insertBeforeTests :: TestTree
insertBeforeTests =
  testGroup
    "insertBefore"
    [ ignoreTest $ testCase "Create [1, 0] with insertBefore" unimplemented,
      ignoreTest $ testCase "Create [1, 2, 0] with insertBefore" unimplemented,
      ignoreTest $
        testCase "Create [1, 2, 3, 0] with insertBefore" unimplemented
    ]

insertAfterTests :: TestTree
insertAfterTests =
  testGroup
    "insertAfter"
    [ ignoreTest $ testCase "Create [0, 1] with insertAfter" unimplemented,
      ignoreTest $ testCase "Create [0, 1, 2] with insertAfter" unimplemented,
      ignoreTest $ testCase "Create [0, 1, 2, 3] with insertAfter" unimplemented
    ]

insertBeforeAfterTests :: TestTree
insertBeforeAfterTests =
  testGroup
    "insertBefore and insertAfter"
    [ ignoreTest $
        testCase
          "Create [-1, 0, 1] with insertBefore and insertAfter"
          unimplemented,
      ignoreTest $
        testCase
          "Create [-2, -1, 0, 1, 2] with insertBefore and insertAfter"
          unimplemented,
      ignoreTest $
        testCase
          "Create [-3, -2, -1, 0, 1, 2, 3] with insertBefore and insertAfter"
          unimplemented
    ]

-- Deletion
deletionTests :: TestTree
deletionTests = testGroup "Deletion" [deleteTests]

deleteTests :: TestTree
deleteTests =
  testGroup
    "delete"
    [ testCase "Turn [-2, -1, 0, 1, 2] -> [-2, -1, 1, 2] using delete" $ do
        let xs :: Maybe [Int]
            xs = runST $ runMaybeT $ do
              dllist <- lift $ fromList [-2 .. 2]
              node1 <- MaybeT $ head dllist
              node2 <- MaybeT $ next node1
              node3 <- MaybeT $ next node2
              lift (delete node3)
              lift (toList dllist)
         in xs @?= Just [-2, -1, 1, 2],
      testCase "Turn [1, 2, 3, 4, 5, 6] -> [2, 4, 6] using delete" $
        let xs :: Maybe [Int]
            xs = runST $ runMaybeT $ do
              dlist <- lift $ fromList [1 .. 6]
              node1 <- MaybeT (head dlist)
              lift (delete node1)
              node2 <- MaybeT (next node1)
              node3 <- MaybeT (next node2)
              node4 <- MaybeT (next node3)
              lift (delete node3)
              node5 <- MaybeT (next node4)
              lift (delete node5)
              lift (toList dlist)
         in xs @?= Just [2, 4, 6]
    ]

-- List conversion
listConversionTests :: TestTree
listConversionTests = testGroup "List conversion" [toListTests]

toListTests :: TestTree
toListTests = testCase "toList" (pure ())

-- Integration
integrationTests :: TestTree
integrationTests = ignoreTest $ testCase "Integration" unimplemented