{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards, LambdaCase, TypeApplications #-}
{-|
Description: Parse and make sense of npm’s @package.json@ project files

They are documented on https://docs.npmjs.com/files/package.json and have a few gotchas. Luckily plain JSON, but the interpretation of certain fields is non-trivial (since they contain a lot of “sugar”).
-}
module Distribution.Nodejs.Package
( -- * Parsing @package.json@
  LoggingPackage(..), decode
, Warning(..), formatWarning
  -- * @package.json@ data
, Package(..)
, Bin(..), Man(..), Dependencies
, parsePackageKeyName
) where

import Protolude hiding (packageName)
import Control.Monad (fail)
import qualified Control.Monad.Writer.Lazy as WL
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified System.FilePath as FP

import Data.Aeson ((.:), (.:?), (.!=), Key)
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as AT
import qualified Yarn.Lock.Types as YLT
import qualified Data.Aeson.Key as Key
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KeyMap

-- | npm `package.json`. Not complete.
--
-- See https://docs.npmjs.com/files/package.json
data Package = Package
  { Package -> Text
name :: Text
  , Package -> Text
version :: Text
  , Package -> Maybe Text
description :: Maybe Text
  , Package -> Maybe Text
homepage :: Maybe Text
  , Package -> Bool
private :: Bool
  , Package -> KeyMap Text
scripts :: KeyMap Text
  , Package -> Bin
bin :: Bin
  , Package -> Man
man :: Man
  , Package -> Maybe Text
license :: Maybe Text
  , Package -> KeyMap Text
dependencies :: Dependencies
  , Package -> KeyMap Text
devDependencies :: Dependencies
  } deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq)

-- | 'Package' with a potential bunch of parsing warnings.
-- Note the 'A.FromJson' instance.
newtype LoggingPackage = LoggingPackage
  { LoggingPackage -> (Package, [Warning])
unLoggingPackage :: (Package, [Warning]) }

-- | Possible warnings from parsing.
data Warning
  = WrongType
  { Warning -> Text
wrongTypeField :: Text -- ^ the field which has a wrong type
  , Warning -> Maybe Text
wrongTypeDefault :: Maybe Text -- ^ the default value, if used
  }
  | PlainWarning Text

-- | The package’s executable files.
data Bin
  = BinFiles (KeyMap FilePath)
  -- ^ map of files from name to their file path (relative to package path)
  | BinFolder FilePath
  -- ^ a folder containing all executable files of the project (also relative)
  deriving (Int -> Bin -> ShowS
[Bin] -> ShowS
Bin -> String
(Int -> Bin -> ShowS)
-> (Bin -> String) -> ([Bin] -> ShowS) -> Show Bin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bin] -> ShowS
$cshowList :: [Bin] -> ShowS
show :: Bin -> String
$cshow :: Bin -> String
showsPrec :: Int -> Bin -> ShowS
$cshowsPrec :: Int -> Bin -> ShowS
Show, Bin -> Bin -> Bool
(Bin -> Bin -> Bool) -> (Bin -> Bin -> Bool) -> Eq Bin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bin -> Bin -> Bool
$c/= :: Bin -> Bin -> Bool
== :: Bin -> Bin -> Bool
$c== :: Bin -> Bin -> Bool
Eq)

-- | The package’s manual files.
data Man
  = ManFiles (KeyMap FilePath)
  -- ^ map of files from name to their file path (relative to package path)
  deriving (Int -> Man -> ShowS
[Man] -> ShowS
Man -> String
(Int -> Man -> ShowS)
-> (Man -> String) -> ([Man] -> ShowS) -> Show Man
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Man] -> ShowS
$cshowList :: [Man] -> ShowS
show :: Man -> String
$cshow :: Man -> String
showsPrec :: Int -> Man -> ShowS
$cshowsPrec :: Int -> Man -> ShowS
Show, Man -> Man -> Bool
(Man -> Man -> Bool) -> (Man -> Man -> Bool) -> Eq Man
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Man -> Man -> Bool
$c/= :: Man -> Man -> Bool
== :: Man -> Man -> Bool
$c== :: Man -> Man -> Bool
Eq)

-- | Dependencies of a package.
type Dependencies = KeyMap Text

type Warn = WL.WriterT [Warning] AT.Parser
putWarning :: a -> Warning -> Warn a
putWarning :: a -> Warning -> Warn a
putWarning a
a Warning
w = (a, [Warning]) -> Warn a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
WL.writer (a
a, [Warning
w])

-- | See https://github.com/npm/normalize-package-data for
-- normalization steps used by npm itself.
instance A.FromJSON LoggingPackage where
  parseJSON :: Value -> Parser LoggingPackage
parseJSON = String
-> (Object -> Parser LoggingPackage)
-> Value
-> Parser LoggingPackage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Package" ((Object -> Parser LoggingPackage)
 -> Value -> Parser LoggingPackage)
-> (Object -> Parser LoggingPackage)
-> Value
-> Parser LoggingPackage
forall a b. (a -> b) -> a -> b
$ \Object
v -> ((Package, [Warning]) -> LoggingPackage)
-> Parser (Package, [Warning]) -> Parser LoggingPackage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Package, [Warning]) -> LoggingPackage
LoggingPackage (Parser (Package, [Warning]) -> Parser LoggingPackage)
-> (WriterT [Warning] Parser Package
    -> Parser (Package, [Warning]))
-> WriterT [Warning] Parser Package
-> Parser LoggingPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [Warning] Parser Package -> Parser (Package, [Warning])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WL.runWriterT (WriterT [Warning] Parser Package -> Parser LoggingPackage)
-> WriterT [Warning] Parser Package -> Parser LoggingPackage
forall a b. (a -> b) -> a -> b
$ do
    let
      l :: AT.Parser a -> Warn a
      l :: Parser a -> Warn a
l = Parser (a, [Warning]) -> Warn a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WL.WriterT (Parser (a, [Warning]) -> Warn a)
-> (Parser a -> Parser (a, [Warning])) -> Parser a -> Warn a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, [Warning])) -> Parser a -> Parser (a, [Warning])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, []))
      tryWarn :: (AT.FromJSON a, Show a)
              => AT.Key -> a -> Warn a
      tryWarn :: Key -> a -> Warn a
tryWarn Key
field a
def =
        Parser a -> Warn a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Object
v Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
field Parser (Maybe a) -> a -> Parser a
forall a. Parser (Maybe a) -> a -> Parser a
.!= a
def)
        Warn a -> Warn a -> Warn a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Warning -> Warn a
forall a. a -> Warning -> Warn a
putWarning a
def (WrongType :: Text -> Maybe Text -> Warning
WrongType { wrongTypeField :: Text
wrongTypeField = Key
field Key -> (Key -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Key -> Text
Key.toText
                                       , wrongTypeDefault :: Maybe Text
wrongTypeDefault = Text -> Maybe Text
forall a. a -> Maybe a
Just (a -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show a
def) })
    Text
name            <- Parser Text -> Warn Text
forall a. Parser a -> Warn a
l (Parser Text -> Warn Text) -> Parser Text -> Warn Text
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name"
    Text
version         <- Parser Text -> Warn Text
forall a. Parser a -> Warn a
l (Parser Text -> Warn Text) -> Parser Text -> Warn Text
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"version"
    Maybe Text
description     <- Key -> Maybe Text -> Warn (Maybe Text)
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"description" Maybe Text
forall a. Maybe a
Nothing
    Maybe Text
homepage        <- Key -> Maybe Text -> Warn (Maybe Text)
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"homepage" Maybe Text
forall a. Maybe a
Nothing
    Bool
private         <- Key -> Bool -> Warn Bool
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"private" Bool
False
    KeyMap Text
scripts         <- (Text -> Object -> Warn (KeyMap Text)
parseMapText Text
"scripts" (Object -> Warn (KeyMap Text))
-> WriterT [Warning] Parser Object -> Warn (KeyMap Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Key -> Object -> WriterT [Warning] Parser Object
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"scripts" Object
forall a. Monoid a => a
mempty))
    Bin
bin             <- Text -> Object -> Warn Bin
parseBin Text
name Object
v
    Man
man             <- Parser Man -> Warn Man
forall a. Parser a -> Warn a
l (Parser Man -> Warn Man) -> Parser Man -> Warn Man
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Parser Man
parseMan Text
name Object
v
    Maybe Text
license         <- Key -> Maybe Text -> Warn (Maybe Text)
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"license" Maybe Text
forall a. Maybe a
Nothing
    KeyMap Text
dependencies    <- Key -> Value -> Warn Value
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"dependencies" (Object -> Value
AT.Object Object
forall a. Monoid a => a
mempty)
                         Warn Value -> (Value -> Warn (KeyMap Text)) -> Warn (KeyMap Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> Warn (KeyMap Text)
parseDependencies Text
"dependencies"
    KeyMap Text
devDependencies <- Key -> Value -> Warn Value
forall a. (FromJSON a, Show a) => Key -> a -> Warn a
tryWarn Key
"devDependencies" (Object -> Value
AT.Object Object
forall a. Monoid a => a
mempty)
                         Warn Value -> (Value -> Warn (KeyMap Text)) -> Warn (KeyMap Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> Warn (KeyMap Text)
parseDependencies Text
"devDependencies"
    Package -> WriterT [Warning] Parser Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package :: Text
-> Text
-> Maybe Text
-> Maybe Text
-> Bool
-> KeyMap Text
-> Bin
-> Man
-> Maybe Text
-> KeyMap Text
-> KeyMap Text
-> Package
Package{Bool
Maybe Text
Text
KeyMap Text
Man
Bin
devDependencies :: KeyMap Text
dependencies :: KeyMap Text
license :: Maybe Text
man :: Man
bin :: Bin
scripts :: KeyMap Text
private :: Bool
homepage :: Maybe Text
description :: Maybe Text
version :: Text
name :: Text
devDependencies :: KeyMap Text
dependencies :: KeyMap Text
license :: Maybe Text
man :: Man
bin :: Bin
scripts :: KeyMap Text
private :: Bool
homepage :: Maybe Text
description :: Maybe Text
version :: Text
name :: Text
..}
    where

      parseDependencies ::  Text -> AT.Value -> Warn Dependencies
      parseDependencies :: Text -> Value -> Warn (KeyMap Text)
parseDependencies Text
field Value
v =
        let
          warn :: Warn (KeyMap Text)
warn = KeyMap Text -> Warning -> Warn (KeyMap Text)
forall a. a -> Warning -> Warn a
putWarning KeyMap Text
forall a. Monoid a => a
mempty
              (Warning -> Warn (KeyMap Text)) -> Warning -> Warn (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ WrongType :: Text -> Maybe Text -> Warning
WrongType
              { wrongTypeField :: Text
wrongTypeField   = Text
field
              , wrongTypeDefault :: Maybe Text
wrongTypeDefault = Text -> Maybe Text
forall a. a -> Maybe a
Just (KeyMap Text -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (KeyMap Text
forall a. Monoid a => a
mempty :: Dependencies)) }
        in case Value
v of
          AT.Array Array
a ->
            -- we interpret empty arrays as just confused users
            if Array -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
a then Warn (KeyMap Text)
warn
            -- however if the user uses a non-empty array,
            -- they probably mean something which we don’t know how to deal with.
            else String -> Warn (KeyMap Text)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
              (String -> Warn (KeyMap Text)) -> String -> Warn (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
field String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is a non empty array instead of a JSON object"
          -- if we get an object here, it's malformed
          AT.Object Object
deps -> Parser (KeyMap Text) -> Warn (KeyMap Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (KeyMap Text) -> Warn (KeyMap Text))
-> Parser (KeyMap Text) -> Warn (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser Text) -> Object -> Parser (KeyMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FromJSON Text => Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON @Text) Object
deps
          -- everything else defaults to mempty and generates a warning
          Value
_ -> Warn (KeyMap Text)
warn

      parseMapText :: Text -> KeyMap AT.Value
                   -> Warn (KeyMap Text)
      parseMapText :: Text -> Object -> Warn (KeyMap Text)
parseMapText Text
fieldPath Object
val =
        (Maybe Text -> Maybe Text) -> KeyMap (Maybe Text) -> KeyMap Text
forall a b. (a -> Maybe b) -> KeyMap a -> KeyMap b
KeyMap.mapMaybe Maybe Text -> Maybe Text
forall a. a -> a
identity (KeyMap (Maybe Text) -> KeyMap Text)
-> WriterT [Warning] Parser (KeyMap (Maybe Text))
-> Warn (KeyMap Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> Value -> Warn (Maybe Text))
-> Object -> WriterT [Warning] Parser (KeyMap (Maybe Text))
forall (f :: * -> *) v1 v2.
Applicative f =>
(Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)
KeyMap.traverseWithKey Key -> Value -> Warn (Maybe Text)
tryParse Object
val
        where
          tryParse :: A.Key -> A.Value -> Warn (Maybe Text)
          tryParse :: Key -> Value -> Warn (Maybe Text)
tryParse Key
key Value
el = Parser (Maybe Text) -> Warn (Maybe Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
AT.parseJSON Value
el)
            Warn (Maybe Text) -> Warn (Maybe Text) -> Warn (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Warning -> Warn (Maybe Text)
forall a. a -> Warning -> Warn a
putWarning Maybe Text
forall a. Maybe a
Nothing
                  (WrongType :: Text -> Maybe Text -> Warning
WrongType { wrongTypeField :: Text
wrongTypeField = Text
fieldPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Key
key Key -> (Key -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Key -> Text
Key.toText)
                             , wrongTypeDefault :: Maybe Text
wrongTypeDefault = Maybe Text
forall a. Maybe a
Nothing })
      parseBin :: Text -> AT.Object -> Warn Bin
      parseBin :: Text -> Object -> Warn Bin
parseBin Text
packageName Object
v = do
        -- check for existence of these fields
        Maybe Value
binVal <- Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value))
-> Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Parser Value -> Parser (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Value -> Parser (Maybe Value))
-> Parser Value -> Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bin"
        Maybe Value
dirBinVal <- Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value))
-> Parser (Maybe Value) -> WriterT [Warning] Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Parser Value -> Parser (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Value -> Parser (Maybe Value))
-> Parser Value -> Parser (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"directories" Parser Object -> (Object -> Parser Value) -> Parser Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bin")
        -- now check for all possible cases of the fields
        -- see npm documentation for more
        case (Maybe Value
binVal, Maybe Value
dirBinVal) of
          (Just Value
_              , Just Value
_) ->
            Bin -> Warning -> Warn Bin
forall a. a -> Warning -> Warn a
putWarning (KeyMap String -> Bin
BinFiles KeyMap String
forall a. Monoid a => a
mempty) (Warning -> Warn Bin) -> Warning -> Warn Bin
forall a b. (a -> b) -> a -> b
$ Text -> Warning
PlainWarning
              Text
"`bin` and `directories.bin` must not exist at the same time, skipping."
          -- either "bin" is a direct path, then it’s linked to the package name
          (Just (A.String Text
path),      Maybe Value
_) -> Bin -> Warn Bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bin -> Warn Bin) -> Bin -> Warn Bin
forall a b. (a -> b) -> a -> b
$ KeyMap String -> Bin
BinFiles
            (KeyMap String -> Bin) -> KeyMap String -> Bin
forall a b. (a -> b) -> a -> b
$ Key -> String -> KeyMap String
forall v. Key -> v -> KeyMap v
KeyMap.singleton (Text -> Text
parsePackageName Text
packageName Text -> (Text -> Key) -> Key
forall a b. a -> (a -> b) -> b
& Text -> Key
Key.fromText) (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
path)
          -- or it’s a map from names to paths
          (Just (A.Object Object
bins),      Maybe Value
_) -> Parser Bin -> Warn Bin
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Bin -> Warn Bin) -> Parser Bin -> Warn Bin
forall a b. (a -> b) -> a -> b
$ KeyMap String -> Bin
BinFiles
            (KeyMap String -> Bin) -> Parser (KeyMap String) -> Parser Bin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser String) -> Object -> Parser (KeyMap String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> (Text -> Parser String) -> Value -> Parser String
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"BinPath" (String -> Parser String
forall (f :: * -> *) a. Applicative f => a -> f a
pure(String -> Parser String)
-> (Text -> String) -> Text -> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> String
forall a b. ConvertText a b => a -> b
toS)) Object
bins
          (Just Value
_              ,      Maybe Value
_) -> String -> Warn Bin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            (String -> Warn Bin) -> String -> Warn Bin
forall a b. (a -> b) -> a -> b
$ String
"`bin` must be a path or a map of names to paths."
          (Maybe Value
_                   , Just (A.String Text
path)) -> Bin -> Warn Bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bin -> Warn Bin) -> Bin -> Warn Bin
forall a b. (a -> b) -> a -> b
$ String -> Bin
BinFolder (String -> Bin) -> String -> Bin
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertText a b => a -> b
toS Text
path
          (Maybe Value
_                   , Just Value
_) -> String -> Warn Bin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            (String -> Warn Bin) -> String -> Warn Bin
forall a b. (a -> b) -> a -> b
$ String
"`directories.bin` must be a path."
          -- if no executables are given, return an empty set
          (Maybe Value
Nothing             , Maybe Value
Nothing) -> Bin -> Warn Bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bin -> Warn Bin)
-> (KeyMap String -> Bin) -> KeyMap String -> Warn Bin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap String -> Bin
BinFiles (KeyMap String -> Warn Bin) -> KeyMap String -> Warn Bin
forall a b. (a -> b) -> a -> b
$ KeyMap String
forall a. Monoid a => a
mempty

      -- TODO: parsing should be as thorough as with "bin"
      parseMan :: Text -> Object -> Parser Man
parseMan Text
name Object
v = do
        let getMan :: (a -> KeyMap String) -> Parser Man
getMan a -> KeyMap String
f = KeyMap String -> Man
ManFiles (KeyMap String -> Man) -> (a -> KeyMap String) -> a -> Man
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> KeyMap String
f (a -> Man) -> Parser a -> Parser Man
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"man"
            extractName :: FilePath -> (Key, FilePath)
            extractName :: String -> (Key, String)
extractName String
file =
              let f :: Text
f = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
FP.takeFileName String
file
              in if Text
name Text -> Text -> Bool
`T.isPrefixOf` Text
f
                  then (Text -> Key
Key.fromText Text
name, String
file)
                  else (Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f, String
file)
        -- TODO: handle directories.man
        (([String] -> KeyMap String) -> Parser Man
forall a. FromJSON a => (a -> KeyMap String) -> Parser Man
getMan ([(Key, String)] -> KeyMap String
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, String)] -> KeyMap String)
-> ([String] -> [(Key, String)]) -> [String] -> KeyMap String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Key, String)) -> [String] -> [(Key, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> (Key, String)
extractName)
            Parser Man -> Parser Man -> Parser Man
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> KeyMap String) -> Parser Man
forall a. FromJSON a => (a -> KeyMap String) -> Parser Man
getMan ([(Key, String)] -> KeyMap String
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, String)] -> KeyMap String)
-> (String -> [(Key, String)]) -> String -> KeyMap String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, String) -> [(Key, String)] -> [(Key, String)]
forall a. a -> [a] -> [a]
:[]) ((Key, String) -> [(Key, String)])
-> (String -> (Key, String)) -> String -> [(Key, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Key, String)
extractName)
            Parser Man -> Parser Man -> Parser Man
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Man -> Parser Man
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap String -> Man
ManFiles KeyMap String
forall a. Monoid a => a
mempty))

-- | Convenience decoding function.
decode :: BL.ByteString -> Either Text LoggingPackage
decode :: ByteString -> Either Text LoggingPackage
decode = (String -> Text)
-> Either String LoggingPackage -> Either Text LoggingPackage
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
forall a b. ConvertText a b => a -> b
toS (Either String LoggingPackage -> Either Text LoggingPackage)
-> (ByteString -> Either String LoggingPackage)
-> ByteString
-> Either Text LoggingPackage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String LoggingPackage
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

-- | Convert a @package.json@ parsing warning to plain text.
formatWarning :: Warning -> Text
formatWarning :: Warning -> Text
formatWarning = \case
  WrongType{Maybe Text
Text
wrongTypeDefault :: Maybe Text
wrongTypeField :: Text
wrongTypeDefault :: Warning -> Maybe Text
wrongTypeField :: Warning -> Text
..} ->
       Text
"Field \""
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
wrongTypeField
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" has the wrong type. "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (case Maybe Text
wrongTypeDefault of
         Just Text
def -> Text
"Defaulting to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
def
         Maybe Text
Nothing  -> Text
"Leaving it out")
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
  (PlainWarning Text
t) -> Text
t

-- | Parse a package name string into a 'YLT.PackageKeyName'.
parsePackageKeyName :: Text -> YLT.PackageKeyName
parsePackageKeyName :: Text -> PackageKeyName
parsePackageKeyName Text
k =
  case Text -> Maybe PackageKeyName
YLT.parsePackageKeyName Text
k of
    -- we don’t crash on a “wrong” package key to keep this
    -- code pure, but assume it’s a simple key instead.
    Maybe PackageKeyName
Nothing -> (Text -> PackageKeyName
YLT.SimplePackageKey Text
k)
    Just PackageKeyName
pkn -> PackageKeyName
pkn

parsePackageName :: Text -> Text
parsePackageName :: Text -> Text
parsePackageName Text
k =
  case Text -> PackageKeyName
parsePackageKeyName Text
k of
     YLT.SimplePackageKey Text
n -> Text
n
     YLT.ScopedPackageKey Text
_ Text
n -> Text
n