test/Strict.hs

   1 {-# LANGUAGE NamedFieldPuns #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE TupleSections #-}
   5 module Strict where
   6
   7 import Data.Function (($), id, const)
   8 import Data.Int (Int)
   9 import qualified Data.Map.Strict as Map
  10 import Data.Monoid ((<>))
  11 import qualified Data.Strict.Maybe as Strict
  12 import Prelude (Integer, undefined)
  13 import Test.Tasty
  14 import Test.Tasty.HUnit
  15
  16 import Data.TreeMap.Strict ((<|))
  17 import Data.TreeMap.Strict (TreeMap(..))
  18 import qualified Data.TreeMap.Strict as TreeMap
  19
  20
  21 tests :: TestTree
  22 tests = testGroup "Strict"
  23  [ testGroup "insert"
  24          [ testCase "[] 0" $
  25                         TreeMap.insert const ((0::Int)<|[]) () TreeMap.empty
  26                  @?= (TreeMap $ Map.fromList [ (0::Int, TreeMap.leaf ()) ])
  27          , testCase "[] 0/1" $
  28                         TreeMap.insert const ((0::Int)<|[1]) () TreeMap.empty
  29                  @?=
  30                         (TreeMap $
  31                         Map.fromList
  32                          [ (0::Int, TreeMap.Node
  33                                  { TreeMap.node_value = Strict.Nothing
  34                                  , TreeMap.node_size = 1
  35                                  , TreeMap.node_descendants =
  36                                         TreeMap.singleton ((1::Int)<|[]) ()
  37                                  })
  38                          ])
  39          ]
  40  , testGroup "mapByDepthFirst"
  41          [ testCase "[0, 0/1, 0/1/2, 1, 1/2/3]" $
  42                         TreeMap.mapByDepthFirst
  43                          (\descendants value ->
  44                                 Map.foldl'
  45                                  (\acc v -> (<>) acc $
  46                                         Strict.fromMaybe undefined $
  47                                         TreeMap.node_value v
  48                                  )
  49                                  (Strict.fromMaybe [] value)
  50                                  (TreeMap.nodes descendants)
  51                          )
  52                         (TreeMap.fromList const
  53                          [ ((0::Integer)<|[], [0::Integer])
  54                          , (0<|[1], [0,1])
  55                          , (0<|[1,2], [0,1,2])
  56                          , (1<|[], [1])
  57                          , (1<|[2,3], [1,2,3])
  58                          ])
  59                  @?=
  60                         TreeMap.fromList const
  61                          [ ((0::Integer)<|[], [0,0,1,0,1,2])
  62                          , (0<|[1], [0,1,0,1,2])
  63                          , (0<|[1,2], [0,1,2])
  64                          , (1<|[], [1,1,2,3])
  65                          , (1<|[2], [1,2,3])
  66                          , (1<|[2,3], [1,2,3])
  67                          ]
  68          , testCase "[0/0]" $
  69                         TreeMap.mapByDepthFirst
  70                          (\descendants value ->
  71                                 Map.foldl'
  72                                  (\acc v -> (<>) acc $
  73                                         Strict.fromMaybe undefined $
  74                                         TreeMap.node_value v
  75                                  )
  76                                  (Strict.fromMaybe [] value)
  77                                  (TreeMap.nodes descendants)
  78                          )
  79                         (TreeMap.fromList const
  80                          [ ((0::Integer)<|[0], [0::Integer,0])
  81                          ])
  82                  @?=
  83                         TreeMap.fromList const
  84                          [ ((0::Integer)<|[], [0,0])
  85                          , (0<|[0], [0,0])
  86                          ]
  87          ]
  88  , testGroup "flatten"
  89          [ testCase "[0, 0/1, 0/1/2]" $
  90                         TreeMap.flatten id
  91                         (TreeMap.fromList const
  92                          [ ((0::Integer)<|[], ())
  93                          , (0<|[1], ())
  94                          , (0<|[1,2], ())
  95                          ])
  96                  @?=
  97                         Map.fromList
  98                          [ ((0::Integer)<|[], ())
  99                          , (0<|[1], ())
 100                          , (0<|[1,2], ())
 101                          ]
 102          , testCase "[1, 1/2, 1/22, 1/2/3, 1/2/33, 11, 11/2, 11/2/3, 11/2/33]" $
 103                         TreeMap.flatten id
 104                         (TreeMap.fromList const
 105                          [ ((1::Integer)<|[], ())
 106                          , (1<|[2], ())
 107                          , (1<|[22], ())
 108                          , (1<|[2,3], ())
 109                          , (1<|[2,33], ())
 110                          , (11<|[], ())
 111                          , (11<|[2], ())
 112                          , (11<|[2,3], ())
 113                          , (11<|[2,33], ())
 114                          ])
 115                  @?=
 116                         Map.fromList
 117                          [ ((1::Integer)<|[], ())
 118                          , (1<|[2], ())
 119                          , (1<|[22], ())
 120                          , (1<|[2,3], ())
 121                          , (1<|[2,33], ())
 122                          , (11<|[], ())
 123                          , (11<|[2], ())
 124                          , (11<|[2,3], ())
 125                          , (11<|[2,33], ())
 126                          ]
 127          ]
 128  , testGroup "lookupAlong"
 129          [ testCase "0/1/2/3 [0, 0/1, 0/1/2, 0/1/2/3]" $
 130                         TreeMap.lookupAlong
 131                          (0<|[1,2,3])
 132                         (TreeMap.fromList const
 133                          [ ((0::Integer)<|[], [0])
 134                          , (0<|[1], [0,1])
 135                          , (0<|[1,2], [0,1,2])
 136                          , (0<|[1,2,3], [0,1,2,3])
 137                          ])
 138                  @?=
 139                         [ [0::Integer]
 140                         , [0,1]
 141                         , [0,1,2]
 142                         , [0,1,2,3]
 143                         ]
 144          , testCase "0/1/2/3 [0, 0/1]" $
 145                         TreeMap.lookupAlong
 146                          (0<|[1,2,3])
 147                         (TreeMap.fromList const
 148                          [ ((0::Integer)<|[], [0])
 149                          , (0<|[1], [0,1])
 150                          ])
 151                  @?=
 152                         [ [0::Integer]
 153                         , [0,1]
 154                         ]
 155          ]
 156  ]