{-# 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")) 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.errorBundlePretty 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)