{-# LANGUAGE OverloadedStrings, TemplateHaskell, NamedFieldPuns, ViewPatterns, NoImplicitPrelude, LambdaCase, RecordWildCards #-} module TestFile (tests) where import Protolude import qualified Data.List.NonEmpty as NE import Test.Tasty (TestTree) import Test.Tasty.TH import Test.Tasty.HUnit import qualified Data.Map.Strict as M import qualified Yarn.Lock.Types as T import qualified Yarn.Lock.File as File import qualified Yarn.Lock.Parse as Parse -- TODO: actually use somehow (apart from manual testing) -- The yarn.lock file should resolve each packageKey exactly once. -- -- No pkgname/semver combination should appear twice. That means -- the lengths of the converted map and the list lists need to match. -- prop_LockfileSameAmountOfKeys :: [Package] -> Bool -- prop_LockfileSameAmountOfKeys pl = length (packageListToLockfile pl) -- == length (concatMap fst pl) emptyAst :: [(Text, Either Text Parse.PackageFields)] -> Parse.PackageFields emptyAst = Parse.PackageFields . M.fromList minimalAst :: [(Text, Either Text Parse.PackageFields)] -> Parse.PackageFields minimalAst = emptyAst . ([("version", Left "0.3")] <>) case_gitRemote :: Assertion case_gitRemote = do let ref = "abcthisisaref" ast link_ hasUid = minimalAst $ [ ("resolved", Left link_) ] <> hasUid `orEmpty` ("uid", Left ref) let gitRemIs parsed (url', ref') = parsed <&> T.remote >>= \case T.GitRemote{..} -> do assertEqual "url url" url' gitRepoUrl assertEqual "url ref" ref' gitRev a -> assertFailure ("should be GitRemote, is " <> show a) let url1 = "git://github.com/bla" astToPackageSuccess (ast (url1 <> "#" <> ref) False) `gitRemIs` (url1, ref) let url2 = "https://github.com/bla" astToPackageSuccess (ast ("git+" <> url2) True) `gitRemIs` (url2, ref) case_fileRemote :: Assertion case_fileRemote = do let sha = "helloimref" good = minimalAst $ [ ("resolved", Left $ "https://gnu.org/stallmanstoe#" <> sha) ] goodNoIntegrity = minimalAst $ [ ("resolved", Left $ "https://gnu.org/stallmanstoe") ] astToPackageSuccess good <&> T.remote >>= \case T.FileRemote{..} -> do assertEqual "remote url" "https://gnu.org/stallmanstoe" fileUrl assertEqual "file sha" sha fileSha1 a -> assertFailure ("should be FileRemote, is " <> show a) astToPackageSuccess goodNoIntegrity <&> T.remote >>= \case T.FileRemoteNoIntegrity{..} -> assertEqual "remote url" "https://gnu.org/stallmanstoe" fileNoIntegrityUrl a -> assertFailure ("should be FileRemote, is " <> show a) case_fileLocal :: Assertion case_fileLocal = do let good = minimalAst $ [ ("resolved" , Left $ "file:../extensions/jupyterlab-toc-0.6.0.tgz#393fe") ] goodNoIntegrity = minimalAst $ [ ("resolved" , Left $ "file:../extensions/jupyterlab-toc-0.6.0.tgz") ] astToPackageSuccess good <&> T.remote >>= \case T.FileLocal{..} -> do assertEqual "file path" "../extensions/jupyterlab-toc-0.6.0.tgz" fileLocalPath assertEqual "file sha" "393fe" fileLocalSha1 a -> assertFailure ("should be FileLocal, is " <> show a) astToPackageSuccess goodNoIntegrity <&> T.remote >>= \case T.FileLocalNoIntegrity{..} -> do assertEqual "file path" "../extensions/jupyterlab-toc-0.6.0.tgz" fileLocalNoIntegrityPath a -> assertFailure ("should be FileLocal, is " <> show a) case_missingField :: Assertion case_missingField = do astToPackageFailureWith (File.MissingField "version" NE.:| [File.UnknownRemoteType]) $ emptyAst [] astToPackageSuccess :: Parse.PackageFields -> IO T.Package astToPackageSuccess ast = case File.astToPackage ast of (Left errs) -> do _ <- assertFailure ("should have succeded, but:\n" <> show errs) panic "not reached" (Right pkg) -> pure pkg astToPackageFailureWith :: (NE.NonEmpty File.ConversionError) -> Parse.PackageFields -> IO () astToPackageFailureWith errs ast = case File.astToPackage ast of (Right _) -> assertFailure "should have failed" (Left actual) -> assertEqual "errors should be the same" errs actual --TODO {- data Keys = Keys { a, b, c, y, z :: PackageKey } keys :: Keys keys = Keys (pk "a") (pk "b") (pk "c") (pk "y") (pk "z") where pk n = PackageKey n "0.1" data LFs = LFs { lfNormal, lfEmpty, lfCycle, lfDecycled , lfComplex, lfComplexD :: Lockfile } -- | Example lockfiles for tests. -- These are put into scope in tests by use of @NamedFieldPuns@. lfs :: LFs lfs = LFs { lfNormal = (tlf [pkg' a [b, c], pkg' b [c], pkg' c []]) , lfEmpty = (tlf []) , lfCycle = (tlf [pkg' a [b, c], pkg' b [a, c], pkg' c [c]]) , lfDecycled = (tlf [pkg' a [b, c], pkg' b [ c], pkg' c [ ]]) , lfComplex = (tlf [pkg [a, z] [a, c], pkg [c, y] [c, a, z]]) -- Hm, this test is implementation dependent. But the cycles get removed. , lfComplexD = (tlf [pkg [a, z] [ ], pkg [c, y] [ z]]) } where pkg keys_ deps = (keys_, Package "0.1" (RemoteFile "" "") deps []) pkg' key = pkg [key] tlf = packageListToLockfile Keys{a,b,c,y,z} = keys -- | Test for the 'decycle' method. case_decycle :: Assertion case_decycle = do -- print lfCycle lfDecycled @=? (decycle lfCycle) lfComplexD @=? (decycle lfComplex) where LFs{lfCycle, lfDecycled, lfComplex, lfComplexD} = lfs type PkgMap = Map PackageKey Package -- | A lockfile is basically a flat version of a recursive dependency structure. -- 'Built' resembles the recursive version of said flat structure. data Built = Built PackageKey [Built] deriving (Eq) instance Show Built where show (Built k b) = show $ printBuild b where printBuild b' = Pr.list [Pr.tupled [Pr.text . toS $ name k, printBuild b']] buildFromMap :: PkgMap -> [Built] buildFromMap m = map go $ M.keys m where go :: PackageKey -> Built go pk = Built pk $ map go (dependencies $ m M.! pk) -- | Checks if the flat lockfile builds a correct recursive structure. case_built :: Assertion case_built = do let LFs{lfNormal} = lfs Keys{a,b,c} = keys bl = Built ble p = Built p [] buildFromMap (flattenKeys lfNormal) @?= [ bl a [bl b [ble c], ble c] , bl b [ble c] , ble c] -} tests :: TestTree tests = $(testGroupGenerator)