packages feed

yarn-lock 0.1.0 → 0.2.0

raw patch · 6 files changed

+317/−9 lines, 6 filesdep +ansi-wl-pprintdep +tastydep +tasty-hunitdep ~basedep ~protolude

Dependencies added: ansi-wl-pprint, tasty, tasty-hunit, tasty-th, yarn-lock

Dependency ranges changed: base, protolude

Files

+ CHANGELOG.md view
@@ -0,0 +1,25 @@+# Changelog++All notable changes to this project will be documented in this file.++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++### 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`++
+ src/Data/MultiKeyedMap.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE ExistentialQuantification, NamedFieldPuns, ScopedTypeVariables #-}+{-|+Module : Data.MultiKeyedMap+Description : A multi-keyed map.+Maintainer : Profpatsch+Stability : experimental+-}+module Data.MultiKeyedMap+( MKMap+, at, (!)+, mkMKMap, fromList, toList+, insert+, flattenKeys, keys, values+) where++import qualified Data.Map.Strict as M+import Data.Monoid (All(..))+import qualified Data.List as L+import Data.Proxy (Proxy(..))+import qualified Data.Tuple as T+import qualified Text.Show as Show++-- TODO: add time behaviour of functions to docstrings++-- | A `Map`-like structure where multiple keys can point+--   to the same value, with corresponding abstracted interface.+--+-- 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').+data MKMap k v = forall ik. (Ord ik, Enum ik)+              => MKMap+                 { keyMap :: M.Map k ik+                 , highestIk :: ik+                 , valMap :: M.Map ik v }++-- TODO: is it possible without (Ord k)?+instance (Eq k, Ord k, Eq v) => Eq (MKMap k v) where+  -- TODO: not sure if that’s correct, add tests+  (==) m1@(MKMap { keyMap = km1+                 , valMap = vm1 })+       m2@(MKMap { keyMap = km2+                 , valMap = vm2 })+    = getAll $ foldMap All+        $ let ks1 = M.keys km1 in+        -- shortcut if the length of the value map is not equal+        [ length vm1 == length vm2+        -- the keys have to be equal (the lists are ascending)+        ,        ks1 == M.keys km2 ]+        -- now test whether every key leads to the same value+        -- I wonder if there is a more efficient way?+        ++ map (\k -> m1 ! k == m2 ! k) ks1+        -- we could test whether the values are equal,+        -- but if the implementation is correct they should+        -- all be reachable from the keys (TODO: add invariants)+   -- TODO: can (/=) be implemented more efficient than not.(==)?++-- | 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)+-- | Operator alias of 'at'.+(!) :: (Ord k) => MKMap k v -> k -> v+(!) = at+{-# INLINABLE (!) #-}+{-# INLINABLE at #-}+infixl 9 !++-- | Create a 'MKMap' given a type for the internally used intermediate key.+mkMKMap :: forall k ik v. (Ord k, Ord ik, Enum ik, Bounded ik)+        => (Proxy ik) -- ^ type of intermediate key+        -> MKMap k v -- ^ new map+mkMKMap _ = MKMap mempty (minBound :: ik) mempty++instance (Show k, Show v) => Show (MKMap k v) where+  showsPrec d m = Show.showString "fromList " . (showsPrec d $ toList m)++-- | Build a map from a list of key\/value pairs.+fromList :: forall ik k v. (Ord k, Ord ik, Enum ik, Bounded ik)+         => (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)++-- | Convert the map to a list of key\/value pairs.+toList :: MKMap k v -> [([k], v)]+toList MKMap{keyMap, valMap} =+  map (fmap (valMap M.!) . T.swap) . M.assocs . aggregateIk $ keyMap+    where aggregateIk = M.foldlWithKey+            (\m k ik -> M.insertWith (++) ik [k] m) mempty++-- | “Unlink” keys that are pointing to the same value.+--+-- Returns a normal map.+flattenKeys :: (Ord k) => MKMap k v -> M.Map k v+flattenKeys MKMap{keyMap, valMap} =+  M.foldlWithKey' (\m k ik -> M.insert k (valMap M.! ik) m) mempty keyMap++-- | Return a list of all keys.+keys :: (Ord k) => MKMap k v -> [k]+keys = M.keys . flattenKeys++-- | Return a list of all values.+values :: MKMap k v -> [v]+values (MKMap _ _ valMap) = M.elems valMap++-- TODO: this is like normal insert, it doesn’t search if the value+-- already exists (where it might want to add the key instead).+-- Of course that would be O(n) in the naive implementation.+-- In that case the keyMap should probably be changed to a bimap.+-- also, naming+-- | Equivalent to 'M.insert', if the key doesn’t exist a new+-- singleton key is added.+insert :: (Ord k) => k -> v -> MKMap k v -> MKMap k v+insert k v m@MKMap{keyMap, highestIk, valMap} =+  maybe ins upd $ M.lookup k keyMap+  where+    ins = newVal [k] v m+    upd ik = MKMap { keyMap, highestIk, valMap = M.insert ik v valMap }+++-- | helper, assumes there is no such value already+--+-- Will leak space otherwise!+newVal :: (Ord k) => [k] -> v -> MKMap k v -> MKMap k v+newVal ks v MKMap{keyMap, highestIk, valMap} =+  MKMap { keyMap = L.foldl' (\m k -> M.insert k next m) keyMap ks+        , highestIk = next+        , valMap = M.insert next v valMap }+  where next = succ highestIk
src/Yarn/Lock.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving #-} {-| Module : Yarn.Lock Description : Parser & Types for yarn.lock files@@ -16,6 +16,7 @@ ( Lockfile, PackageKey(..), Package(..), RemoteFile(..) , PackageEntry, PackageList , Yarn.Lock.parse+, decycle -- | = Parsers , lockfile , packageListToLockfile, packageList@@ -23,16 +24,30 @@ ) 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 qualified Data.Text as T -import qualified Data.Map.Strict as M+import qualified Data.MultiKeyedMap as MKM+import Data.Proxy (Proxy(..))  -- | Yarn lockfile.-type Lockfile = M.Map PackageKey Package+--+-- 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@@ -77,6 +92,34 @@ --                                    == 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.@@ -90,8 +133,10 @@ -- -- This should press it into our Lockfile Map. packageListToLockfile :: PackageList -> Lockfile-packageListToLockfile = foldl' go mempty-  where go lf (keys, pkg) = foldl' (\lf' key' -> M.insert key' pkg lf') lf keys+packageListToLockfile = MKM.fromList lockfileIkProxy++  -- foldl' go mempty+  -- where go lf (keys, pkg) = foldl' (\lf' key' -> M.insert key' pkg lf') lf keys  -- | Parse a complete yarn.lock into exaclty the same representation. --
+ tests/Test.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.Tasty+import qualified TestLock as TL++main = defaultMain TL.tests
+ tests/TestLock.hs view
@@ -0,0 +1,76 @@+{-# 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)
yarn-lock.cabal view
@@ -3,12 +3,12 @@ -- see: https://github.com/sol/hpack  name:           yarn-lock-version:        0.1.0+version:        0.2.0 synopsis:       Represent and parse yarn.lock files description:    Types and parser for the lock file format of the npm successor yarn. category:       Data-homepage:       https://github.com/Profpatsch/yaml-lock#readme-bug-reports:    https://github.com/Profpatsch/yaml-lock/issues+homepage:       https://github.com/Profpatsch/yarn-lock#readme+bug-reports:    https://github.com/Profpatsch/yarn-lock/issues author:         Profpatsch maintainer:     mail@profpatsch.de license:        MIT@@ -16,9 +16,12 @@ build-type:     Simple cabal-version:  >= 1.10 +extra-source-files:+    CHANGELOG.md+ source-repository head   type: git-  location: https://github.com/Profpatsch/yaml-lock+  location: https://github.com/Profpatsch/yarn-lock  library   hs-source-dirs:@@ -31,5 +34,28 @@     , megaparsec == 5.*     , protolude >= 0.1   exposed-modules:+      Data.MultiKeyedMap       Yarn.Lock+  default-language: Haskell2010++test-suite yarn-lock-tests+  type: exitcode-stdio-1.0+  main-is: Test.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall+  build-depends:+      base == 4.*+    , containers+    , text+    , megaparsec == 5.*+    , protolude >= 0.1+    , yarn-lock+    , ansi-wl-pprint >= 0.6+    , tasty >= 0.11+    , tasty-th >= 0.1.7+    , tasty-hunit >= 0.9+    , protolude+  other-modules:+      TestLock   default-language: Haskell2010