Speed up versionRangeP

haskell · Jan 16, 2025 · e95eb38 · e95eb38
1 parent 2229287
commit e95eb38
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 18 deletions.
diff --git a/ghcup.cabal b/ghcup.cabal
@@ -451,6 +451,7 @@ test-suite ghcup-test
     GHCup.Prelude.File.Posix.TraversalsSpec
     GHCup.Types.JSONSpec
     GHCup.Utils.FileSpec
+    GHCup.ParserSpec
     Spec
 
   default-language:   Haskell2010
@@ -477,6 +478,7 @@ test-suite ghcup-test
     , ghcup
     , hspec                     >=2.7.10  && <2.12
     , hspec-golden-aeson        ^>=0.9
+    , megaparsec                >=8.0.0    && <9.8
     , QuickCheck                ^>=2.14.1 || ^>=2.15
     , quickcheck-arbitrary-adt  ^>=0.3.1.0
     , text                      ^>=2.0 || ^>=2.1

diff --git a/lib/GHCup/Prelude/MegaParsec.hs b/lib/GHCup/Prelude/MegaParsec.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings    #-}
 
 {-|
-Module      : GHCup.Utils.MegaParsec
+Module      : GHCup.Prelude.MegaParsec
 Description : MegaParsec utilities
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0

diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs
@@ -220,23 +220,16 @@ versionCmpToText (VR_lteq ver') = "<= " <> prettyV ver'
 versionCmpToText (VR_eq   ver') = "== " <> prettyV ver'
 
 versionCmpP :: MP.Parsec Void T.Text VersionCmp
-versionCmpP =
-  fmap VR_gt (MP.try $ MPC.space *> MP.chunk ">" *> MPC.space *> versioningEnd)
-    <|> fmap
-          VR_gteq
-          (MP.try $ MPC.space *> MP.chunk ">=" *> MPC.space *> versioningEnd)
-    <|> fmap
-          VR_lt
-          (MP.try $ MPC.space *> MP.chunk "<" *> MPC.space *> versioningEnd)
-    <|> fmap
-          VR_lteq
-          (MP.try $ MPC.space *> MP.chunk "<=" *> MPC.space *> versioningEnd)
-    <|> fmap
-          VR_eq
-          (MP.try $ MPC.space *> MP.chunk "==" *> MPC.space *> versioningEnd)
-    <|> fmap
-          VR_eq
-          (MP.try $ MPC.space *> versioningEnd)
+versionCmpP = either (fail . T.unpack) pure =<< (translate <$> (MPC.space *> MP.try (MP.takeWhileP Nothing (`elem` ['>', '<', '=']))) <*> (MPC.space *> versioningEnd))
+ where
+   translate ">" v  = Right $ VR_gt v
+   translate ">=" v = Right $ VR_gteq v
+   translate "<" v  = Right $ VR_lt v
+   translate "<=" v = Right $ VR_lteq v
+   translate "==" v = Right $ VR_eq v
+   translate "" v   = Right $ VR_eq v
+   translate c  _   = Left $ "unexpected comparator: " <> c
+
 
 instance ToJSON VersionRange where
   toJSON = String . verRangeToText