{-# LANGUAGE NoImplicitPrelude, GeneralizedNewtypeDeriving, OverloadedStrings #-}
{-|
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, nestedField, simpleField
, packageKeys
) where

import Protolude hiding (try, some, many)
import qualified Data.Char as Ch
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import Control.Monad (fail)

import Text.Megaparsec as MP
import qualified Text.Megaparsec.Char as MP
import qualified Text.Megaparsec.Char.Lexer as MPL

-- import qualified Data.MultiKeyedMap as MKM
-- import Data.Proxy (Proxy(..))

import qualified Yarn.Lock.Types as YLT


-- | We use a simple (pure) @Megaparsec@ parser.
type Parser = Parsec Void Text

-- | 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 (Int -> PackageFields -> ShowS
[PackageFields] -> ShowS
PackageFields -> String
(Int -> PackageFields -> ShowS)
-> (PackageFields -> String)
-> ([PackageFields] -> ShowS)
-> Show PackageFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageFields] -> ShowS
$cshowList :: [PackageFields] -> ShowS
show :: PackageFields -> String
$cshow :: PackageFields -> String
showsPrec :: Int -> PackageFields -> ShowS
$cshowsPrec :: Int -> PackageFields -> ShowS
Show, PackageFields -> PackageFields -> Bool
(PackageFields -> PackageFields -> Bool)
-> (PackageFields -> PackageFields -> Bool) -> Eq PackageFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageFields -> PackageFields -> Bool
$c/= :: PackageFields -> PackageFields -> Bool
== :: PackageFields -> PackageFields -> Bool
$c== :: PackageFields -> PackageFields -> Bool
Eq, b -> PackageFields -> PackageFields
NonEmpty PackageFields -> PackageFields
PackageFields -> PackageFields -> PackageFields
(PackageFields -> PackageFields -> PackageFields)
-> (NonEmpty PackageFields -> PackageFields)
-> (forall b. Integral b => b -> PackageFields -> PackageFields)
-> Semigroup PackageFields
forall b. Integral b => b -> PackageFields -> PackageFields
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PackageFields -> PackageFields
$cstimes :: forall b. Integral b => b -> PackageFields -> PackageFields
sconcat :: NonEmpty PackageFields -> PackageFields
$csconcat :: NonEmpty PackageFields -> PackageFields
<> :: PackageFields -> PackageFields -> PackageFields
$c<> :: PackageFields -> PackageFields -> PackageFields
Semigroup, Semigroup PackageFields
PackageFields
Semigroup PackageFields
-> PackageFields
-> (PackageFields -> PackageFields -> PackageFields)
-> ([PackageFields] -> PackageFields)
-> Monoid PackageFields
[PackageFields] -> PackageFields
PackageFields -> PackageFields -> PackageFields
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PackageFields] -> PackageFields
$cmconcat :: [PackageFields] -> PackageFields
mappend :: PackageFields -> PackageFields -> PackageFields
$cmappend :: PackageFields -> PackageFields -> PackageFields
mempty :: PackageFields
$cmempty :: PackageFields
$cp1Monoid :: Semigroup PackageFields
Monoid)

-- | A parsed 'Package' AST has one or more keys, a position in the original files
-- and a collection of fields.
type Package = YLT.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 :: Parser [Package]
packageList = ParsecT Void Text Identity Package -> Parser [Package]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (ParsecT Void Text Identity Package -> Parser [Package])
-> ParsecT Void Text Identity Package -> Parser [Package]
forall a b. (a -> b) -> a -> b
$ (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT Void Text Identity Text
Parser (Tokens Text)
comment ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Parser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.string Tokens Text
"\n")) ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Package
-> ParsecT Void Text Identity Package
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Package
packageEntry
                where
                  comment :: Parser (Tokens Text)
                  comment :: Parser (Tokens Text)
comment = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')

-- | 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 (YLT.Keyed (SourcePos, PackageFields))
packageEntry :: ParsecT Void Text Identity Package
packageEntry = String
-> ParsecT Void Text Identity Package
-> ParsecT Void Text Identity Package
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"package entry" (ParsecT Void Text Identity Package
 -> ParsecT Void Text Identity Package)
-> ParsecT Void Text Identity Package
-> ParsecT Void Text Identity Package
forall a b. (a -> b) -> a -> b
$ do
  SourcePos
pos <- ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  -- A package entry is a non-indented
  (NonEmpty PackageKey
keys, PackageFields
pkgs) <- Parser (NonEmpty PackageKey, PackageFields)
-> Parser (NonEmpty PackageKey, PackageFields)
forall a. Parser a -> Parser a
nonIndented
            -- block that has a header of package keys
            -- and an indented part that contains fields
            (Parser (NonEmpty PackageKey, PackageFields)
 -> Parser (NonEmpty PackageKey, PackageFields))
-> Parser (NonEmpty PackageKey, PackageFields)
-> Parser (NonEmpty PackageKey, PackageFields)
forall a b. (a -> b) -> a -> b
$ Parser (NonEmpty PackageKey)
-> Parser (NonEmpty PackageKey, PackageFields)
forall a. Parser a -> Parser (a, PackageFields)
indentedFieldsWithHeader Parser (NonEmpty PackageKey)
packageKeys
  Package -> ParsecT Void Text Identity Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Package -> ParsecT Void Text Identity Package)
-> Package -> ParsecT Void Text Identity Package
forall a b. (a -> b) -> a -> b
$ NonEmpty PackageKey -> (SourcePos, PackageFields) -> Package
forall a. NonEmpty PackageKey -> a -> Keyed a
YLT.Keyed NonEmpty PackageKey
keys (SourcePos
pos, PackageFields
pkgs)

-- | The list of PackageKeys that index the same Package
--
-- @
-- align-text@^0.1.1, align-text@^0.1.3:\\n
-- @
packageKeys :: Parser (NE.NonEmpty YLT.PackageKey)
packageKeys :: Parser (NonEmpty PackageKey)
packageKeys = String
-> Parser (NonEmpty PackageKey) -> Parser (NonEmpty PackageKey)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"package keys" (Parser (NonEmpty PackageKey) -> Parser (NonEmpty PackageKey))
-> Parser (NonEmpty PackageKey) -> Parser (NonEmpty PackageKey)
forall a b. (a -> b) -> a -> b
$ do
  [PackageKey]
firstEls <- ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity [PackageKey]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity PackageKey
 -> ParsecT Void Text Identity PackageKey)
-> ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity PackageKey
 -> ParsecT Void Text Identity PackageKey)
-> ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Void Text Identity PackageKey
packageKey String
":," ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity PackageKey
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token Text
',')
  PackageKey
lastEl   <-                      String -> ParsecT Void Text Identity PackageKey
packageKey String
":"  ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity PackageKey
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token Text
':'
  NonEmpty PackageKey -> Parser (NonEmpty PackageKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty PackageKey -> Parser (NonEmpty PackageKey))
-> NonEmpty PackageKey -> Parser (NonEmpty PackageKey)
forall a b. (a -> b) -> a -> b
$ [PackageKey] -> NonEmpty PackageKey
forall a. [a] -> NonEmpty a
NE.fromList ([PackageKey] -> NonEmpty PackageKey)
-> [PackageKey] -> NonEmpty PackageKey
forall a b. (a -> b) -> a -> b
$ [PackageKey]
firstEls [PackageKey] -> [PackageKey] -> [PackageKey]
forall a. Semigroup a => a -> a -> a
<> [PackageKey
lastEl]

-- | A packageKey is @\<package-name\>\@\<semver\>@;
--
-- If the semver contains spaces, it is also quoted with @"@.
packageKey :: [Char] -> Parser YLT.PackageKey
packageKey :: String -> ParsecT Void Text Identity PackageKey
packageKey String
separators = ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall a. Parser a -> Parser a
inString (String -> ParsecT Void Text Identity PackageKey
pkgKey String
"\"")
         -- if no string delimiters is used we need to check for the separators
         -- this file format is shit :<
         ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Void Text Identity PackageKey
pkgKey String
separators
         ParsecT Void Text Identity PackageKey
-> String -> ParsecT Void Text Identity PackageKey
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"package key"
  where
    pkgKey :: [Char] -> Parser YLT.PackageKey
    pkgKey :: String -> ParsecT Void Text Identity PackageKey
pkgKey String
valueChars = String
-> ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"package key" (ParsecT Void Text Identity PackageKey
 -> ParsecT Void Text Identity PackageKey)
-> ParsecT Void Text Identity PackageKey
-> ParsecT Void Text Identity PackageKey
forall a b. (a -> b) -> a -> b
$ do
      Text
key <- ParsecT Void Text Identity Char -> ParsecT Void Text Identity Text
someTextOf ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.noneOf String
[Token Text]
valueChars)
      -- okay, here’s the rub:
      -- `@` is used for separation, but package names can also
      -- start with the `@` character (so-called “scoped packages”).
      -- Furthermore, versions can contain `@` as well.
      -- This file format is a pile of elephant shit.
      case Char -> Text -> (Text, Text)
breakDrop Char
'@' Text
key of
        (Text
"", Text
rest) -> case Char -> Text -> (Text, Text)
breakDrop Char
'@' Text
rest of
          -- scoped key with empty name
          (Text
"", Text
_) -> Text -> ParsecT Void Text Identity PackageKey
forall a. Text -> Parser a
emptyKeyErr Text
key
          -- scoped key ("@scope/package")
          (Text
scopedName, Text
ver) -> PackageKeyName -> Text -> PackageKey
YLT.PackageKey
            (PackageKeyName -> Text -> PackageKey)
-> ParsecT Void Text Identity PackageKeyName
-> ParsecT Void Text Identity (Text -> PackageKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Void Text Identity PackageKeyName
forall (m :: * -> *). MonadFail m => Text -> m PackageKeyName
scoped (Char -> Text -> Text
T.cons Char
'@' Text
scopedName) ParsecT Void Text Identity (Text -> PackageKey)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity PackageKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ver
        -- just a simple key
        (Text
name, Text
ver) -> PackageKey -> ParsecT Void Text Identity PackageKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageKey -> ParsecT Void Text Identity PackageKey)
-> PackageKey -> ParsecT Void Text Identity PackageKey
forall a b. (a -> b) -> a -> b
$ PackageKeyName -> Text -> PackageKey
YLT.PackageKey (Text -> PackageKeyName
YLT.SimplePackageKey Text
name) Text
ver

    emptyKeyErr :: Text -> Parser a
    emptyKeyErr :: Text -> Parser a
emptyKeyErr Text
key = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String
"packagekey: package name can not be empty (is: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertText a b => a -> b
toS Text
key String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")

    -- | Like 'T.breakOn', but drops the separator char.
    breakDrop :: Char -> Text -> (Text, Text)
    breakDrop :: Char -> Text -> (Text, Text)
breakDrop Char
c Text
str = case Text -> Text -> (Text, Text)
T.breakOn (Char -> Text
T.singleton Char
c) Text
str of
      (Text
s, Text
"") -> (Text
s, Text
"")
      (Text
s, Text
s') -> (Text
s, Int -> Text -> Text
T.drop Int
1 Text
s')

    -- | Parses a (scoped) package key and throws an error if misformatted.
    scoped :: Text -> m PackageKeyName
scoped Text
n = m PackageKeyName
-> (PackageKeyName -> m PackageKeyName)
-> Maybe PackageKeyName
-> m PackageKeyName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (String -> m PackageKeyName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m PackageKeyName) -> String -> m PackageKeyName
forall a b. (a -> b) -> a -> b
$ String
"packageKey: scoped variable must be of form @scope/package"
           String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (is: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertText a b => a -> b
toS Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")
      PackageKeyName -> m PackageKeyName
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PackageKeyName -> m PackageKeyName)
-> Maybe PackageKeyName -> m PackageKeyName
forall a b. (a -> b) -> a -> b
$ Text -> Maybe PackageKeyName
YLT.parsePackageKeyName Text
n

-- | Either a simple or a nested field.
field :: Parser (Text, Either Text PackageFields)
field :: Parser (Text, Either Text PackageFields)
field = Parser (Text, Either Text PackageFields)
-> Parser (Text, Either Text PackageFields)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Text, Either Text PackageFields)
forall a. ParsecT Void Text Identity (Text, Either a PackageFields)
nested Parser (Text, Either Text PackageFields)
-> Parser (Text, Either Text PackageFields)
-> Parser (Text, Either Text PackageFields)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Text, Either Text PackageFields)
forall b. ParsecT Void Text Identity (Text, Either Text b)
simple Parser (Text, Either Text PackageFields)
-> String -> Parser (Text, Either Text PackageFields)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"field"
  where
    simple :: ParsecT Void Text Identity (Text, Either Text b)
simple = (Text -> Either Text b) -> (Text, Text) -> (Text, Either Text b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text b
forall a b. a -> Either a b
Left ((Text, Text) -> (Text, Either Text b))
-> ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Either Text b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Text, Text)
simpleField
    nested :: ParsecT Void Text Identity (Text, Either a PackageFields)
nested = (PackageFields -> Either a PackageFields)
-> (Text, PackageFields) -> (Text, Either a PackageFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageFields -> Either a PackageFields
forall a b. b -> Either a b
Right ((Text, PackageFields) -> (Text, Either a PackageFields))
-> ParsecT Void Text Identity (Text, PackageFields)
-> ParsecT Void Text Identity (Text, Either a PackageFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Text, PackageFields)
nestedField

-- | A key-value pair, separated by space.
-- Key any value may be enclosed in "".
-- Returns key and value.
simpleField :: Parser (Text, Text)
simpleField :: ParsecT Void Text Identity (Text, Text)
simpleField = (,) (Text -> Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> (Text, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
strSymbolChars ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
symbolChars)
                  -- valueChars may be in Strings or maybe not >:
                  -- this file format is absolute garbage
                  ParsecT Void Text Identity (Text -> (Text, Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity Text
strValueChars ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
valueChars)
                  ParsecT Void Text Identity (Text, Text)
-> String -> ParsecT Void Text Identity (Text, Text)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"simple field"
  where
    valueChars, strValueChars :: Parser Text
    valueChars :: ParsecT Void Text Identity Text
valueChars = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Text
someTextOf ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.noneOf (String
"\n\r\"" :: [Char]))
    strSymbolChars :: ParsecT Void Text Identity Text
strSymbolChars = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
inString (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
symbolChars
    strValueChars :: ParsecT Void Text Identity Text
strValueChars = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
inString (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
valueChars
      -- as with packageKey semvers, this can be empty
      ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"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 :: ParsecT Void Text Identity (Text, PackageFields)
nestedField = String
-> ParsecT Void Text Identity (Text, PackageFields)
-> ParsecT Void Text Identity (Text, PackageFields)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"nested field" (ParsecT Void Text Identity (Text, PackageFields)
 -> ParsecT Void Text Identity (Text, PackageFields))
-> ParsecT Void Text Identity (Text, PackageFields)
-> ParsecT Void Text Identity (Text, PackageFields)
forall a b. (a -> b) -> a -> b
$
  ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text, PackageFields)
forall a. Parser a -> Parser (a, PackageFields)
indentedFieldsWithHeader (ParsecT Void Text Identity Text
symbolChars ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token Text
':')


-- 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 :: Parser a -> Parser (a, PackageFields)
indentedFieldsWithHeader Parser a
header = Parser
  (IndentOpt
     Parser (a, PackageFields) (Text, Either Text PackageFields))
-> Parser (a, PackageFields)
forall a b. Parser (IndentOpt Parser a b) -> Parser a
indentBlock (Parser
   (IndentOpt
      Parser (a, PackageFields) (Text, Either Text PackageFields))
 -> Parser (a, PackageFields))
-> Parser
     (IndentOpt
        Parser (a, PackageFields) (Text, Either Text PackageFields))
-> Parser (a, PackageFields)
forall a b. (a -> b) -> a -> b
$ do
    -- … block that has a header of package keys
    a
hdr <- Parser a
header
    -- … and an indented part that contains fields
    IndentOpt
  Parser (a, PackageFields) (Text, Either Text PackageFields)
-> Parser
     (IndentOpt
        Parser (a, PackageFields) (Text, Either Text PackageFields))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt
   Parser (a, PackageFields) (Text, Either Text PackageFields)
 -> Parser
      (IndentOpt
         Parser (a, PackageFields) (Text, Either Text PackageFields)))
-> IndentOpt
     Parser (a, PackageFields) (Text, Either Text PackageFields)
-> Parser
     (IndentOpt
        Parser (a, PackageFields) (Text, Either Text PackageFields))
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([(Text, Either Text PackageFields)]
    -> Parser (a, PackageFields))
-> Parser (Text, Either Text PackageFields)
-> IndentOpt
     Parser (a, PackageFields) (Text, Either Text PackageFields)
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
MPL.IndentSome Maybe Pos
forall a. Maybe a
Nothing
      (\[(Text, Either Text PackageFields)]
fields -> (a, PackageFields) -> Parser (a, PackageFields)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
hdr, [(Text, Either Text PackageFields)] -> PackageFields
toPfs [(Text, Either Text PackageFields)]
fields)) Parser (Text, Either Text PackageFields)
field
  where
    toPfs :: [(Text, Either Text PackageFields)] -> PackageFields
    toPfs :: [(Text, Either Text PackageFields)] -> PackageFields
toPfs = Map Text (Either Text PackageFields) -> PackageFields
PackageFields (Map Text (Either Text PackageFields) -> PackageFields)
-> ([(Text, Either Text PackageFields)]
    -> Map Text (Either Text PackageFields))
-> [(Text, Either Text PackageFields)]
-> PackageFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Either Text PackageFields)]
-> Map Text (Either Text PackageFields)
forall k a. Ord k => [(k, a)] -> Map k a
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.
-- Update: According to https://docs.npmjs.com/misc/scope
-- the package name format is “URL-safe characters, no leading dots or underscores” TODO
symbolChars :: Parser Text
symbolChars :: ParsecT Void Text Identity Text
symbolChars = String
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"key symbol" (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char -> ParsecT Void Text Identity Text
someTextOf (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
MP.satisfy
  (\Token Text
c -> Char -> Bool
Ch.isAscii Char
Token Text
c Bool -> Bool -> Bool
&&
     (Char -> Bool
Ch.isLower Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
Ch.isUpper Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
Ch.isNumber Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
special))
  where special :: String
special = String
"-_.@/" :: [Char]


-- text versions of parsers & helpers

someTextOf :: Parser Char -> Parser Text
someTextOf :: ParsecT Void Text Identity Char -> ParsecT Void Text Identity Text
someTextOf ParsecT Void Text Identity Char
c = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
c

-- | parse everything as inside a string
inString :: Parser a -> Parser a
inString :: Parser a -> Parser a
inString = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token Text
'"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MP.char Char
Token Text
'"')

-- lexers

-- | Parse whitespace.
space :: Parser ()
space :: ParsecT Void Text Identity ()
space = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
MPL.space (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
MP.spaceChar)
                  (Tokens Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
MPL.skipLineComment Tokens Text
"# ")
                  (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
MP.satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
False))

-- | Parse a lexeme.
lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = ParsecT Void Text Identity () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
MPL.lexeme ParsecT Void Text Identity ()
space

-- | Ensure parser is not indented.
nonIndented :: Parser a -> Parser a
nonIndented :: Parser a -> Parser a
nonIndented = ParsecT Void Text Identity () -> Parser a -> Parser a
forall s e (m :: * -> *) a.
(TraversableStream s, MonadParsec e s m) =>
m () -> m a -> m a
MPL.nonIndented ParsecT Void Text Identity ()
space
indentBlock :: Parser (MPL.IndentOpt Parser a b)
            -> Parser a
indentBlock :: Parser (IndentOpt Parser a b) -> Parser a
indentBlock = ParsecT Void Text Identity ()
-> Parser (IndentOpt Parser a b) -> Parser a
forall s e (m :: * -> *) a b.
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () -> m (IndentOpt m a b) -> m a
MPL.indentBlock ParsecT Void Text Identity ()
space