Spec.purs 5.21 KB
Newer Older
1 2
module Gargantext.Utils.Spec where

3
import Data.Argonaut as Argonaut
4
import Data.Argonaut.Decode.Error (JsonDecodeError)
5 6
import Data.Either (Either(..), isLeft)
import Data.Generic.Rep (class Generic)
7
import Data.Show.Generic (genericShow)
8 9 10 11 12
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)

import Gargantext.Prelude

13
import Gargantext.Utils as GU
14
import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson)
15
import Gargantext.Utils.Array as GUA
16
import Gargantext.Utils.Crypto as Crypto
17
import Gargantext.Utils.Math as GUM
18 19 20 21 22 23

data Fruit
  = Boat { hi :: Int }
  | Gravy String
  | Pork Int

24 25 26
derive instance Eq Fruit
derive instance Generic Fruit _
instance Show Fruit where
27
  show = genericShow
28
instance Argonaut.DecodeJson Fruit where
29
  decodeJson = genericSumDecodeJson
30
instance Argonaut.EncodeJson Fruit where
31
  encodeJson = genericSumEncodeJson
32

33 34 35 36 37
data EnumTest
  = Member1
  | Member2
  | Member3

38 39 40
derive instance Eq EnumTest
derive instance Generic EnumTest _
instance Show EnumTest where
41
  show = genericShow
42
instance Argonaut.DecodeJson EnumTest where
43
  decodeJson = genericEnumDecodeJson
44
instance Argonaut.EncodeJson EnumTest where
45 46
  encodeJson = genericEnumEncodeJson

47 48 49 50
spec :: Spec Unit
spec =
  describe "G.Utils" do
    it "zeroPad 1 works" do
51 52 53
      GU.zeroPad 1 0 `shouldEqual` "0"
      GU.zeroPad 1 1 `shouldEqual` "1"
      GU.zeroPad 1 10 `shouldEqual` "10"
54
    it "zeroPad 2 works" do
55 56 57 58
      GU.zeroPad 2 0 `shouldEqual` "00"
      GU.zeroPad 2 1 `shouldEqual` "01"
      GU.zeroPad 2 10 `shouldEqual` "10"
      GU.zeroPad 2 100 `shouldEqual` "100"
59
    it "zeroPad 3 works" do
60 61 62 63 64 65 66
      GU.zeroPad 3 0 `shouldEqual` "000"
      GU.zeroPad 3 1 `shouldEqual` "001"
      GU.zeroPad 3 10 `shouldEqual` "010"
      GU.zeroPad 3 99 `shouldEqual` "099"
      GU.zeroPad 3 100 `shouldEqual` "100"
      GU.zeroPad 3 101 `shouldEqual` "101"
      GU.zeroPad 3 1000 `shouldEqual` "1000"
67
    it "log10 10" do
68
      GUM.log10 10.0 `shouldEqual` 1.0
69 70

    it "genericSumDecodeJson works" do
71
      let result1 = Argonaut.decodeJson =<< Argonaut.parseJson """{"Boat":{"hi":1}}"""
72 73
      result1 `shouldEqual` Right (Boat { hi: 1 })

74
      let result2 = Argonaut.decodeJson =<< Argonaut.parseJson """{"Gravy":"hi"}"""
75 76
      result2 `shouldEqual` Right (Gravy "hi")

77 78
      let result3 = Argonaut.decodeJson =<< Argonaut.parseJson """{"Boat":123}"""
      isLeft (result3 :: Either JsonDecodeError Fruit) `shouldEqual` true
79 80 81 82 83 84 85 86 87 88 89 90 91

    it "genericSumEncodeJson works and loops back with decode" do
      let input1 = Boat { hi: 1 }
      let result1 = Argonaut.encodeJson input1
      let result1' = Argonaut.decodeJson result1
      Argonaut.stringify result1 `shouldEqual` """{"Boat":{"hi":1}}"""
      result1' `shouldEqual` Right input1

      let input2 = Gravy "hi"
      let result2 = Argonaut.encodeJson input2
      let result2' = Argonaut.decodeJson result2
      Argonaut.stringify result2 `shouldEqual` """{"Gravy":"hi"}"""
      result2' `shouldEqual` Right input2
92 93

    it "genericEnumDecodeJson works" do
94
      let result1 = Argonaut.decodeJson =<< Argonaut.parseJson "\"Member1\""
95 96
      result1 `shouldEqual` Right Member1

97
      let result2 = Argonaut.decodeJson =<< Argonaut.parseJson "\"Member2\""
98 99
      result2 `shouldEqual` Right Member2

100 101
      let result3 = Argonaut.decodeJson =<< Argonaut.parseJson "\"Failure\""
      isLeft (result3 :: Either JsonDecodeError EnumTest) `shouldEqual` true
102 103 104 105 106 107 108 109 110 111 112 113 114

    it "genericSumEncodeJson works and loops back with decode" do
      let input1 = Member1
      let result1 = Argonaut.encodeJson input1
      let result1' = Argonaut.decodeJson result1
      Argonaut.stringify result1 `shouldEqual` "\"Member1\""
      result1' `shouldEqual` Right input1

      let input2 = Member2
      let result2 = Argonaut.encodeJson input2
      let result2' = Argonaut.decodeJson result2
      Argonaut.stringify result2 `shouldEqual` "\"Member2\""
      result2' `shouldEqual` Right input2
115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136

------------------------------------------------------------------------
-- | Crypto Hash tests
    it "Hash String with backend works" do
      let text = "To hash with backend"
      let hashed = "8a69a94d164279af2b7d1443ce08da6184b3d7e815406076e148159c284b53c3"
                   -- ^ hash from backend with text above
      Crypto.hash text `shouldEqual` hashed

    it "Hash List with backend works" do
      let list = ["a","b"]
      let hashed = "ab19ec537f09499b26f0f62eed7aefad46ab9f498e06a7328ce8e8ef90da6d86"
                   -- ^ hash from backend with text above
      Crypto.hash list `shouldEqual` hashed

------------------------------------------------------------------------
-- | TODO property based tests
    it "Hash works with any order of list" do
      let hash1 = Crypto.hash ["a","b"]
      let hash2 = Crypto.hash ["b","a"]
      hash1 `shouldEqual` hash2

137 138 139 140 141 142 143 144
------------------------------------------------------------------------
-- | Gargantext.Utils.Array tests
    it "G.U.Array.range works correctly (include endpoint)" do
      GUA.range 0 10 2 `shouldEqual` [0, 2, 4, 6, 8, 10]
      GUA.range 0 10 5 `shouldEqual` [0, 5, 10]
    it "G.U.Array.range works correctly (no endpoint)" do
      GUA.range 0 11 2 `shouldEqual` [0, 2, 4, 6, 8, 10]
      GUA.range 0 11 5 `shouldEqual` [0, 5, 10]