initial commit, handling semvers

Author: Allen Nelson

.gitignore

@@ -0,0 +1 @@
+dist

LICENSE

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

Setup.hs

@@ -0,0 +1,24 @@
+-- Initial npm2nixhs.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                npm2nixhs
+version:             0.1.0.0
+-- synopsis:
+-- description:
+-- license:
+license-file:        LICENSE
+author:              Allen Nelson
+maintainer:          [email protected]
+-- copyright:
+-- category:
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+executable npm2nixhs
+  main-is:             Main.hs
+  -- other-modules:
+  other-extensions:    NoImplicitPrelude, OverloadedStrings
+  build-depends:       base >=4.7 && <4.8, classy-prelude, text, unordered-containers, parsec
+  hs-source-dirs:      src
+  default-language:    Haskell2010

npm2nixhs.cabal

@@ -0,0 +1,10 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+
+import SemVer
+import ParseSemVer
+import ClassyPrelude
+
+--type DependencySet = HashMap Name Version
+main = putStrLn "hey"

src/Main.hs

@@ -0,0 +1,105 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+module ParseSemVer where
+
+import ClassyPrelude hiding (try)
+import Control.Applicative
+import qualified Prelude as P
+import Prelude (String)
+import Text.Parsec hiding (many, (<|>), spaces, parse)
+import qualified Text.Parsec as Parsec
+import SemVer
+
+type Parser = ParsecT String () Identity
+
+-- | Parse a string as a version range, or return an error.
+parseSemVerRange :: String -> Either ParseError SemVerRange
+parseSemVerRange = parse (pSemVerRange <* eof)
+
+parse :: Parser a -> String -> Either ParseError a
+parse p = Parsec.parse p ""
+
+spaces :: Parser String
+spaces = many $ char ' '
+
+spaces1 :: Parser String
+spaces1 = many1 $ char ' '
+
+sym :: String -> Parser String
+sym s = string s <* spaces
+
+cmp :: Parser String
+cmp = choice $ fmap (try . sym) [">=", "<=", ">", "<", "="]
+
+pNum :: Parser Int
+pNum = (P.read <$> many1 digit) <* spaces
+
+-- | Parses a semantic version.
+pSemVer :: Parser SemVer
+pSemVer = (,,) <$> pNum <*> (sym "." *> pNum) <*> (sym "." *> pNum)
+
+-- | Parses versions with an explicit range qualifier (gt, lt, etc).
+pSemVerRangeSingle :: Parser SemVerRange
+pSemVerRangeSingle = choice [wildcardToRange <$> pWildCard,
+                             tildeToRange <$> pTildeRange,
+                             caratToRange <$> pCaratRange,
+                             Eq <$> (sym "=" *> pSemVer),
+                             Gt <$> (sym ">" *> pSemVer),
+                             Lt <$> (sym "<" *> pSemVer),
+                             Geq <$> (sym ">=" *> pSemVer),
+                             Leq <$> (sym "<=" *> pSemVer)
+                            ]
+
+-- | Joins semantic version ranges with Ands and Ors.
+pJoinedSemVerRange :: Parser SemVerRange
+pJoinedSemVerRange = do
+  first <- pSemVerRangeSingle
+  option first $ do
+    lookAhead (sym "||" <|> cmp) >>= \case
+      "||" -> Or first <$> (sym "||" *> pJoinedSemVerRange)
+      _ -> And first <$> pJoinedSemVerRange
+
+-- | Translates a hyphenated range to an actual range.
+-- Ex: 1.2.3 - 2.3.4 := >=1.2.3 <=2.3.4
+-- Ex: 1.2 - 2.3.4 := >=1.2.0 <=2.3.4
+-- Ex: 1.2.3 - 2 := >=1.2.3 <3.0.0
+pHyphen :: Parser SemVerRange
+pHyphen = do
+  wc1 <- pWildCard
+  sym "-"
+  wc2 <- pWildCard
+  let sv1 = case wc1 of
+              Any -> Geq (0, 0, 0)
+              One n -> Geq (n, 0, 0)
+              Two n m -> Geq (n, m, 0)
+              Three n m o -> Geq (n, m, o)
+  let sv2 = case wc2 of
+              Any -> Geq (0, 0, 0) -- Refers to "any version"
+              One n -> Lt (n+1, 0, 0)
+              Two n m -> Lt (n, m + 1, 0)
+              Three n m o -> Leq (n, m, o)
+  return $ And sv1 sv2
+
+
+-- | Parses a "wildcard" (which is a possibly partial semantic version).
+pWildCard :: Parser Wildcard
+pWildCard = try $ do
+  let bound = choice [sym "x" *> pure Nothing, Just <$> pNum]
+  sepBy1 bound (sym ".") >>= \case
+    [Nothing] -> return Any
+    [Just n] -> return $ One n
+    [Just n, Nothing] -> return $ One n
+    [Just n, Just m] -> return $ Two n m
+    [Just n, Just m, Nothing] -> return $ Two n m
+    [Just n, Just m, Just o] -> return $ Three n m o
+    w -> unexpected ("Invalid version " ++ show w)
+
+pTildeRange :: Parser Wildcard
+pTildeRange = sym "~" *> pWildCard
+
+pCaratRange :: Parser Wildcard
+pCaratRange = sym "^" *> pWildCard
+
+pSemVerRange :: Parser SemVerRange
+pSemVerRange = pJoinedSemVerRange <|> pHyphen

src/ParseSemVer.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+module SemVer where
+
+import ClassyPrelude hiding (try)
+
+type SemVer = (Int, Int, Int)
+
+-- | A partially specified semantic version. Implicitly defines
+-- a range of acceptable versions, as seen in @wildcardToRange@.
+data Wildcard = Any
+              | One Int
+              | Two Int Int
+              | Three Int Int Int
+              deriving (Show, Eq)
+
+data SemVerRange
+  = Eq SemVer
+  | Gt SemVer
+  | Lt SemVer
+  | Geq SemVer
+  | Leq SemVer
+  | And SemVerRange SemVerRange
+  | Or SemVerRange SemVerRange
+  deriving (Show, Eq)
+
+
+-- | Returns whether a given semantic version matches a range.
+matches :: SemVerRange -> SemVer -> Bool
+matches range ver = case range of
+  Eq sv -> ver == sv
+  Gt sv -> ver > sv
+  Lt sv -> ver < sv
+  Geq sv -> ver >= sv
+  Leq sv -> ver <= sv
+  And sv1 sv2 -> matches sv1 ver && matches sv2 ver
+  Or sv1 sv2 -> matches sv1 ver || matches sv2 ver
+
+-- | Fills in zeros in a wildcard.
+wildcardToSemver :: Wildcard -> SemVer
+wildcardToSemver Any = (0, 0, 0)
+wildcardToSemver (One n) = (n, 0, 0)
+wildcardToSemver (Two n m) = (n, m, 0)
+wildcardToSemver (Three n m o) = (n, m, o)
+
+
+-- | Translates a wildcard (partially specified version) to a range.
+-- Ex: 2 := >=2.0.0 <3.0.0
+-- Ex: 1.2.x := 1.2 := >=1.2.0 <1.3.0
+wildcardToRange :: Wildcard -> SemVerRange
+wildcardToRange = \case
+  Any -> Geq (0, 0, 0)
+  One n -> Geq (n, 0, 0) `And` Lt (n+1, 0, 0)
+  Two n m -> Geq (n, m, 0) `And` Lt (n, m + 1, 0)
+  Three n m o -> Eq (n, m, o)
+
+-- | Translates a ~wildcard to a range.
+-- Ex: ~1.2.3 := >=1.2.3 <1.(2+1).0 := >=1.2.3 <1.3.0
+tildeToRange :: Wildcard -> SemVerRange
+tildeToRange = \case
+  Any -> tildeToRange (Three 0 0 0)
+  One n -> tildeToRange (Three n 0 0)
+  Two n m -> tildeToRange (Three n m 0)
+  Three n m o -> And (Geq (n, m, o)) (Lt (n, m + 1, 0))
+
+
+-- | Translates a ^wildcard to a range.
+-- Ex: ^1.2.x := >=1.2.0 <2.0.0
+caratToRange :: Wildcard -> SemVerRange
+caratToRange = \case
+  One n -> And (Geq (n, 0, 0)) (Lt (n+1, 0, 0))
+  Two n m -> And (Geq (n, m, 0)) (Lt (n+1, 0, 0))
+  Three 0 0 n -> Eq (0, 0, n)
+  Three 0 n m -> And (Geq (0, n, m)) (Lt (0, n + 1, 0))
+  Three n m o -> And (Geq (n, m, o)) (Lt (n+1, 0, 0))