Read the "os" key of the package.json, use for platforms (#125)

* Read the "os" key of the package.json, use for platforms

* use explicit unpack

* refactor, add tests

* add LANGAUGE pragma

default.nix

@@ -4,6 +4,7 @@
 , network-uri, optparse-applicative, parsec, pcre-heavy, QuickCheck
 , semver-range, SHA, shelly, stdenv, system-filepath, temporary
 , text, text-render, transformers, unix, unordered-containers
+, neat-interpolation
 }:
 mkDerivation {
   pname = "nixfromnpm";
@@ -31,6 +32,7 @@ mkDerivation {
     monad-control mtl network-uri optparse-applicative parsec
     pcre-heavy QuickCheck semver-range SHA shelly system-filepath
     temporary text text-render transformers unix unordered-containers
+    neat-interpolation
   ];
   description = "Generate nix expressions from npm packages";
   license = stdenv.lib.licenses.mit;

nixfromnpm.cabal

@@ -38,16 +38,16 @@ library
   exposed-modules:     NixFromNpm
                      , NixFromNpm.Cli
                      , NixFromNpm.Common
-                     , NixFromNpm.Options
                      , NixFromNpm.Conversion.ToDisk
+                     , NixFromNpm.Conversion.ToNix
                      , NixFromNpm.Git.Types
-                     , NixFromNpm.Npm.Version
                      , NixFromNpm.Npm.PackageMap
+                     , NixFromNpm.Npm.Types
+                     , NixFromNpm.Npm.Version
+                     , NixFromNpm.Options
   other-modules:       Filesystem.Path.Wrappers
                      , NixFromNpm.HttpTools
-                     , NixFromNpm.Conversion.ToNix
                      , NixFromNpm.Npm.Resolve
-                     , NixFromNpm.Npm.Types
                      , Paths_nixfromnpm
   other-extensions:    NoImplicitPrelude
   build-depends:       base >=4.8 && < 5.0
@@ -98,9 +98,13 @@ test-suite unit-tests
                      , OverloadedStrings
   build-depends:       base >=4.8 && < 5.0
                      , classy-prelude
+                     , aeson
+                     , bytestring
+                     , hnix
                      , text
                      , hspec
                      , QuickCheck
+                     , neat-interpolation
                      , nixfromnpm
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010

src/NixFromNpm.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE LambdaCase #-}
-module NixFromNpm (module NixFromNpm.Common,
-                   module NixFromNpm.Options,
+module NixFromNpm (module NixFromNpm.Options,
                    module Data.SemVer,
                    module NixFromNpm.Npm.Version,
                    module NixFromNpm.Npm.Types,
@@ -12,7 +11,6 @@ module NixFromNpm (module NixFromNpm.Common,
 
 import Data.SemVer
 
-import NixFromNpm.Common
 import NixFromNpm.Options
 import NixFromNpm.Npm.Version
 import NixFromNpm.Npm.Types

src/NixFromNpm/Conversion/ToNix.hs

@@ -146,7 +146,16 @@ metaToNix PackageMeta{..} = do
     keywords = case pmKeywords of
       ks | null ks -> []
          | otherwise -> ["keywords" $= mkList (toList (map mkStr ks))]
-  case homepage <> description <> keywords <> author of
+    stdenvPlatforms = mkDots "pkgs" ["stdenv", "lib", "platforms"]
+    platforms = case map nodePlatformToText $ toList pmPlatforms of
+      [] -> []
+      ps -> singleton $ "platforms" $= case ps of
+        -- For a single one, just do pkgs.stdenv.lib.platforms.<platform>
+        [p] -> stdenvPlatforms !. p
+        -- For multiples, use the `with` syntax, and since each is a
+        -- list, join with the concatenation operator.
+        (p:ps) -> mkWith stdenvPlatforms $ foldl' ($++) (mkSym p) (mkSym <$> ps)
+  case homepage <> description <> keywords <> author <> platforms of
     [] -> Nothing
     bindings -> Just $ mkNonRecSet bindings
 

src/NixFromNpm/Npm/Types.hs

@@ -8,7 +8,7 @@ module NixFromNpm.Npm.Types where
 
 import qualified ClassyPrelude as CP
 import Data.Aeson
-import Data.Aeson.Types as Aeson (Parser, typeMismatch)
+import Data.Aeson.Types as Aeson (Parser, typeMismatch, withObject)
 import qualified Data.HashMap.Strict as H
 import qualified Data.Text as T
 import Data.SemVer (SemVer, SemVerRange)
@@ -25,14 +25,72 @@ data PackageInfo = PackageInfo {
   piTags :: Record SemVer
   } deriving (Show, Eq)
 
+-- | Taken from https://nodejs.org/api/process.html#process_process_platform,
+-- and filtered to those that correspond to nixpkgs platforms.
+data NodePlatform
+  = Darwin
+  | FreeBSD
+  | OpenBSD
+  | Linux
+  | SunOS
+  deriving (Show, Eq)
+
+-- | Convert a NodePlatform into text
+nodePlatformToText :: IsString t => NodePlatform -> t
+nodePlatformToText = \case
+  Darwin -> "darwin"
+  FreeBSD -> "freebsd"
+  OpenBSD -> "openbsd"
+  Linux -> "linux"
+  SunOS -> "solaris"
+
+-- | Parse a node platform from a string.
+parseNodePlatform :: Alternative f => Text -> f NodePlatform
+parseNodePlatform = \case
+  "linux" -> pure Linux
+  "darwin" -> pure Darwin
+  "freebsd" -> pure FreeBSD
+  "openbsd" -> pure OpenBSD
+  "sunos" -> pure SunOS
+  _ -> empty
+
 -- | Metadata about a package.
 data PackageMeta = PackageMeta {
   pmDescription :: Maybe Text,
   pmAuthor :: Maybe Text,
   pmHomepage :: Maybe URI,
-  pmKeywords :: Vector Text
+  pmKeywords :: Vector Text,
+  pmPlatforms :: Vector NodePlatform
   } deriving (Show, Eq)
 
+-- | Default (empty) package metadata.
+emptyPackageMeta :: PackageMeta
+emptyPackageMeta = PackageMeta Nothing Nothing Nothing mempty mempty
+
+instance FromJSON PackageMeta where
+  parseJSON = withObject "PackageMeta" $ \o -> do
+    let getString = \case {String s -> Just s; _ -> Nothing}
+    description <- o .:? "description"
+    author <- o .:? "author" <|> pure Nothing
+    maybePlatforms :: Maybe (Vector Text) <- o .:? "os" <|> pure Nothing
+    let platforms = maybe mempty (catMaybes . map parseNodePlatform) maybePlatforms
+    homepage <- o .:? "homepage" >>= \case
+      Nothing -> return Nothing
+      Just (String txt) -> return $ parseURIText txt
+      Just (Array stuff) -> case toList $ catMaybes (getString <$> stuff) of
+        [] -> return Nothing
+        (uri:_) -> return $ parseURIText uri
+    let
+      -- If keywords are a string, split on commas and strip whitespace.
+      getKeywords (String s) = fromList $ T.strip <$> T.split (==',') s
+      -- If an array, just take the array.
+      getKeywords (Array a) = catMaybes $ map getString a
+      -- Otherwise, this is an error, but just return an empty array.
+      getKeywords _ = mempty
+    keywords <- map getKeywords $ o .:? "keywords" .!= Null
+    return $ PackageMeta description author homepage keywords platforms
+
+
 -- | Expresses all of the information that a version of a package needs, in
 -- the abstract (e.g. using version ranges instead of explicit versions).
 -- This type can be used as an input to the Npm.Resolve stuff to produce a
@@ -160,7 +218,7 @@ getDict key obj = case H.lookup key obj of
   _ -> return mempty
 
 instance FromJSON VersionInfo where
-  parseJSON = getObject "version info" >=> \o -> do
+  parseJSON = withObject "version info" $ \o -> do
     listedDependencies <- getDict "dependencies" o
     devDependencies <- getDict "devDependencies" o
     optionalDependencies <- getDict "optionalDependencies" o
@@ -174,25 +232,7 @@ instance FromJSON VersionInfo where
     dist <- o .:? "dist"
     pkgName <- o .: "name"
     version <- o .: "version"
-    packageMeta <- do
-      let getString = \case {String s -> Just s; _ -> Nothing}
-      description <- o .:? "description"
-      author <- o .:? "author" <|> pure Nothing
-      homepage <- o .:? "homepage" >>= \case
-        Nothing -> return Nothing
-        Just (String txt) -> return $ parseURIText txt
-        Just (Array stuff) -> case toList $ catMaybes (getString <$> stuff) of
-          [] -> return Nothing
-          (uri:_) -> return $ parseURIText uri
-      let
-        -- If keywords are a string, split on commas and strip whitespace.
-        getKeywords (String s) = fromList $ T.strip <$> T.split (==',') s
-        -- If an array, just take the array.
-        getKeywords (Array a) = catMaybes $ map getString a
-        -- Otherwise, this is an error, but just return an empty array.
-        getKeywords _ = mempty
-      keywords <- map getKeywords $ o .:? "keywords" .!= Null
-      return $ PackageMeta description author homepage keywords
+    packageMeta <- parseJSON (Object o)
     scripts :: Record Value <- getDict "scripts" o <|> fail "couldn't get scripts"
     case parseSemVer version of
       Left _ -> throw $ VersionSyntaxError version

tests/Unit.hs

@@ -1,14 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE QuasiQuotes #-}
 module Main (main) where
 
 import ClassyPrelude hiding ((<>))
 import Data.Either (isRight, isLeft)
+import Data.Aeson (Value(..), decode)
+import Nix.Expr
 import Test.Hspec
 import Test.QuickCheck (property, Arbitrary(..), oneof)
+import NeatInterpolation (text)
+import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 
 import NixFromNpm
+import NixFromNpm.Common hiding (decode)
 import NixFromNpm.Git.Types as Git
 import NixFromNpm.Npm.PackageMap (PackageName(..), parsePackageName)
 import NixFromNpm.Npm.Version as Npm
@@ -86,7 +93,7 @@ npmVersionParserSpec = describe "npm version parser" $ do
     parseNpmVersionRange "0.0.0" `shouldBeJ` SemVerRange (Eq (semver 0 0 0))
 
   it "should parse a tag" $ do
-    parseNpmVersionRange "xyz" `shouldBeJ` NixFromNpm.Tag "xyz"
+    parseNpmVersionRange "xyz" `shouldBeJ` Npm.Tag "xyz"
 
   it "should parse a git uri" $ do
     let owner = "holidaycheck"
@@ -137,9 +144,89 @@ npmNameAndVersionParserSpec = describe "npm name@version parser" $ do
     parseNameAndRange "foo%1.2.3" `shouldThrow` \(UnrecognizedVersionFormat msg) -> do
       "use '@' instead" `isInfixOf` msg
 
+parsePackageMetadataSpec :: Spec
+parsePackageMetadataSpec = describe "parse package metadata JSON" $ do
+  let unsafeDecode = fromJust . decode . BL.fromStrict . T.encodeUtf8
+  let meta = emptyPackageMeta
+  it "should parse a description" $ do
+    let pkgJSON = unsafeDecode [text|{"description": "hey there"}|]
+    pkgJSON `shouldBe` meta {pmDescription = Just "hey there"}
+
+  it "should parse keywords" $ do
+    let pkgJSON = unsafeDecode [text|{"keywords": ["awesome", "amazing"]}|]
+    pkgJSON `shouldBe` meta {pmKeywords = fromList ["awesome", "amazing"]}
+
+  it "should parse keywords separated by commas" $ do
+    let pkgJSON = unsafeDecode [text|{"keywords": "awesome, amazing"}|]
+    pkgJSON `shouldBe` meta {pmKeywords = fromList ["awesome", "amazing"]}
+
+  it "should parse platforms" $ do
+    let pkgJSON = unsafeDecode [text|{"os": ["darwin", "linux"]}|]
+    pkgJSON `shouldBe` meta {pmPlatforms = fromList [Darwin, Linux]}
+
+  it "should ignore platforms it doesn't recognize" $ do
+    let pkgJSON = unsafeDecode [text|{"os": ["darwin", "weird"]}|]
+    pkgJSON `shouldBe` meta {pmPlatforms = fromList [Darwin]}
+
+  it "should parse multiple keys" $ do
+    let pkgJSON = unsafeDecode [text|{
+      "description": "hey there",
+      "keywords": ["awesome", "amazing"],
+      "os": ["darwin", "weird"]
+    }|]
+    pkgJSON `shouldBe` meta {
+      pmDescription = Just "hey there",
+      pmKeywords = fromList ["awesome", "amazing"],
+      pmPlatforms = fromList [Darwin]
+      }
+
+
+metaToNixSpec :: Spec
+metaToNixSpec = describe "converting package meta to nix" $ do
+  let meta = emptyPackageMeta
+  it "should return nothing for an empty metadata" $ do
+    metaToNix meta `shouldBe` Nothing
+
+  it "should grab the description" $ do
+    let description = "Some description"
+    let converted = metaToNix (meta {pmDescription = Just description})
+    fromJust converted `shouldBe` mkNonRecSet ["description" $= mkStr description]
+
+  it "should grab the author" $ do
+    let author = "Some author"
+    let converted = metaToNix (meta {pmAuthor = Just author})
+    fromJust converted `shouldBe` mkNonRecSet ["author" $= mkStr author]
+
+  it "should grab the homepage" $ do
+    let homepageStr = "http://example.com"
+        mHomepage = parseURI (T.unpack homepageStr)
+    let converted = metaToNix (meta {pmHomepage = mHomepage})
+    fromJust converted `shouldBe` mkNonRecSet ["homepage" $= mkStr homepageStr]
+
+  it "should grab keywords" $ do
+    let keywords = ["keyword1", "keyword2"]
+    let converted = metaToNix (meta {pmKeywords = fromList keywords})
+    fromJust converted `shouldBe` mkNonRecSet ["keywords" $= mkList (mkStr <$> keywords)]
+
+  describe "platforms" $ do
+    let check ps expr = do
+          let converted = metaToNix (meta {pmPlatforms = fromList ps})
+          fromJust converted `shouldBe` mkNonRecSet ["platforms" $= expr]
+
+    it "should convert a single platform" $ do
+      let platforms = [Linux]
+      check platforms (mkDots "pkgs" ["stdenv", "lib", "platforms"] !. "linux")
+
+    it "should convert platforms" $ do
+      let platforms = [Linux, OpenBSD]
+      let withPlatforms = mkWith (mkDots "pkgs" ["stdenv", "lib", "platforms"])
+      check platforms (withPlatforms ("linux" $++ "openbsd"))
+
 main :: IO ()
 main = hspec $ do
   npmVersionParserSpec
   npmNameParserSpec
   npmNameAndVersionParserSpec
   gitIdParsingSpec
+  metaToNixSpec
+  parsePackageMetadataSpec