{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards, LambdaCase #-}
{-|
Description: Misc utils
-}
module Distribution.Nixpkgs.Nodejs.Utils where
import Protolude
import Nix.Expr
import qualified Yarn.Lock.Types as YLT

-- | Representation of a PackageKey as nix attribute name.
packageKeyToSymbol :: YLT.PackageKey -> Text
packageKeyToSymbol :: PackageKey -> Text
packageKeyToSymbol (YLT.PackageKey{Text
PackageKeyName
name :: PackageKey -> PackageKeyName
npmVersionSpec :: PackageKey -> Text
npmVersionSpec :: Text
name :: PackageKeyName
..}) =
  PackageKeyName -> Text
packageKeyNameToSymbol PackageKeyName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
npmVersionSpec
{-# INLINABLE packageKeyToSymbol #-}

-- | Representation of a PackageKeyName as nix attribute name.
packageKeyNameToSymbol :: YLT.PackageKeyName -> Text
packageKeyNameToSymbol :: PackageKeyName -> Text
packageKeyNameToSymbol = \case
  YLT.SimplePackageKey Text
n -> Text
n
  YLT.ScopedPackageKey Text
scope Text
n -> Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scope Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
{-# INLINABLE packageKeyNameToSymbol #-}

-- | Return a 'Binding' if 'Just' (or none if 'Nothing')
--   for 'mkRecSet' and 'mkNonRecSet'.
attrSetMay :: Text -> Maybe NExpr -> [Binding NExpr]
attrSetMay :: Text -> Maybe NExpr -> [Binding NExpr]
attrSetMay Text
k Maybe NExpr
v = Maybe (Binding NExpr) -> [Binding NExpr]
forall a. Maybe a -> [a]
maybeToList (Maybe (Binding NExpr) -> [Binding NExpr])
-> Maybe (Binding NExpr) -> [Binding NExpr]
forall a b. (a -> b) -> a -> b
$ (Text
k Text -> NExpr -> Binding NExpr
$=) (NExpr -> Binding NExpr) -> Maybe NExpr -> Maybe (Binding NExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NExpr
v
{-# INLINABLE attrSetMay #-}

-- | Convenience shortcut for @'attrSetMay' x (mkStr \<$\> y)@.
attrSetMayStr :: Text -> Maybe Text -> [Binding NExpr]
attrSetMayStr :: Text -> Maybe Text -> [Binding NExpr]
attrSetMayStr Text
k = Text -> Maybe NExpr -> [Binding NExpr]
attrSetMay Text
k (Maybe NExpr -> [Binding NExpr])
-> (Maybe Text -> Maybe NExpr) -> Maybe Text -> [Binding NExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> NExpr) -> Maybe Text -> Maybe NExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NExpr
mkStr
{-# INLINABLE attrSetMayStr #-}