{-# LANGUAGE NoImplicitPrelude, LambdaCase, OverloadedStrings, RecordWildCards #-}
{-|
Module : Yarn.Lock
Description : High-level parser of yarn.lock files
Maintainer : Profpatsch
Stability : experimental

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.
-}
module Yarn.Lock
( T.Lockfile
, parseFile, parse
-- * Errors
, prettyLockfileError
, LockfileError(..), PackageErrorInfo(..)
) where

import Protolude hiding ((<>))
import Data.Semigroup ((<>))
import qualified Data.Text as T
import qualified Data.List.NonEmpty as NE
import qualified Text.Megaparsec as MP
import qualified Data.Either.Validation as V

import qualified Yarn.Lock.Types as T
import qualified Yarn.Lock.File as File
import qualified Yarn.Lock.Parse as Parse

-- | 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 (Int -> LockfileError -> ShowS
[LockfileError] -> ShowS
LockfileError -> String
(Int -> LockfileError -> ShowS)
-> (LockfileError -> String)
-> ([LockfileError] -> ShowS)
-> Show LockfileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LockfileError] -> ShowS
$cshowList :: [LockfileError] -> ShowS
show :: LockfileError -> String
$cshow :: LockfileError -> String
showsPrec :: Int -> LockfileError -> ShowS
$cshowsPrec :: Int -> LockfileError -> ShowS
Show, LockfileError -> LockfileError -> Bool
(LockfileError -> LockfileError -> Bool)
-> (LockfileError -> LockfileError -> Bool) -> Eq LockfileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockfileError -> LockfileError -> Bool
$c/= :: LockfileError -> LockfileError -> Bool
== :: LockfileError -> LockfileError -> Bool
$c== :: LockfileError -> LockfileError -> Bool
Eq)

-- | Information about package parsing errors.
data PackageErrorInfo = PackageErrorInfo
  { PackageErrorInfo -> SourcePos
srcPos :: MP.SourcePos
  -- ^ the position of the package in the original file
  , PackageErrorInfo -> NonEmpty ConversionError
convErrs :: NE.NonEmpty File.ConversionError
  -- ^ list of reasons for failure
  } deriving (Int -> PackageErrorInfo -> ShowS
[PackageErrorInfo] -> ShowS
PackageErrorInfo -> String
(Int -> PackageErrorInfo -> ShowS)
-> (PackageErrorInfo -> String)
-> ([PackageErrorInfo] -> ShowS)
-> Show PackageErrorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageErrorInfo] -> ShowS
$cshowList :: [PackageErrorInfo] -> ShowS
show :: PackageErrorInfo -> String
$cshow :: PackageErrorInfo -> String
showsPrec :: Int -> PackageErrorInfo -> ShowS
$cshowsPrec :: Int -> PackageErrorInfo -> ShowS
Show, PackageErrorInfo -> PackageErrorInfo -> Bool
(PackageErrorInfo -> PackageErrorInfo -> Bool)
-> (PackageErrorInfo -> PackageErrorInfo -> Bool)
-> Eq PackageErrorInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageErrorInfo -> PackageErrorInfo -> Bool
$c/= :: PackageErrorInfo -> PackageErrorInfo -> Bool
== :: PackageErrorInfo -> PackageErrorInfo -> Bool
$c== :: PackageErrorInfo -> PackageErrorInfo -> Bool
Eq)

-- | Convenience function, combining all parsing steps.
--
-- The resulting 'Lockfile' structure might not yet be optimal,
-- see 'File.fromPackages'.
parseFile :: FilePath -- ^ file to read
          -> IO (Either LockfileError T.Lockfile)
parseFile :: String -> IO (Either LockfileError Lockfile)
parseFile String
fp = String -> IO Text
readFile String
fp IO Text
-> (Text -> IO (Either LockfileError Lockfile))
-> IO (Either LockfileError Lockfile)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either LockfileError Lockfile -> IO (Either LockfileError Lockfile)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LockfileError Lockfile
 -> IO (Either LockfileError Lockfile))
-> (Text -> Either LockfileError Lockfile)
-> Text
-> IO (Either LockfileError Lockfile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Either LockfileError Lockfile
parse String
fp

-- | 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 :: String -> Text -> Either LockfileError Lockfile
parse String
fp = String -> Text -> Either LockfileError [Package]
astParse String
fp (Text -> Either LockfileError [Package])
-> ([Package] -> Either LockfileError Lockfile)
-> Text
-> Either LockfileError Lockfile
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Package] -> Either LockfileError [Keyed Package]
toPackages ([Package] -> Either LockfileError [Keyed Package])
-> ([Keyed Package] -> Either LockfileError Lockfile)
-> [Package]
-> Either LockfileError Lockfile
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Keyed Package] -> Either LockfileError Lockfile
toLockfile

-- | Pretty print a parsing error with sane default formatting.
prettyLockfileError :: LockfileError -> Text
prettyLockfileError :: LockfileError -> Text
prettyLockfileError = \case
  (ParseError Text
t) -> Text
"Error while parsing the yarn.lock:\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines (Int -> [Text] -> [Text]
forall (f :: * -> *). Functor f => Int -> f Text -> f Text
indent Int
2 (Text -> [Text]
T.lines Text
t))
  (PackageErrors NonEmpty PackageErrorInfo
errs) -> Text
"Some packages could not be made sense of:\n"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> NonEmpty Text -> NonEmpty Text
forall (f :: * -> *). Functor f => Int -> f Text -> f Text
indent Int
2 (NonEmpty (NonEmpty Text) -> NonEmpty Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty (NonEmpty Text) -> NonEmpty Text)
-> NonEmpty (NonEmpty Text) -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ (PackageErrorInfo -> NonEmpty Text)
-> NonEmpty PackageErrorInfo -> NonEmpty (NonEmpty Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageErrorInfo -> NonEmpty Text
errText NonEmpty PackageErrorInfo
errs))
  where
    indent :: Functor f => Int -> f Text -> f Text
    indent :: Int -> f Text -> f Text
indent Int
i = (Text -> Text) -> f Text -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.replicate Int
i Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
    errText :: PackageErrorInfo -> NonEmpty Text
errText (PackageErrorInfo{NonEmpty ConversionError
SourcePos
convErrs :: NonEmpty ConversionError
srcPos :: SourcePos
convErrs :: PackageErrorInfo -> NonEmpty ConversionError
srcPos :: PackageErrorInfo -> SourcePos
..}) =
      (Text -> NonEmpty Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> NonEmpty Text) -> Text -> NonEmpty Text
forall a b. (a -> b) -> a -> b
$ Text
"Package at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
MP.sourcePosPretty SourcePos
srcPos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":")
      NonEmpty Text -> NonEmpty Text -> NonEmpty Text
forall a. Semigroup a => a -> a -> a
<> Int -> NonEmpty Text -> NonEmpty Text
forall (f :: * -> *). Functor f => Int -> f Text -> f Text
indent Int
2 ((ConversionError -> Text)
-> NonEmpty ConversionError -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConversionError -> Text
convErrText NonEmpty ConversionError
convErrs)
    convErrText :: ConversionError -> Text
convErrText = \case
      (File.MissingField Text
t) -> Text
"Field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
qu Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is missing."
      (File.WrongType{Text
fieldType :: ConversionError -> Text
fieldName :: ConversionError -> Text
fieldType :: Text
fieldName :: Text
..})  -> Text
"Field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
qu Text
fieldName
                               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" should be of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      (ConversionError
File.UnknownRemoteType) -> Text
"We don’t know this remote type."
    qu :: a -> a
qu a
t = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""

-- helpers
astParse :: FilePath -> Text -> Either LockfileError [Parse.Package]
astParse :: String -> Text -> Either LockfileError [Package]
astParse String
fp = (ParseErrorBundle Text Void -> LockfileError)
-> Either (ParseErrorBundle Text Void) [Package]
-> Either LockfileError [Package]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> LockfileError
ParseError (Text -> LockfileError)
-> (ParseErrorBundle Text Void -> Text)
-> ParseErrorBundle Text Void
-> LockfileError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertText a b => a -> b
toS (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty)
                (Either (ParseErrorBundle Text Void) [Package]
 -> Either LockfileError [Package])
-> (Text -> Either (ParseErrorBundle Text Void) [Package])
-> Text
-> Either LockfileError [Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text [Package]
-> String -> Text -> Either (ParseErrorBundle Text Void) [Package]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text [Package]
Parse.packageList String
fp

toPackages :: [Parse.Package] -> Either LockfileError [T.Keyed T.Package]
toPackages :: [Package] -> Either LockfileError [Keyed Package]
toPackages = (NonEmpty PackageErrorInfo -> LockfileError)
-> Either (NonEmpty PackageErrorInfo) [Keyed Package]
-> Either LockfileError [Keyed Package]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first NonEmpty PackageErrorInfo -> LockfileError
PackageErrors (Either (NonEmpty PackageErrorInfo) [Keyed Package]
 -> Either LockfileError [Keyed Package])
-> ([Package]
    -> Either (NonEmpty PackageErrorInfo) [Keyed Package])
-> [Package]
-> Either LockfileError [Keyed Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation (NonEmpty PackageErrorInfo) [Keyed Package]
-> Either (NonEmpty PackageErrorInfo) [Keyed Package]
forall e a. Validation e a -> Either e a
V.validationToEither
                (Validation (NonEmpty PackageErrorInfo) [Keyed Package]
 -> Either (NonEmpty PackageErrorInfo) [Keyed Package])
-> ([Package]
    -> Validation (NonEmpty PackageErrorInfo) [Keyed Package])
-> [Package]
-> Either (NonEmpty PackageErrorInfo) [Keyed Package]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Package -> Validation (NonEmpty PackageErrorInfo) (Keyed Package))
-> [Package]
-> Validation (NonEmpty PackageErrorInfo) [Keyed Package]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Package -> Validation (NonEmpty PackageErrorInfo) (Keyed Package)
validatePackage

validatePackage :: Parse.Package
                -> V.Validation (NE.NonEmpty PackageErrorInfo) (T.Keyed T.Package)
validatePackage :: Package -> Validation (NonEmpty PackageErrorInfo) (Keyed Package)
validatePackage (T.Keyed NonEmpty PackageKey
keys (SourcePos
pos, PackageFields
fields)) = Either (NonEmpty PackageErrorInfo) (Keyed Package)
-> Validation (NonEmpty PackageErrorInfo) (Keyed Package)
forall e a. Either e a -> Validation e a
V.eitherToValidation
  (Either (NonEmpty PackageErrorInfo) (Keyed Package)
 -> Validation (NonEmpty PackageErrorInfo) (Keyed Package))
-> Either (NonEmpty PackageErrorInfo) (Keyed Package)
-> Validation (NonEmpty PackageErrorInfo) (Keyed Package)
forall a b. (a -> b) -> a -> b
$ (NonEmpty ConversionError -> NonEmpty PackageErrorInfo)
-> (Package -> Keyed Package)
-> Either (NonEmpty ConversionError) Package
-> Either (NonEmpty PackageErrorInfo) (Keyed Package)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (PackageErrorInfo -> NonEmpty PackageErrorInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageErrorInfo -> NonEmpty PackageErrorInfo)
-> (NonEmpty ConversionError -> PackageErrorInfo)
-> NonEmpty ConversionError
-> NonEmpty PackageErrorInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> NonEmpty ConversionError -> PackageErrorInfo
PackageErrorInfo SourcePos
pos) (NonEmpty PackageKey -> Package -> Keyed Package
forall a. NonEmpty PackageKey -> a -> Keyed a
T.Keyed NonEmpty PackageKey
keys)
    (Either (NonEmpty ConversionError) Package
 -> Either (NonEmpty PackageErrorInfo) (Keyed Package))
-> Either (NonEmpty ConversionError) Package
-> Either (NonEmpty PackageErrorInfo) (Keyed Package)
forall a b. (a -> b) -> a -> b
$ PackageFields -> Either (NonEmpty ConversionError) Package
File.astToPackage PackageFields
fields

toLockfile :: [T.Keyed T.Package] -> Either LockfileError T.Lockfile
toLockfile :: [Keyed Package] -> Either LockfileError Lockfile
toLockfile = Lockfile -> Either LockfileError Lockfile
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lockfile -> Either LockfileError Lockfile)
-> ([Keyed Package] -> Lockfile)
-> [Keyed Package]
-> Either LockfileError Lockfile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Keyed Package] -> Lockfile
File.fromPackages