dfinity-radix-tree-0.5.0: test/Units.hs

{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS -Wall #-}
{-# OPTIONS -Werror #-}

module Units
   ( tests
   ) where

import Control.Arrow (first)
import Control.Monad (foldM_, void)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.State.Strict (StateT, runStateT)
import Data.Aeson (eitherDecode)
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Lazy.Char8 as Lazy (readFile)
import Data.ByteString.Short (fromShort)
import Data.HashMap.Strict (toList)
import Data.Map.Strict (Map, empty)
import Data.Maybe (fromJust)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertFailure, testCase)

import DFINITY.RadixTree
import Types

tests :: IO TestTree
tests = do
   contents <- Lazy.readFile "test/tests.json"
   vectors <- either fail return $ eitherDecode contents
   pure $ testGroup "units"
      [testCase name $ run ops | (name, ops) <- toList vectors]

run :: [Op] -> IO ()
run ops = void $ flip runStateT empty $ do
   tree <- createRadixTree 262144 2048 Nothing ()
   foldM_ step tree ops

step :: RadixTree () -> Op -> StateT (Map ByteString ByteString) IO (RadixTree ())
step tree op = do
   liftIO $ print op
   case op of
      Insert key value -> do
         tree' <- insertRadixTree key value tree
         printRadixTree tree'
         pure tree'
      Delete key -> do
         tree' <- deleteRadixTree key tree
         printRadixTree tree'
         pure tree'
      Lookup key value -> do
         result <- lookupRadixTree key tree
         case result of
            Nothing | value == Nothing -> pure tree
            Nothing -> throw
               ["Expecting value ", ", but received no value for key "]
               [fromJust value, key]
            Just (value', tree') | value == Just value' -> pure tree'
            Just (value', _) -> throw
               ["Expecting value ", ", but received value ", " for key "]
               [maybe "null" id value, value', key]
      Merkleize value -> do
         (value', tree') <- first fromShort <$> merkleizeRadixTree tree
         if value == value'
         then pure tree'
         else throw
            ["Expecting state root ", ", but received state root "]
            [value, value']

throw :: MonadIO m => [String] -> [ByteString] -> m a
throw err = liftIO . assertFailure . concat . zipWith mappend err . map show