bower-json-0.4.0.0: test/Main.hs

{-# LANGUAGE OverloadedStrings #-}

import Test.Tasty
import Test.Tasty.HUnit

import Control.Monad
import Data.Monoid
import Data.Aeson
import Data.Maybe
import qualified Data.ByteString.Lazy as B

import Web.BowerJson

-- Decode any JSON value, not just arrays/objects.
-- this is a bit of a hack, but the 'proper' way is just too much effort.
decodeValue :: FromJSON a => B.ByteString -> Maybe a
decodeValue = the <=< decode . ("[" <>) . (<> "]")
  where
  the [x] = Just x
  the _ = Nothing

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "tests"
  [ testGroup "FromJSON Author instance" authorTests
  , testGroup "optional keys" optionalKeyTests
  , testGroup "round trips" roundTripTests
  ]

authorTests :: [TestTree]
authorTests =
  [ testCase "As string without homepage/email" $ do
      Just authorWithoutOptionalAttrs @=?
        decodeValue "\"Harry Garrood\""

      -- should not be sensitive to extra whitespace
      Just authorWithoutOptionalAttrs @=?
        decodeValue "\" Harry Garrood \""

  , testCase "As string with homepage/email" $ do
      Just authorWithEmail @=?
        decodeValue "\"Harry Garrood <harry@garrood.me>\""

      Just authorWithHomepage @=?
        decodeValue "\"Harry Garrood (http://harry.garrood.me)\""

      Just authorWithBoth @=?
        decodeValue "\"Harry Garrood <harry@garrood.me> (http://harry.garrood.me)\""

  , testCase "As object" $ do
      Just authorWithoutOptionalAttrs @=?
        decode "{\"name\": \"Harry Garrood\"}"

      Just authorWithEmail @=?
        decode "{\"name\": \"Harry Garrood\", \"email\": \"harry@garrood.me\"}"

      Just authorWithHomepage @=?
        decode "{\"name\": \"Harry Garrood\", \"homepage\": \"http://harry.garrood.me\"}"

      Just authorWithBoth @=?
        decode "{\"name\": \"Harry Garrood\", \"email\": \"harry@garrood.me\", \"homepage\": \"http://harry.garrood.me\"}"
  ]

authorWithoutOptionalAttrs = Author "Harry Garrood" Nothing Nothing
authorWithEmail = Author "Harry Garrood" (Just "harry@garrood.me") Nothing
authorWithHomepage = Author "Harry Garrood" Nothing (Just "http://harry.garrood.me")
authorWithBoth = Author "Harry Garrood" (Just "harry@garrood.me") (Just "http://harry.garrood.me")

optionalKeyTests :: [TestTree]
optionalKeyTests =
  [ testCase "Missing keys should become empty lists, missing private key means not private" $ do
      Just basic @=? decode "{\"name\": \"test-package\"}"

  , testCase "Empty objects should turn into empty lists" $ do
      Just basic @=? decode "{\"name\": \"test-package\", \"dependencies\": {}}"

  , testCase "Nonempty objects should be parsed" $ do
      Just basicWithDeps @=?
        decode "{\"name\": \"test-package\", \"dependencies\": {\"dependency-package\": \">= 1.0\"}}"

  , testCase "Empty arrays should be parsed as empty lists" $ do
      Just basic @=? decode "{\"name\": \"test-package\", \"main\": []}"

  , testCase "Arrays with values should be parsed" $ do
      Just basicWithModuleType @=?
        decode "{\"name\": \"test-package\", \"moduleType\": [\"amd\"]}"
  ]
  where

pkgName = fromJust (mkPackageName "test-package")
depPkgName = fromJust (mkPackageName "dependency-package")
basic = BowerJson pkgName Nothing [] [] [] [] [] [] Nothing Nothing [] [] [] False
basicWithDeps = basic { bowerDependencies = [(depPkgName, VersionRange ">= 1.0")] }
basicWithModuleType = basic { bowerModuleType = [AMD] }

complex =
  basicWithDeps
    { bowerDescription     = Just "hello, world"
    , bowerMain            = ["foo.js"]
    , bowerModuleType      = [Globals, Node]
    , bowerLicence         = ["MIT"]
    , bowerIgnore          = []
    , bowerKeywords        = ["purescript"]
    , bowerAuthors         = [authorWithoutOptionalAttrs, authorWithEmail, authorWithBoth]
    , bowerHomepage        = Nothing
    , bowerRepository      = Just (Repository "git://github.com/hdgarrood/test-package" "git")
    , bowerDevDependencies = []
    , bowerResolutions     = []
    }

complexPrivate = complex { bowerPrivate = True }

allBowerJsons =
  [ ("basic", basic)
  , ("basicWithDeps", basicWithDeps)
  , ("basicWithModuleType", basicWithModuleType)
  , ("complex", complex)
  , ("complexPrivate", complexPrivate)
  ]

roundTripTests :: [TestTree]
roundTripTests =
  map (\(name, b) -> testCase name (Just b @=? decode (encode b)))
      allBowerJsons