yarn-lock-0.5.0: tests/TestParse.hs

{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, NamedFieldPuns, ViewPatterns, NoImplicitPrelude #-}
module TestParse (tests) where

import Protolude
import qualified Data.Map as Map
import qualified Data.List.NonEmpty as NE
import Test.Tasty (TestTree)
import Test.Tasty.TH
import Test.Tasty.HUnit
import NeatInterpolation
import qualified Text.Megaparsec as MP
import qualified Data.Char as Ch

import Yarn.Lock.Types
import Yarn.Lock.Parse

startComment :: Text
startComment = [text|
  # THIS IS AN AUTOGENERATED FILE. DO NOT EDIT THIS FILE DIRECTLY.
  # yarn lockfile v1
  dummy-package@foo:
    version: foo
  |]

case_startCommentEmptyPackageList :: Assertion
case_startCommentEmptyPackageList = do
  parseSuccess packageList startComment
    >>= \((Keyed keys _) : _) -> do
      assertBool "only foo"
        (keys == pure (PackageKey (SimplePackageKey "dummy-package") "foo"))

-- registryPackage :: Text
-- registryPackage = [text|
--   accepts@1.3.3, accepts@~1.3.3:
--     version "1.3.3"
--     resolved "https://registry.yarnpkg.com/accepts/-/accepts-1.3.3.tgz#c3ca7434938648c3e0d9c1e328dd68b622c284ca"
--     dependencies:
--       mime-types "~2.1.11"
--       negotiator "0.6.1"
--   |]

nonsenseEntry :: Text
nonsenseEntry = [text|
  foobar@~1.2.3, xyz@hehe:
    field1 "°§ℓ»«UAIERNT"
    field2 "nopedidope"
  |]

case_NonsenseASTPackageEntry :: Assertion
case_NonsenseASTPackageEntry = do
  parseSuccess packageEntry nonsenseEntry
    >>= \(Keyed keys (_, PackageFields fields)) -> do
      assertBool "two keys" (length keys == 2)
      assertBool "two fields" (length fields == 2)
      assertBool "field1 member" (Map.member "field1" fields)
      assertBool "field2 member" (Map.member "field2" fields)
      Map.lookup "field1" fields @=? (Just (Left "°§ℓ»«UAIERNT"))

nestedPackageExample :: Text
nestedPackageExample = [text|
  readable-stream@1.0, "readable-stream@>=1.0.33-1 <1.1.0-0":
    dependencies:
      core-util-is "~1.0.0"
      is.array ""
      "@types/string_decoder" "~0.10.x"
      johnny-dep 2.3.4
  |]

nestedFieldExample :: Text
nestedFieldExample = [text|
  dependencies:
    core-util-is "~1.0.0"
    is.array ""
    "@types/string_decoder" "~0.10.x"
    johnny-dep 2.3.4
  |]

case_nestedField :: Assertion
case_nestedField = do
  void $ parseSuccess nestedField nestedFieldExample

case_NestedPackage :: Assertion
case_NestedPackage = do
  assertBool "there is unicode" (all Ch.isAscii (toS nestedPackageExample :: [Char]))
  parseSuccess packageEntry nestedPackageExample
    >>= \(Keyed _ (_, PackageFields fields)) -> do
      case Map.lookup "dependencies" fields of
        (Nothing) -> assertFailure "where’s the key"
        (Just (Left s)) -> do
          assertFailure $ toS (s <> "should be a nested package")
        (Just (Right (PackageFields nested))) -> do
          assertEqual "nested keys" 4 $ length nested
          assertEqual "dep exists" (Just (Left "2.3.4"))
            $ Map.lookup "johnny-dep" nested
          assertEqual "scoped packages start with @" (Just (Left "~0.10.x"))
            $ Map.lookup "@types/string_decoder" nested

case_PackageField :: IO ()
case_PackageField = do
  let goodField = "myfield12 \"abc\""
      badField = "badbad \"abc"
      okayishField = "f abc"
  parseFailure field badField
  parseSuccess field goodField
    >>= \(key, val) -> do
      key @=? "myfield12"
      val @=? (Left "abc")
  parseSuccess field okayishField
    >>= \(key, val) -> do
      key @=? "f"
      val @=? (Left "abc")

case_PackageKey :: Assertion
case_PackageKey = do
  let key = "foo@^1.3.4, bar@blafoo234, xnu@, @types/foo@:\n"
  parseSuccess packageKeys key
    >>= \keys -> do
      keys @?= NE.fromList
               [ PackageKey (SimplePackageKey "foo") "^1.3.4"
               , PackageKey (SimplePackageKey "bar") "blafoo234"
               -- yes, the version can be empty …
               , PackageKey (SimplePackageKey "xnu") ""
               -- and yes, package names can contain `@`
               , PackageKey (ScopedPackageKey "types" "foo") ""
               ]


-- | PackageKeys can contain arbitrary stuff apparently
case_complexKey :: Assertion
case_complexKey = do
  parseSuccess packageKeys
    "\"mango-components@git+ssh://git@github.com:stuff/#fe234\":"
    >>= \((PackageKey name version) NE.:| []) -> do
      assertEqual "complexKey name"
        (SimplePackageKey "mango-components") name
      assertEqual "complexKey version"
        "git+ssh://git@github.com:stuff/#fe234"
        version
  parseSuccess packageKeys
    "\"@types/mango-components@git@github\":"
    >>= \((PackageKey name version) NE.:| []) -> do
      assertEqual "complexKeyScoped name"
        (ScopedPackageKey "types" "mango-components") name
      assertEqual "complexKeyScoped version" "git@github" version


-- HELPERS

parseSuccess :: Parser a -> Text -> IO a
parseSuccess parser string = do
  case MP.parse parser "" string of
    (Right a) -> pure a
    (Left err) -> do
      _ <- assertFailure ("parse should succeed, but: \n"
                    <> MP.parseErrorPretty err
                    <> "for input\n" <> toS string <> "\n\"")
      panic "not reached"

parseFailure :: Parser a -> Text -> IO ()
parseFailure parser string = do
  case MP.parseMaybe parser string of
    Nothing -> pure ()
    (Just _) -> assertFailure "parse should have failed"
     
tests :: TestTree
tests = $(testGroupGenerator)