diff --git a/subs/pantry/package.yaml b/subs/pantry/package.yaml index 0c9fe5b67c..14eb4e127d 100644 --- a/subs/pantry/package.yaml +++ b/subs/pantry/package.yaml @@ -87,3 +87,4 @@ tests: - pantry - hspec - exceptions + - hedgehog diff --git a/subs/pantry/src/Pantry/Types.hs b/subs/pantry/src/Pantry/Types.hs index 28ea89640b..64e1a6ad7f 100644 --- a/subs/pantry/src/Pantry/Types.hs +++ b/subs/pantry/src/Pantry/Types.hs @@ -983,7 +983,12 @@ parseWantedCompiler t0 = maybe (Left $ InvalidWantedCompiler t0) Right $ Just t1 -> parseGhcjs t1 Nothing -> T.stripPrefix "ghc-" t0 >>= parseGhc where - parseGhcjs = undefined + parseGhcjs t1 = do + let (ghcjsVT, t2) = T.break (== '_') t1 + ghcjsV <- parseVersion $ T.unpack ghcjsVT + ghcVT <- T.stripPrefix "_ghc-" t2 + ghcV <- parseVersion $ T.unpack ghcVT + pure $ WCGhcjs ghcjsV ghcV parseGhc = fmap WCGhc . parseVersion . T.unpack data UnresolvedSnapshotLocation diff --git a/subs/pantry/test/Pantry/TypesSpec.hs b/subs/pantry/test/Pantry/TypesSpec.hs new file mode 100644 index 0000000000..b97baab973 --- /dev/null +++ b/subs/pantry/test/Pantry/TypesSpec.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Pantry.TypesSpec (spec) where + +import Test.Hspec +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Pantry +import RIO +import Distribution.Types.Version (mkVersion) + +hh :: HasCallStack => String -> Property -> Spec +hh name p = it name $ do + result <- check p + unless result $ throwString "Hedgehog property failed" :: IO () + +spec :: Spec +spec = do + describe "WantedCompiler" $ do + hh "parse/render works" $ property $ do + wc <- forAll $ + let ghc = WCGhc <$> genVersion + ghcjs = WCGhcjs <$> genVersion <*> genVersion + genVersion = mkVersion <$> Gen.list (Range.linear 1 5) (Gen.int (Range.linear 0 100)) + in Gen.choice [ghc, ghcjs] + let text = utf8BuilderToText $ display wc + case parseWantedCompiler text of + Left e -> throwIO e + Right actual -> liftIO $ actual `shouldBe` wc