packages feed

yarn-lock 0.2.0 → 0.3.1

raw patch · 13 files changed

+945/−317 lines, 13 filesdep +eitherdep +neat-interpolationdep +tasty-quickcheckdep ~basedep ~megaparsec

Dependencies added: either, neat-interpolation, tasty-quickcheck

Dependency ranges changed: base, megaparsec

Files

CHANGELOG.md view
@@ -5,21 +5,47 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/) and this project adheres to [Semantic Versioning](http://semver.org/). -## 0.2 - 2017-05-21+## [0.3.1] - 2017-08-16  ### Added-- a multi-keyed map module-- `decycle` function for removing npm dependency cycles+- Functor, Foldable and Traversable instances for MKMap +### Fixed+- Remote URL parsing strips more unneeded elements++## [0.3] - 2017-08-16++This is a major overhaul, changing nearly every part of the API+and the implementation!++### Added+- Support for multiple kinds of remote.+- Heuristics for parsing git and file remotes.+- Helpful, local error messages if the parsing goes wrong somewhere+- A convenience function for doing all parsing steps at once+- A pretty printer for error messages+- Tests for all parsing logic+- Tests for simple invariants in the multi-keyed map implementation+ ### Changed-- Lockfile type is now a multi-keyed map+- Split the code into multiple modules.+- Rewrote the parser to have a separate AST parsing step. +## [0.2] - 2017-05-21 +### Added+- A multi-keyed map module.+- `decycle` function for removing npm dependency cycles.++### Changed+- Lockfile type is now a multi-keyed map.++ ## [0.1] - 2017-04-18  ### Added-- parser for `yarn.lock` files generated by yarn-- data types representing the yarn file-- Lockfile type that is a simple `Map`+- Parser for `yarn.lock` files generated by yarn.+- Data types representing the yarn file.+- Lockfile type that is a simple `Map`.
src/Data/MultiKeyedMap.hs view
@@ -1,9 +1,21 @@-{-# LANGUAGE ExistentialQuantification, NamedFieldPuns, ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification, NamedFieldPuns, ScopedTypeVariables, RecordWildCards, ApplicativeDo #-} {-| Module : Data.MultiKeyedMap-Description : A multi-keyed map.+Description : A map with possibly multiple keys per value Maintainer : Profpatsch Stability : experimental++Still very much experimental and missing lots of functions and testing.++Internally, a 'MKMap' is two maps, a @keyMap@ referencing an intermediate key+(whose type can be chosen freely and which is incremented sequentially), and+a @valueMap@ going from intermediate key to final value.++A correct implementation guarantees that++(1) the internal structure can’t be corrupted by operations declared safe+(2) adding and removing keys does not make values inaccessible+    (thus leaking memory) and doesn’t insert unnecessary values -} module Data.MultiKeyedMap ( MKMap@@ -27,7 +39,8 @@ -- -- Internally, we use two maps connected by an intermediate key. -- The intermediate key (@ik@) can be anything implementing--- 'Ord' (for 'Map') and 'Enum' (for 'succ').+-- 'Ord' (for 'Map'), 'Bounded' (to get the first value)+-- and 'Enum' (for 'succ'). data MKMap k v = forall ik. (Ord ik, Enum ik)               => MKMap                  { keyMap :: M.Map k ik@@ -55,6 +68,22 @@         -- all be reachable from the keys (TODO: add invariants)    -- TODO: can (/=) be implemented more efficient than not.(==)? ++instance Functor (MKMap k) where+  fmap f (MKMap{..}) = MKMap { valMap = fmap f valMap, .. }+  {-# INLINE fmap #-}++-- TODO implement all functions Data.Map also implements for Foldable+instance Foldable (MKMap k) where+  foldMap f (MKMap{..}) = foldMap f valMap+  {-# INLINE foldMap #-}++instance Traversable (MKMap k) where+  traverse f (MKMap{..}) = do+    val <- traverse f valMap+    pure $ MKMap{ valMap=val, .. }+  {-# INLINE traverse #-}+ -- | Find value at key. Partial. See 'M.!'. at :: (Ord k) => MKMap k v -> k -> v at MKMap{keyMap, valMap} k =  valMap M.! (keyMap M.! k)@@ -70,6 +99,7 @@         => (Proxy ik) -- ^ type of intermediate key         -> MKMap k v -- ^ new map mkMKMap _ = MKMap mempty (minBound :: ik) mempty+{-# INLINE mkMKMap #-}  instance (Show k, Show v) => Show (MKMap k v) where   showsPrec d m = Show.showString "fromList " . (showsPrec d $ toList m)@@ -79,6 +109,7 @@          => (Proxy ik) -- ^ type of intermediate key          -> [([k], v)] -- ^ list of @(key, value)@          -> MKMap k v  -- ^ new map+ -- TODO: it’s probably better to implement with M.fromList fromList p = L.foldl' (\m (ks, v) -> newVal ks v m) (mkMKMap p) @@ -119,10 +150,14 @@     upd ik = MKMap { keyMap, highestIk, valMap = M.insert ik v valMap }  --- | helper, assumes there is no such value already---+-- | Helper, assumes there is no such value already. -- Will leak space otherwise!+--+-- Insert every key into the keyMap, increase the intermediate counter,+-- insert the value at new intermediate counter.+-- Overwrites all already existing keys! newVal :: (Ord k) => [k] -> v -> MKMap k v -> MKMap k v+newVal [] _ m = m newVal ks v MKMap{keyMap, highestIk, valMap} =   MKMap { keyMap = L.foldl' (\m k -> M.insert k next m) keyMap ks         , highestIk = next
src/Yarn/Lock.hs view
@@ -1,244 +1,98 @@-{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude, LambdaCase, OverloadedStrings, RecordWildCards #-} {-| Module : Yarn.Lock-Description : Parser & Types for yarn.lock files+Description : High-level parser of yarn.lock files Maintainer : Profpatsch Stability : experimental -The <https://yarnpkg.com/ Yarn package manager> improves on npm-in that it writes @yarn.lock@ files that contain a complete+The <https://yarnpkg.com/ Yarn package manager> improves on npm,+because it writes @yarn.lock@ files that contain a complete version resolution of all dependencies. This way a deterministic deployment can be guaranteed.--This module provides a parser for @yarn.lock@ files. -} module Yarn.Lock-( Lockfile, PackageKey(..), Package(..), RemoteFile(..)-, PackageEntry, PackageList-, Yarn.Lock.parse-, decycle--- | = Parsers-, lockfile-, packageListToLockfile, packageList-, packageEntry, packageKeys, packageKey, package+( T.Lockfile+, parseFile, parse+-- * Errors+, prettyLockfileError+, LockfileError(..), PackageErrorInfo(..) ) where -import Protolude hiding (try)-import qualified Data.List as L-import Data.String (String)-import Text.Megaparsec as MP-import Text.Megaparsec.Text+import Protolude import qualified Data.Text as T--import qualified Data.MultiKeyedMap as MKM-import Data.Proxy (Proxy(..))---- | Yarn lockfile.------ It is a multi-keyed map (each value can be referenced by multiple keys).--- This is achieved by using an intermediate key @ik@.-type Lockfile = MKM.MKMap PackageKey Package---- | Proxy type for our MKMap intermediate key-lockfileIkProxy :: Proxy Int-lockfileIkProxy = Proxy---- instance Monoid Lockfile where---    mempty = Lockfile $ MKM.mkMap (Proxy :: Proxy Int)---    -- TODO associativity?---    mappend = undefined---- | Key that indexes package for a specific version.-data PackageKey = PackageKey-  { name      :: Text -- ^ package name-  , npmSemver :: Text -- ^ semver string-  } deriving (Show, Eq, Ord)---- | The actual package with dependencies and download link.-data Package = Package-  { version              :: Text         -- ^ resolved, specific version-  , resolved             :: RemoteFile   -- ^ download link w/ hash-  , dependencies         :: [PackageKey] -- ^ list of dependencies-  , optionalDependencies :: [PackageKey] -- ^ list of optional dependencies-  } deriving (Eq, Show)---- | A package download link.-data RemoteFile = RemoteFile-  { url     :: Text-  , sha1sum :: Text }-  deriving (Eq, Show)---- | A entry as it appears in the yarn.lock representation.-type PackageEntry = ([PackageKey], Package)--- | Convenience alias.-type PackageList = [PackageEntry]---- | Convenience function that converts errors to Text.------ The actual parsers are below.-parse :: Text -- ^ name of source file-      -> Text -- ^ input for parser-      -> Either Text Lockfile-parse src inp = first (T.pack . parseErrorPretty)-              $ MP.parse lockfile (T.unpack src) inp---- 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 :: PackageList -> Bool--- prop_LockfileSameAmountOfKeys pl = length (packageListToLockfile pl)---                                    == length (concatMap fst pl)----- | Takes a 'Lockfile' and removes dependency cycles.------ Node packages often contain those and the yarn lockfile--- does not yet eliminate them, which may lead to infinite--- recursions.-decycle :: Lockfile -> Lockfile-decycle lf = goFold [] lf (MKM.keys lf)-  -- TODO: probably rewrite with State-  where-    -- | fold over all package keys, passing the lockfile-    goFold seen lf' pkeys =-      foldl' (\lf'' pkey -> go (pkey:seen) lf'') lf' pkeys-    -- | We get a stack of already seen packages-    -- and filter out any dependencies we already saw.-    go :: [PackageKey] -> Lockfile -> Lockfile-    go seen@(we:_) lf' =-      let ourPkg = lf' MKM.! we-          -- old deps minus the already seen ones-          -- TODO make handling of opt pkgs less of a duplication-          newDeps = dependencies ourPkg L.\\ seen-          newOptDeps = optionalDependencies ourPkg L.\\ seen-          -- we update the pkg with the cleaned dependencies-          lf'' = MKM.insert we (ourPkg { dependencies = newDeps-                               , optionalDependencies = newOptDeps }) lf'-      -- finally we do the same for all remaining deps-      in goFold seen lf'' $ newDeps ++ newOptDeps-    go [] _ = panic $ toS "should not happen!"---- HALP, I don’t know how to parser.--- It appears to be a more general format which somewhat resembles yaml.--- The code below conflates the format & the semantics of yarn.lock files.--- It should be separated sometime, to make parsing easier.---- | Convenience function that applies @packageListToLockfile@.-lockfile :: Parser Lockfile-lockfile = packageListToLockfile <$> packageList---- | The yarn.lock file is basically a hashmap with multi-keyed entries.------ This should press it into our Lockfile Map.-packageListToLockfile :: PackageList -> Lockfile-packageListToLockfile = MKM.fromList lockfileIkProxy--  -- foldl' go mempty-  -- where go lf (keys, pkg) = foldl' (\lf' key' -> M.insert key' pkg lf') lf keys+import qualified Data.List.NonEmpty as NE+import qualified Text.Megaparsec as MP+import qualified Data.Either.Validation as V --- | Parse a complete yarn.lock into exaclty the same representation.------ You can apply @packageListToLockfile@ to make it usable.-packageList :: Parser PackageList-packageList = many $ (skipMany (comment <|> eol)) *> packageEntry-                where comment = char '#' *> manyTill anyChar eol+import qualified Yarn.Lock.Types as T+import qualified Yarn.Lock.File as File+import qualified Yarn.Lock.Parse as Parse --- | A single PackageEntry.------ @--- handlebars@^4.0.4:---   version "4.0.6"---   resolved "https://registry.yarnpkg.com/handlebars/-/handlebars-4.0.6.tgz#2ce4484850537f9c97a8026d5399b935c4ed4ed7"---   dependencies:---     async "^1.4.0"---     optimist "^0.6.1"---     source-map "^0.4.4"---   optionalDependencies:---     uglify-js "^2.6"--- @-packageEntry :: Parser PackageEntry-packageEntry = (,) <$> packageKeys <*> package <?> "package entry"+-- | Everything that can go wrong when parsing a 'Lockfile'.+data LockfileError+  = ParseError Text+  -- ^ The initial parsing step failed+  | PackageErrors (NE.NonEmpty PackageErrorInfo)+  -- ^ a package could not be parsed from the AST+  deriving (Show, Eq) --- | The list of PackageKeys that index the same Package------ @--- align-text@^0.1.1, align-text@^0.1.3:\\n--- @-packageKeys :: Parser [PackageKey]-packageKeys = sepBy1 packageKey (string ", ") <* (char ':') <* eol <?> "package keys"+-- | Information about package parsing errors.+data PackageErrorInfo = PackageErrorInfo+  { srcPos :: MP.SourcePos+  -- ^ the position of the package in the original file+  , convErrs :: NE.NonEmpty File.ConversionError+  -- ^ list of reasons for failure+  } deriving (Show, Eq) --- | A packageKey is @\<package-name\>\@\<semver\>@;+-- | Convenience function, combining all parsing steps. ----- If the semver contains spaces, it is also quoted with @"@.-packageKey :: Parser PackageKey-packageKey = label "package key" $ inString pkgKey <|> pkgKey-  where-    pkgKey = PackageKey-      -- everything until the version, sep is @-      <$> (someTextUntilSep '@' <?> "package name part of package key")-      -- a version is anything but the , (used for seperating package keys)-      -- or : (used to close the packageKeys line)-      -- could be more specific (version is semver), but I’m lazy-      <*> (someText (noneOf "\",:") <?> "semver part of package key")---- | Parses the content fields of a package.-package :: Parser Package-package = Package--- TODO: order shouldn’t matter, horrible indentation scheme-  <$> (indent 2 $ key "version" stringText)-  <*> (indent 2 $ key "resolved" remoteFile)-  <*> (maybe [] identity <$> optional (indent 2 $ dependencyEntries "dependencies"))-  <*> (maybe [] identity <$> optional (indent 2 $ dependencyEntries "optionalDependencies"))----- internal parsers+-- The resulting 'Lockfile' structure might not yet be optimal,+-- see 'File.fromPackages'.+parseFile :: FilePath -- ^ file to read+          -> IO (Either LockfileError T.Lockfile)+parseFile fp = readFile fp >>= pure . parse fp --- | the “resolved”-field contains the link and the hash-remoteFile :: Parser RemoteFile-remoteFile = label "file link with hash" $ RemoteFile-  <$> someTextUntilSep '#'-  <*> stringText+-- | For when you want to provide only the file contents.+parse :: FilePath -- ^ name of the input file, used for the parser+      -> Text     -- ^ content of a @yarn.lock@+      -> Either LockfileError T.Lockfile+parse fp = astParse fp >=> toPackages >=> toLockfile --- | dependency field of a package-dependencyEntries :: String -> Parser [PackageKey]-dependencyEntries key' = label (key' <>" field") $ do-  _ <- string (key' <>":") <* eol-  -- TODO: cool indentation handling-  some (indent 4 dep)+-- | Pretty print a parsing error with sane default formatting.+prettyLockfileError :: LockfileError -> Text+prettyLockfileError = \case+  (ParseError t) -> "Error while parsing the yarn.lock:\n"+    <> T.unlines (indent 2 (T.lines t))+  (PackageErrors errs) -> "Some packages could not be made sense of:\n"+    <> T.unlines (NE.toList $ indent 2 (join $ fmap errText errs))   where-    -- It’s a bit like a key below, but the value of the key is not known.-    -- Here’s where the format should get its own AST, but I’m too lazy right now.-    dep = PackageKey <$> someTextUntilSep ' ' <*> inString stringText <* eol <?> "a dependency entry"---- | A key-value pair, separated by space. The value is enclosed in "".------ The given parser is used to parse the value and should not parse ".-key :: String -> Parser a -> Parser a-key name' val = label ("key " <> name') $-  string name' *> char ' ' *> inString val  <* eol----- text versions of parsers & helpers+    indent :: Functor f => Int -> f Text -> f Text+    indent i = fmap (T.replicate i " " <>)+    errText (PackageErrorInfo{..}) =+      (pure $ "Package at " <> (toS $ MP.sourcePosPretty srcPos) <> ":")+      <> indent 2 (fmap convErrText convErrs)+    convErrText = \case+      (File.MissingField t) -> "Field " <> qu t <> " is missing."+      (File.WrongType{..})  -> "Field " <> qu fieldName+                               <> " should be of type " <> fieldType <> "."+      (File.UnknownRemoteType) -> "We don’t know this remote type."+    qu t = "\"" <> t <> "\"" -someText :: Parser Char -> Parser Text-someText c = T.pack <$> some c+-- helpers+astParse :: FilePath -> Text -> Either LockfileError [Parse.Package]+astParse fp = first (ParseError . toS . MP.parseErrorPretty)+                . MP.parse Parse.packageList fp --- | parse everything as inside a string--- TODO: this breaks the 'between' abstraction, can it be avoided somehow?-inString :: Parser a -> Parser a-inString = between (char '"') (char '"')+toPackages :: [Parse.Package] -> Either LockfileError [T.Keyed T.Package]+toPackages = first PackageErrors . V.validationToEither+                . traverse validatePackage --- | function to annotate text inside strings (which should never parse ")---   symptom of the broken 'between' abstraction-stringText :: Parser Text-stringText = someText (noneOf "\"") <?> "non-empty text without \""+validatePackage :: Parse.Package+                -> V.Validation (NE.NonEmpty PackageErrorInfo) (T.Keyed T.Package)+validatePackage (T.Keyed keys (pos, fields)) = V.eitherToValidation+  $ bimap (pure . PackageErrorInfo pos) (T.Keyed keys)+    $ File.astToPackage fields --- | parse some text until seperator is reached-someTextUntilSep :: Char -> Parser Text-someTextUntilSep sep = T.pack <$> someTill anyChar (char sep)+toLockfile :: [T.Keyed T.Package] -> Either LockfileError T.Lockfile+toLockfile = pure . File.fromPackages --- | intend by @i@ spaces-indent :: Int -> Parser a -> Parser a-indent i p = try $ count i (char ' ') *> p
+ src/Yarn/Lock/File.hs view
@@ -0,0 +1,154 @@+{-|+Module : Yarn.Lock.File+Description : Convert AST to semantic data structures+Maintainer : Profpatsch+Stability : experimental++After parsing yarn.lock files in 'Yarn.Lock.Parse',+you want to convert the AST to something with more information+and ultimately get a 'T.Lockfile'.++@yarn.lock@ files don’t follow a structured approach+(like for example sum types), so information like e.g.+the remote type have to be inferred frome AST values.+-}+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, ApplicativeDo, RecordWildCards, NamedFieldPuns #-}+module Yarn.Lock.File+( fromPackages+, astToPackage+-- * Errors+, ConversionError(..)+) where++import Protolude+import qualified Data.List.NonEmpty as NE+import qualified Data.Map.Strict as M+import qualified Data.Text as Text+import qualified Data.Either.Validation as V++import qualified Yarn.Lock.Parse as Parse+import qualified Yarn.Lock.Types as T+import qualified Data.MultiKeyedMap as MKM++-- | Press a list of packages into the lockfile structure.+--+-- It’s a dumb conversion, you should probably apply+-- the 'Yarn.Lock.Helpers.decycle' function afterwards.+fromPackages :: [T.Keyed T.Package] -> T.Lockfile+fromPackages = MKM.fromList T.lockfileIkProxy+             . fmap (\(T.Keyed ks p) -> (ks, p))++-- | Possible errors when converting from AST.+data ConversionError+  = MissingField Text+  -- ^ field is missing+  | WrongType { fieldName :: Text, fieldType :: Text }+  -- ^ this field has the wrong type+  | UnknownRemoteType+  -- ^ the remote (e.g. git, tar archive) could not be determined+  deriving (Show, Eq)++-- | Something that can parse the value of a field into type @a@.+data FieldParser a = FieldParser+  { parseField :: Either Text Parse.PackageFields -> Maybe a+    -- ^ the parsing function (Left is a simple field, Right a nested one)+  , parserName :: Text+    -- ^ name of this parser (for type errors)+  }++type Val = V.Validation (NE.NonEmpty ConversionError)++-- | Parse an AST 'PackageFields' to a 'T.Package', which has+-- the needed fields resolved.+astToPackage :: Parse.PackageFields+             -> Either (NE.NonEmpty ConversionError) T.Package+astToPackage = V.validationToEither . validate+  where+    validate :: Parse.PackageFields -> Val T.Package+    validate fs = do+      version              <- getField text "version" fs+      remote               <- checkRemote fs+      dependencies         <- getFieldOpt keylist "dependencies" fs+      optionalDependencies <- getFieldOpt keylist "optionalDependencies" fs+      pure $ T.Package{..}++    -- | Parse a field from a 'PackageFields'.+    getField :: FieldParser a -> Text -> Parse.PackageFields -> Val a+    getField = getFieldImpl Nothing+    -- | Parse an optional field and insert the empty monoid value+    getFieldOpt :: Monoid a => FieldParser a -> Text -> Parse.PackageFields -> Val a+    getFieldOpt = getFieldImpl (Just mempty)++    getFieldImpl :: Maybe a -> FieldParser a -> Text -> Parse.PackageFields -> Val a+    getFieldImpl mopt typeParser fieldName (Parse.PackageFields m)=+      first pure $ V.eitherToValidation $ do+        case M.lookup fieldName m of+          Nothing -> case mopt of+            Just opt -> Right opt+            Nothing  -> Left $ MissingField fieldName+          Just val -> note+            (WrongType { fieldName, fieldType = parserName typeParser })+            $ parseField typeParser val++    -- | Parse a simple field to type 'Text'.+    text :: FieldParser Text+    text = FieldParser { parseField = either Just (const Nothing)+                       , parserName = "text" }++    -- | Parse a field nested one level to a list of 'PackageKey's.+    keylist :: FieldParser [T.PackageKey]+    keylist = FieldParser+      { parserName = "list of package keys"+      , parseField = either (const Nothing)+             (\(Parse.PackageFields inner) ->+                  for (M.toList inner) $ \(k, v) -> do+                    npmVersionSpec <- parseField text v+                    pure $ T.PackageKey { T.name = k, ..}) }++    -- | Appling heuristics to the field contents to find the+    -- correct remote type.+    checkRemote :: Parse.PackageFields -> Val T.Remote+    checkRemote fs =+      -- any error is replaced by the generic remote error+      mToV (pure UnknownRemoteType)+        -- implementing the heuristics of searching for types;+        -- it should of course not lead to false positives+        -- see tests/TestLock.hs+        $ checkGit <|> checkFile+      where+        mToV :: e -> Maybe a -> V.Validation e a+        mToV err = V.eitherToValidation . note err+        vToM :: Val a -> Maybe a+        vToM = hush . V.validationToEither++        -- | "https://blafoo.com/a/b#alonghash"+        --   -> ("https://blafoo.com/a/b", "alonghash")+        -- we assume the # can only occur exactly once+        findUrlHash :: Text -> (Text, Maybe Text)+        findUrlHash url = case Text.splitOn "#" url of+          [url']       -> (url', Nothing)+          [url', ""]   -> (url', Nothing)+          [url', hash] -> (url', Just hash)+          _           -> panic "checkRemote: # should only appear exactly once!"++        checkGit = do+          resolved <- vToM $ getField text "resolved" fs+          -- either in uid field or after the hash in the “resolved” URL+          (repo, gitRev) <- do+            let (repo', mayHash) = findUrlHash resolved+            hash <- vToM (getField text "uid" fs)+              <|> if any (`Text.isPrefixOf` resolved) ["git+", "git://"]+                  then mayHash else Nothing+            pure (repo', hash)+          pure $ T.GitRemote+            { T.gitRepoUrl = noPrefix "git+" repo , .. }++        -- | ensure the prefix is removed+        noPrefix :: Text -> Text -> Text+        noPrefix pref hay = maybe hay identity $ Text.stripPrefix pref hay++        checkFile = do+          resolved <- vToM (getField text "resolved" fs)+          let (fileUrl, mayFileSha1) = findUrlHash resolved+          fileSha1 <- mayFileSha1+          pure $ T.FileRemote{..}
+ src/Yarn/Lock/Helpers.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-|+Module : Yarn.Lock.Helpers+Description : Helpers for modifying Lockfiles+Maintainer : Profpatsch+Stability : experimental++Freshly parsed 'Lockfile's are often not directly usable+e.g. because they still can contain cycles. This module+provides helpers for modifying them.+-}+module Yarn.Lock.Helpers+( decycle+) where++import Protolude+import qualified Data.List as L++import qualified Data.MultiKeyedMap as MKM++import Yarn.Lock.Types+++-- | Takes a 'Lockfile' and removes dependency cycles.+--+-- Node packages often contain those and the yarn lockfile+-- does not yet eliminate them, which may lead to infinite+-- recursions.+decycle :: Lockfile -> Lockfile+decycle lf = goFold [] lf (MKM.keys lf)+  -- TODO: probably rewrite with State+  where+    -- | fold over all package keys, passing the lockfile+    goFold seen lf' pkeys =+      foldl' (\lf'' pkey -> go (pkey:seen) lf'') lf' pkeys+    -- | We get a stack of already seen packages+    -- and filter out any dependencies we already saw.+    go :: [PackageKey] -> Lockfile -> Lockfile+    go seen@(we:_) lf' =+      let ourPkg = lf' MKM.! we+          -- old deps minus the already seen ones+          -- TODO make handling of opt pkgs less of a duplication+          newDeps = dependencies ourPkg L.\\ seen+          newOptDeps = optionalDependencies ourPkg L.\\ seen+          -- we update the pkg with the cleaned dependencies+          lf'' = MKM.insert we (ourPkg { dependencies = newDeps+                               , optionalDependencies = newOptDeps }) lf'+      -- finally we do the same for all remaining deps+      in goFold seen lf'' $ newDeps ++ newOptDeps+    go [] _ = panic $ toS "should not happen!"
+ src/Yarn/Lock/Parse.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-}+{-|+Module : Yarn.Lock.Parse+Description : Parser for yarn.lock files+Maintainer : Profpatsch+Stability : experimental++This module provides a parser for the AST of @yarn.lock@ files.+-}+module Yarn.Lock.Parse+( PackageFields(..), Package+-- * Parsing+-- ** Re-export+, Parser+-- ** Parsers+, packageList+, packageEntry+-- = internal parsers+, field, packageKeys, packageKey+) where++import Protolude hiding (try)+import qualified Data.Char as Ch+import qualified Data.Text as Text+import qualified Data.Map.Strict as M+import Text.Megaparsec as MP hiding (space)+import Text.Megaparsec.Text+import qualified Text.Megaparsec.Lexer as MPL++-- import qualified Data.MultiKeyedMap as MKM+-- import Data.Proxy (Proxy(..))++import qualified Yarn.Lock.Types as T+++-- | The @yarn.lock@ format doesn’t specifically include a fixed scheme,+-- it’s just an unnecessary custom version of a list of fields.+--+-- An field can either be a string or more fields w/ deeper indentation.+--+-- The actual conversion to semantic structures needs to be done afterwards.+newtype PackageFields = PackageFields (Map Text (Either Text PackageFields))+  deriving (Show, Eq, Monoid)++-- | A parsed 'Package' AST has one or more keys, a position in the original files+-- and a collection of fields.+type Package = T.Keyed (SourcePos, PackageFields)+++-- | Parse a complete yarn.lock into an abstract syntax tree,+-- keeping the source positions of each package entry.+packageList :: Parser [Package]+packageList = many $ (skipMany (comment <|> eol)) *> packageEntry+                where comment = char '#' *> manyTill anyChar eol++-- | A single Package.+--+-- Example:+--+-- @+-- handlebars@^4.0.4:+--   version "4.0.6"+--   resolved "https://registry.yarnpkg.com/handlebars/-/handlebars-4.0.6.tgz#2ce4484850537f9c97a8026d5399b935c4ed4ed7"+--   dependencies:+--     async "^1.4.0"+--     optimist "^0.6.1"+--     source-map "^0.4.4"+--   optionalDependencies:+--     uglify-js "^2.6"+-- @+packageEntry :: Parser (T.Keyed (SourcePos, PackageFields))+packageEntry = label "package entry" $ do+  pos <- getPosition+  -- A package entry is a non-indented+  (keys, pkgs) <- nonIndented+            -- block that has a header of package keys+            -- and an indented part that contains fields+            $ indentedFieldsWithHeader packageKeys+  pure $ T.Keyed keys (pos, pkgs)++-- | The list of PackageKeys that index the same Package+--+-- @+-- align-text@^0.1.1, align-text@^0.1.3:\\n+-- @+packageKeys :: Parser [T.PackageKey]+packageKeys = label "package keys" $ do+  firstEls <- many (try $ lexeme $ packageKey ":," <* char ',')+  lastEl   <-                      packageKey ":"  <* char ':'+  pure $ firstEls ++ [lastEl]++-- | A packageKey is @\<package-name\>\@\<semver\>@;+--+-- If the semver contains spaces, it is also quoted with @"@.+packageKey :: [Char] -> Parser T.PackageKey+packageKey separators = inString (pkgKey "\"")+         -- if no string delimiters is used we need to check for the separators+         -- this file format is shit :<+         <|> pkgKey separators+         <?> "package key"+  where+    pkgKey valueChars = do+      pkgName <- someTextOf (noneOf "@") <?> "package name part of package key"+      _ <- char '@'+      semver <- (someTextOf (noneOf valueChars))+                <|> (pure Text.empty <?> "an empty semver")+                <?> "semver part of package key"+      pure $ T.PackageKey pkgName semver+++-- | Either a simple or a nested field.+field :: Parser (Text, Either Text PackageFields)+field = try nested <|> simple <?> "field"+  where+    simple = fmap Left <$> simpleField+    nested = fmap Right <$> nestedField++-- | A key-value pair, separated by space. The value is enclosed in "".+-- Returns key and value.+simpleField :: Parser (Text, Text)+simpleField = (,) <$> lexeme symbolChars+                  -- valueChars may be in Strings or maybe not >:+                  -- this file format is absolute garbage+                  <*> (strValueChars <|> valueChars)+                  <?> "simple field"+  where+    valueChars, strValueChars :: Parser Text+    valueChars = someTextOf (noneOf "\n\r\"")+    strValueChars = inString $ valueChars+      -- as with packageKey semvers, this can be empty+      <|> (pure Text.empty <?> "an empty value field")++-- | Similar to a @simpleField@, but instead of a string+-- we get another block with deeper indentation.+nestedField :: Parser (Text, PackageFields)+nestedField = label "nested field" $+  indentedFieldsWithHeader (symbolChars <* char ':')+++-- internal parsers++-- | There are two kinds of indented blocks:+-- One where the header is the package+-- and one where the header is already a package field key.+indentedFieldsWithHeader :: Parser a -> Parser (a, PackageFields)+indentedFieldsWithHeader header = indentBlock $ do+    -- … block that has a header of package keys+    hdr <- header+    -- … and an indented part that contains fields+    pure $ MPL.IndentSome Nothing+      (\fields -> pure (hdr, toPfs fields)) field+  where+    toPfs :: [(Text, Either Text PackageFields)] -> PackageFields+    toPfs = PackageFields . M.fromList++-- | Characters allowed in key symbols.+-- +-- TODO: those are partly npm package names, so check the allowed symbols, too.+--+-- Update: npm doesn’t specify the package name format, at all.+-- Apart from the length.+symbolChars :: Parser Text+symbolChars = label "key symbol" $ someTextOf $ satisfy+  (\c -> Ch.isAscii c &&+     (Ch.isLower c || Ch.isUpper c || Ch.isNumber c || c `elem` "-_."))+++-- text versions of parsers & helpers++someTextOf :: Parser Char -> Parser Text+someTextOf c = Text.pack <$> some c++-- | parse everything as inside a string+inString :: Parser a -> Parser a+inString = between (char '"') (char '"')++-- lexers++-- | Parse whitespace.+space :: Parser ()+space = MPL.space (void MP.spaceChar)+                  (MPL.skipLineComment "# ")+                  (void $ satisfy (const False))++-- | Parse a lexeme.+lexeme :: Parser a -> Parser a+lexeme = MPL.lexeme space++-- | Ensure parser is not indented.+nonIndented :: Parser a -> Parser a+nonIndented = MPL.nonIndented space+indentBlock :: ParsecT Dec Text Identity (MPL.IndentOpt (ParsecT Dec Text Identity) a b)+            -> ParsecT Dec Text Identity a+indentBlock = MPL.indentBlock space
+ src/Yarn/Lock/Types.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DeriveFunctor #-}+{-|+Module : Yarn.Lock.Types+Description : Types for yarn.lock files+Maintainer : Profpatsch+Stability : experimental+-}+module Yarn.Lock.Types where++import Protolude hiding (try)+import qualified Data.MultiKeyedMap as MKM++-- | Yarn lockfile.+--+-- It is a multi-keyed map (each value can be referenced by multiple keys).+-- This is achieved by using an intermediate key @ik@.+--+-- Attention: Might be changed to a newtype in a future release.+type Lockfile = MKM.MKMap PackageKey Package+-- TODO+-- newtype Lockfile = Lockfile (MKM.MKMap PackageKey Package)++-- | Proxy type for our MKMap intermediate key+lockfileIkProxy :: Proxy Int+lockfileIkProxy = Proxy++-- | Key that indexes package for a specific version.+data PackageKey = PackageKey+  { name           :: Text -- ^ package name+  , npmVersionSpec :: Text+  -- ^ tring that specifies the version of a package;+  -- sometimes a npm semver, sometimes an arbitrary string+  } deriving (Show, Eq, Ord)++-- | Something with a list of 'PackageKey's pointing to it.+data Keyed a = Keyed [PackageKey] a+  deriving (Show, Eq, Ord, Functor)++-- | The actual npm package with dependencies and a way to download.+data Package = Package+  { version              :: Text         -- ^ resolved, specific version+  , remote               :: Remote+  , dependencies         :: [PackageKey] -- ^ list of dependencies+  , optionalDependencies :: [PackageKey] -- ^ list of optional dependencies+  } deriving (Eq, Show)++-- | Information on where to download the package.+data Remote+  = FileRemote+  { fileUrl     :: Text -- ^ URL to a remote file+  , fileSha1    :: Text -- ^ sha1 hash of the file (attached to the link)++  }+  | GitRemote+  { gitRepoUrl  :: Text -- ^ valid git remote URL+  , gitRev      :: Text -- ^ git tree-ish (commit, branch, &c.)+  } deriving (Eq, Show)
tests/Test.hs view
@@ -1,6 +1,13 @@ module Main where  import Test.Tasty-import qualified TestLock as TL+import qualified TestParse as Parse+import qualified TestFile as File+import qualified TestMultiKeyedMap as MKM -main = defaultMain TL.tests+main :: IO ()+main = defaultMain $ testGroup "tests"+  [ Parse.tests+  , File.tests+  , MKM.tests+  ]
+ tests/TestFile.hs view
@@ -0,0 +1,155 @@+{-# 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) ]+      bad = minimalAst [ ("resolved", Left "https://nohash") ]+  astToPackageSuccess good+    <&> T.remote >>= \case+      T.FileRemote{..} -> assertEqual "file sha" sha fileSha1+      a -> assertFailure ("should be FileRemote, is " <> show a)+  astToPackageFailureWith (pure File.UnknownRemoteType) bad++case_missingField :: Assertion+case_missingField = do+  astToPackageFailureWith+    (File.MissingField "version"+     NE.:| [File.UnknownRemoteType]) $ emptyAst []++-- will be in protolude soon+infixl 4 <&>+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = flip fmap++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)+
− tests/TestLock.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE OverloadedStrings, TemplateHaskell, NamedFieldPuns, ViewPatterns, NoImplicitPrelude #-}-module TestLock (tests) where--import Protolude-import Yarn.Lock-import Data.MultiKeyedMap hiding (keys)-import Test.Tasty (TestTree)-import Test.Tasty.TH-import Test.Tasty.HUnit-import qualified Text.Show as S-import qualified Text.PrettyPrint.ANSI.Leijen as Pr-import qualified Data.Map.Strict as M--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 }-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--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--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)---- lfBuilt :: Lockfile -> [Built]--- lfBuilt = buildFromMap . flattenKeys--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)
+ tests/TestMultiKeyedMap.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, NamedFieldPuns, ViewPatterns, NoImplicitPrelude #-}+module TestMultiKeyedMap (tests) where++import Protolude+import qualified Data.List as List+import Test.Tasty (TestTree)+import Test.Tasty.TH+import Test.Tasty.QuickCheck++import qualified Data.MultiKeyedMap as MKM++emptyMkm :: (Ord k) => MKM.MKMap k v+emptyMkm = MKM.mkMKMap (Proxy :: Proxy Int)++fromList :: [([Int], v)] -> MKM.MKMap Int v+fromList = MKM.fromList (Proxy :: Proxy Int)++prop_equality :: Property+prop_equality =+  forAll (resize 5 arbitrary :: Gen [([Int], Int)])+    $ \map1 -> forAll (resize 2 arbitrary :: Gen [([Int], Int)])+    $ \map2 ->+        -- fromList drops empty keys, the right side would be different+        keysNotEmpty map1 ==> keysNotEmpty map2 ==>+        -- equality of contents also applies to the MKM+        (map1 == map2) === (fromList map1 == fromList map2)+        -- force the contents to be the same, should always be equal+  where+    keysNotEmpty = all (\(ks, _) -> ks /= [])++-- | inserting the same value is idempotent+prop_insertIdempotent :: Int -> Int -> Property+prop_insertIdempotent key val = do+  let insVal = MKM.insert key val+  (insVal emptyMkm) === (insVal (insVal emptyMkm))++prop_fromList_emptyKeyList :: Int -> ([Int], Int) -> Property+prop_fromList_emptyKeyList val el = do+  fromList [([], val), el, ([], val)] === fromList [el]++-- | inserting the same values in a different order+-- results in the same map+prop_insertShuffled :: [(Int, Int)] -> Property+prop_insertShuffled xs =+  let xs' = List.nubBy ((==) `on` fst) xs+      insVals = foldl' (\m (k, v) -> MKM.insert k v m) emptyMkm+  in forAll (shuffle xs')+    $ \ys -> insVals xs' === insVals ys++tests :: TestTree+tests = $(testGroupGenerator)
+ tests/TestParse.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, NamedFieldPuns, ViewPatterns, NoImplicitPrelude #-}+module TestParse (tests) where++import Protolude+import qualified Data.Map as Map+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++-- 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"))++nestedPackage :: Text+nestedPackage = [text|+  readable-stream@1.0, "readable-stream@>=1.0.33-1 <1.1.0-0":+    dependencies:+      core-util-is "~1.0.0"+      is.array ""+      string_decoder "~0.10.x"+      johnny-dep 2.3.4+  |]++case_NestedPackage :: Assertion+case_NestedPackage = do+  assertBool "there is unicode" (all Ch.isAscii (toS nestedPackage :: [Char]))+  parseSuccess packageEntry nestedPackage+    >>= \(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 ++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@:\n"+  parseSuccess packageKeys key+    >>= \keys -> do+      keys @=? [ PackageKey "foo" "^1.3.4"+               , PackageKey "bar" "blafoo234"+               -- yes, the version can be empty …+               , PackageKey "xnu" ""]++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)
yarn-lock.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.17.0.+-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack  name:           yarn-lock-version:        0.2.0+version:        0.3.1 synopsis:       Represent and parse yarn.lock files-description:    Types and parser for the lock file format of the npm successor yarn.+description:    Types and parser for the lock file format of the npm successor yarn. All modules should be imported qualified. category:       Data homepage:       https://github.com/Profpatsch/yarn-lock#readme bug-reports:    https://github.com/Profpatsch/yarn-lock/issues@@ -28,14 +28,21 @@       src   ghc-options: -Wall   build-depends:-      base == 4.*+      base >= 4.9 && < 4.10     , containers     , text-    , megaparsec == 5.*+    , megaparsec == 5.* || == 6.*     , protolude >= 0.1+    , either == 4.*   exposed-modules:       Data.MultiKeyedMap       Yarn.Lock+      Yarn.Lock.File+      Yarn.Lock.Helpers+      Yarn.Lock.Parse+      Yarn.Lock.Types+  other-modules:+      Paths_yarn_lock   default-language: Haskell2010  test-suite yarn-lock-tests@@ -45,17 +52,22 @@       tests   ghc-options: -Wall   build-depends:-      base == 4.*+      base >= 4.9 && < 4.10     , containers     , text-    , megaparsec == 5.*+    , megaparsec == 5.* || == 6.*     , protolude >= 0.1+    , either == 4.*     , yarn-lock     , ansi-wl-pprint >= 0.6     , tasty >= 0.11     , tasty-th >= 0.1.7     , tasty-hunit >= 0.9+    , tasty-quickcheck >= 0.8     , protolude+    , neat-interpolation >= 0.3   other-modules:-      TestLock+      TestFile+      TestMultiKeyedMap+      TestParse   default-language: Haskell2010