{-# LANGUAGE OverloadedStrings, LambdaCase, NoImplicitPrelude #-}
{-# LANGUAGE TypeApplications #-}
module Distribution.Nixpkgs.Nodejs.Cli
( cli
)
where
import Protolude
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Options.Applicative as O
import qualified Options.Applicative.Help.Pretty as O (linebreak)
import qualified System.Directory as Dir
import System.Environment (getProgName)
import qualified Nix.Pretty as NixP
import qualified Prettyprinter.Render.Text as RT
import qualified Yarn.Lock as YL
import qualified Yarn.Lock.Types as YLT
import qualified Yarn.Lock.Helpers as YLH
import qualified Distribution.Nixpkgs.Nodejs.OptimizedNixOutput as NixOut
import qualified Distribution.Nixpkgs.Nodejs.FromPackage as NodeFP
import qualified Distribution.Nixpkgs.Nodejs.ResolveLockfile as Res
import qualified Distribution.Nodejs.Package as NP
import Distribution.Nixpkgs.Nodejs.ResolveLockfile (ResolverConfig(ResolverConfig, resolveOffline))
import Distribution.Nixpkgs.Nodejs.License (LicensesBySpdxId)
import qualified Data.Aeson as Json
description :: O.InfoMod a
description :: InfoMod a
description = InfoMod a
forall a. InfoMod a
O.fullDesc
InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
O.progDescDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
O.linebreak
[ Doc
"yarn2nix has two modes:"
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
O.linebreak
, Doc
"In its default mode (started without --template) it parses a given yarn.lock file"
, Doc
"and prints a nix expressions representing it to stdout."
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
O.linebreak
, Doc
"If --template is given, it processes a given package.json"
, Doc
"and prints a template nix expression for an equivalent nix package."
Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
O.linebreak
, Doc
"In both modes yarn2nix will take the file as an argument"
, Doc
"or read it from stdin if it is missing."
])
cli :: IO ()
cli :: IO ()
cli = IO RunConfig
parseOpts IO RunConfig -> (RunConfig -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RunConfig -> IO ()
runAction
data RunMode
= YarnLock
| NodeTemplate
deriving (Int -> RunMode -> ShowS
[RunMode] -> ShowS
RunMode -> String
(Int -> RunMode -> ShowS)
-> (RunMode -> String) -> ([RunMode] -> ShowS) -> Show RunMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunMode] -> ShowS
$cshowList :: [RunMode] -> ShowS
show :: RunMode -> String
$cshow :: RunMode -> String
showsPrec :: Int -> RunMode -> ShowS
$cshowsPrec :: Int -> RunMode -> ShowS
Show, RunMode -> RunMode -> Bool
(RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool) -> Eq RunMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunMode -> RunMode -> Bool
$c/= :: RunMode -> RunMode -> Bool
== :: RunMode -> RunMode -> Bool
$c== :: RunMode -> RunMode -> Bool
Eq)
data RunConfig
= RunConfig
{ RunConfig -> RunMode
runMode :: RunMode
, RunConfig -> Bool
runOffline :: Bool
, RunConfig -> Maybe String
runLicensesJson :: Maybe FilePath
, RunConfig -> Maybe String
runInputFile :: Maybe FilePath
} deriving (Int -> RunConfig -> ShowS
[RunConfig] -> ShowS
RunConfig -> String
(Int -> RunConfig -> ShowS)
-> (RunConfig -> String)
-> ([RunConfig] -> ShowS)
-> Show RunConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunConfig] -> ShowS
$cshowList :: [RunConfig] -> ShowS
show :: RunConfig -> String
$cshow :: RunConfig -> String
showsPrec :: Int -> RunConfig -> ShowS
$cshowsPrec :: Int -> RunConfig -> ShowS
Show, RunConfig -> RunConfig -> Bool
(RunConfig -> RunConfig -> Bool)
-> (RunConfig -> RunConfig -> Bool) -> Eq RunConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunConfig -> RunConfig -> Bool
$c/= :: RunConfig -> RunConfig -> Bool
== :: RunConfig -> RunConfig -> Bool
$c== :: RunConfig -> RunConfig -> Bool
Eq)
fileFor :: RunConfig -> Text
fileFor :: RunConfig -> Text
fileFor RunConfig
cfg =
case RunConfig -> RunMode
runMode RunConfig
cfg of
RunMode
YarnLock -> Text
"yarn.lock"
RunMode
NodeTemplate -> Text
"package.json"
parseOpts :: IO RunConfig
parseOpts :: IO RunConfig
parseOpts = ParserPrefs -> ParserInfo RunConfig -> IO RunConfig
forall a. ParserPrefs -> ParserInfo a -> IO a
O.customExecParser ParserPrefs
optparsePrefs ParserInfo RunConfig
runConfigParserWithHelp
runAction :: RunConfig -> IO ()
runAction :: RunConfig -> IO ()
runAction RunConfig
cfg = do
String
file <- IO String
fileForConfig
case RunConfig -> RunMode
runMode RunConfig
cfg of
RunMode
YarnLock -> String -> IO ()
parseYarn String
file
RunMode
NodeTemplate -> String -> IO ()
parseNode String
file
where
fileForConfig :: IO FilePath
fileForConfig :: IO String
fileForConfig =
case RunConfig -> Maybe String
runInputFile RunConfig
cfg of
Just String
f -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
f
Maybe String
Nothing -> IO String
Dir.getCurrentDirectory IO String -> (String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
d ->
[String] -> String -> IO (Maybe String)
Dir.findFile [String
d] (Text -> String
forall a b. ConvertText a b => a -> b
toS (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ RunConfig -> Text
fileFor RunConfig
cfg) IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe String
Nothing -> Text -> IO String
forall a. Text -> IO a
dieWithUsage
(Text -> IO String) -> Text -> IO String
forall a b. (a -> b) -> a -> b
$ Text
"No " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RunConfig -> Text
fileFor RunConfig
cfg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" found in current directory"
Just String
path -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
path
parseYarn :: FilePath -> IO ()
parseYarn :: String -> IO ()
parseYarn String
path = do
Text
fc <- String -> IO Text -> IO Text
forall a. String -> IO a -> IO a
catchCouldNotOpen String
path (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFile String
path
case String -> Text -> Either LockfileError Lockfile
YL.parse String
path Text
fc of
Right Lockfile
yarnfile -> RunConfig -> Lockfile -> IO ()
toStdout RunConfig
cfg Lockfile
yarnfile
Left LockfileError
err -> Text -> IO ()
forall a. Text -> IO a
die' (Text
"Could not parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LockfileError -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show LockfileError
err)
parseNode :: FilePath -> IO ()
parseNode :: String -> IO ()
parseNode String
path = do
ByteString -> Either Text LoggingPackage
NP.decode (ByteString -> Either Text LoggingPackage)
-> IO ByteString -> IO (Either Text LoggingPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BL.readFile String
path IO (Either Text LoggingPackage)
-> (Either Text LoggingPackage -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right (NP.LoggingPackage (Package
nodeModule, [Warning]
warnings)) -> do
[Warning] -> (Warning -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Warning]
warnings ((Warning -> IO ()) -> IO ()) -> (Warning -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (Text -> IO ()) -> (Warning -> Text) -> Warning -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warning -> Text
NP.formatWarning
Maybe LicensesBySpdxId
licenseSet <- case RunConfig
cfg RunConfig -> (RunConfig -> Maybe String) -> Maybe String
forall a b. a -> (a -> b) -> b
& RunConfig -> Maybe String
runLicensesJson of
Maybe String
Nothing -> Maybe LicensesBySpdxId -> IO (Maybe LicensesBySpdxId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LicensesBySpdxId
forall a. Maybe a
Nothing
Just String
licensesJson -> do
String -> IO ByteString -> IO ByteString
forall a. String -> IO a -> IO a
catchCouldNotOpen String
licensesJson
(String -> IO ByteString
BL.readFile String
licensesJson)
IO ByteString
-> (ByteString -> Maybe LicensesBySpdxId)
-> IO (Maybe LicensesBySpdxId)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> FromJSON LicensesBySpdxId => ByteString -> Maybe LicensesBySpdxId
forall a. FromJSON a => ByteString -> Maybe a
Json.decode @LicensesBySpdxId
Doc Any -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
print (Doc Any -> IO ()) -> Doc Any -> IO ()
forall a b. (a -> b) -> a -> b
$ NExpr -> Doc Any
forall ann. NExpr -> Doc ann
NixP.prettyNix (NExpr -> Doc Any) -> NExpr -> Doc Any
forall a b. (a -> b) -> a -> b
$ Maybe LicensesBySpdxId -> Package -> NExpr
NodeFP.genTemplate Maybe LicensesBySpdxId
licenseSet Package
nodeModule
Left Text
err -> Text -> IO ()
forall a. Text -> IO a
die' (Text
"Could not parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show Text
err)
catchCouldNotOpen :: FilePath -> IO a -> IO a
catchCouldNotOpen :: String -> IO a -> IO a
catchCouldNotOpen String
path IO a
action = IO a
action IO a -> (IOException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \IOException
e ->
Text -> IO a
forall a. Text -> IO a
dieWithUsage (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$ Text
"Could not open " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (IOException
e :: IOException)
optparsePrefs :: O.ParserPrefs
optparsePrefs :: ParserPrefs
optparsePrefs = ParserPrefs
O.defaultPrefs { prefColumns :: Int
O.prefColumns = Int
100 }
runModeParser :: O.Parser RunMode
runModeParser :: Parser RunMode
runModeParser = RunMode -> RunMode -> Mod FlagFields RunMode -> Parser RunMode
forall a. a -> a -> Mod FlagFields a -> Parser a
O.flag RunMode
YarnLock RunMode
NodeTemplate (Mod FlagFields RunMode -> Parser RunMode)
-> Mod FlagFields RunMode -> Parser RunMode
forall a b. (a -> b) -> a -> b
$
String -> Mod FlagFields RunMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"template"
Mod FlagFields RunMode
-> Mod FlagFields RunMode -> Mod FlagFields RunMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields RunMode
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Output a nix package template for a given package.json"
runConfigParser :: O.Parser RunConfig
runConfigParser :: Parser RunConfig
runConfigParser = RunMode -> Bool -> Maybe String -> Maybe String -> RunConfig
RunConfig
(RunMode -> Bool -> Maybe String -> Maybe String -> RunConfig)
-> Parser RunMode
-> Parser (Bool -> Maybe String -> Maybe String -> RunConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RunMode
runModeParser
Parser (Bool -> Maybe String -> Maybe String -> RunConfig)
-> Parser Bool
-> Parser (Maybe String -> Maybe String -> RunConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
O.switch
(String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"offline"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Makes yarn2nix fail if network access is required")
Parser (Maybe String -> Maybe String -> RunConfig)
-> Parser (Maybe String) -> Parser (Maybe String -> RunConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
O.option ReadM String
forall s. IsString s => ReadM s
O.str
(String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"license-data"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Path to a license.json equivalent to nixpkgs.lib.licenses"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall (f :: * -> *) a. Mod f a
O.internal))
Parser (Maybe String -> RunConfig)
-> Parser (Maybe String) -> Parser RunConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
O.optional (ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
O.argument ReadM String
forall s. IsString s => ReadM s
O.str (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
O.metavar String
"FILE"))
runConfigParserWithHelp :: O.ParserInfo RunConfig
runConfigParserWithHelp :: ParserInfo RunConfig
runConfigParserWithHelp =
Parser RunConfig -> InfoMod RunConfig -> ParserInfo RunConfig
forall a. Parser a -> InfoMod a -> ParserInfo a
O.info (Parser RunConfig
runConfigParser Parser RunConfig
-> Parser (RunConfig -> RunConfig) -> Parser RunConfig
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (RunConfig -> RunConfig)
forall a. Parser (a -> a)
O.helper) InfoMod RunConfig
forall a. InfoMod a
description
die' :: Text -> IO a
die' :: Text -> IO a
die' Text
err = Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText Text
err IO () -> IO a -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO a
forall a. IO a
exitFailure
dieWithUsage :: Text -> IO a
dieWithUsage :: Text -> IO a
dieWithUsage Text
err = do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putErrText (Text
err Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
String
progn <- IO String
getProgName
Handle -> String -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStr Handle
stderr
(String -> IO ())
-> (ParserFailure ParserHelp -> String)
-> ParserFailure ParserHelp
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ExitCode) -> String
forall a b. (a, b) -> a
fst ((String, ExitCode) -> String)
-> (ParserFailure ParserHelp -> (String, ExitCode))
-> ParserFailure ParserHelp
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParserFailure ParserHelp -> String -> (String, ExitCode))
-> String -> ParserFailure ParserHelp -> (String, ExitCode)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ParserFailure ParserHelp -> String -> (String, ExitCode)
O.renderFailure String
progn
(ParserFailure ParserHelp -> IO ())
-> ParserFailure ParserHelp -> IO ()
forall a b. (a -> b) -> a -> b
$ ParserPrefs
-> ParserInfo RunConfig
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
O.parserFailure ParserPrefs
optparsePrefs
ParserInfo RunConfig
runConfigParserWithHelp (Maybe String -> ParseError
O.ShowHelpText Maybe String
forall a. Maybe a
Nothing) [Context]
forall a. Monoid a => a
mempty
IO a
forall a. IO a
exitFailure
toStdout :: RunConfig -> YLT.Lockfile -> IO ()
toStdout :: RunConfig -> Lockfile -> IO ()
toStdout RunConfig
cfg Lockfile
lf = do
Chan Remote
ch <- IO (Chan Remote)
forall a. IO (Chan a)
newChan
let resolverConfig :: ResolverConfig
resolverConfig = ResolverConfig :: Bool -> ResolverConfig
ResolverConfig {
resolveOffline :: Bool
resolveOffline = RunConfig
cfg RunConfig -> (RunConfig -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& RunConfig -> Bool
runOffline
}
ResolvedLockfile
lf' <- ResolverConfig
-> Chan Remote
-> Lockfile
-> IO (Either (NonEmpty Text) ResolvedLockfile)
Res.resolveLockfileStatus ResolverConfig
resolverConfig Chan Remote
ch (HasCallStack => Lockfile -> Lockfile
Lockfile -> Lockfile
YLH.decycle Lockfile
lf) IO (Either (NonEmpty Text) ResolvedLockfile)
-> (Either (NonEmpty Text) ResolvedLockfile -> IO ResolvedLockfile)
-> IO ResolvedLockfile
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left NonEmpty Text
err -> Text -> IO ResolvedLockfile
forall a. Text -> IO a
die' (Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
err)
Right ResolvedLockfile
res -> ResolvedLockfile -> IO ResolvedLockfile
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResolvedLockfile
res
Doc Any -> IO ()
forall ann. Doc ann -> IO ()
RT.putDoc (Doc Any -> IO ()) -> Doc Any -> IO ()
forall a b. (a -> b) -> a -> b
$ NExpr -> Doc Any
forall ann. NExpr -> Doc ann
NixP.prettyNix (NExpr -> Doc Any) -> NExpr -> Doc Any
forall a b. (a -> b) -> a -> b
$ Map Text PkgRef -> NExpr
NixOut.mkPackageSet (Map Text PkgRef -> NExpr) -> Map Text PkgRef -> NExpr
forall a b. (a -> b) -> a -> b
$ ResolvedLockfile -> Map Text PkgRef
NixOut.convertLockfile ResolvedLockfile
lf'