diff --git a/bloodhound.cabal b/bloodhound.cabal index 127a6d0..6889f23 100644 --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -64,23 +64,24 @@ library Database.Bloodhound.Common.Script hs-source-dirs: src build-depends: base >= 4.3 && <5, + aeson >= 0.11.1, + blaze-builder, bytestring >= 0.10.0 && <0.11, containers >= 0.5.0.0 && <0.6, - aeson >= 0.11.1, - http-client >= 0.4.30 && <0.6, - network-uri >= 2.6 && <2.7, - semigroups >= 0.15 && <0.19, - time >= 1.4 && <1.9, - text >= 0.11 && <1.3, - mtl >= 1.0 && <2.3, - transformers >= 0.2 && <0.6, - http-types >= 0.8 && <0.13, - vector >= 0.10.9 && <0.13, - scientific >= 0.3.0.0 && <0.4.0.0, - blaze-builder, exceptions, hashable, - unordered-containers + http-client >= 0.4.30 && <0.6, + http-types >= 0.8 && <0.13, + mtl >= 1.0 && <2.3, + network-uri >= 2.6 && <2.7, + scientific >= 0.3.0.0 && <0.4.0.0, + semigroups >= 0.15 && <0.19, + semver, + text >= 0.11 && <1.3, + time >= 1.4 && <1.9, + transformers >= 0.2 && <0.6, + unordered-containers, + vector >= 0.10.9 && <0.13 default-language: Haskell2010 test-suite bloodhound-tests @@ -109,28 +110,29 @@ test-suite bloodhound-tests Test.Suggest Test.Templates build-depends: base, + QuickCheck, + aeson, bloodhound, bytestring, + containers, + errors, + exceptions, + hspec >= 1.8, http-client, http-types, - containers, - hspec >= 1.8, - text, - time, - aeson, - semigroups, - QuickCheck, - vector, - unordered-containers >= 0.2.5.0 && <0.3, + microlens, + microlens-aeson, mtl, + network-uri, pretty-simple, quickcheck-arbitrary-template, quickcheck-properties, - errors, - exceptions, + semigroups, + semver, temporary, + text, + time, unix-compat, - network-uri, - microlens, - microlens-aeson + unordered-containers >= 0.2.5.0 && <0.3, + vector default-language: Haskell2010 diff --git a/src/Database/V5/Bloodhound/Internal/Client.hs b/src/Database/V5/Bloodhound/Internal/Client.hs index cf58403..417359e 100644 --- a/src/Database/V5/Bloodhound/Internal/Client.hs +++ b/src/Database/V5/Bloodhound/Internal/Client.hs @@ -12,11 +12,10 @@ import Bloodhound.Import import qualified Data.Text as T import qualified Data.Traversable as DT import qualified Data.HashMap.Strict as HM +import qualified Data.SemVer as SemVer import qualified Data.Vector as V -import qualified Data.Version as Vers import GHC.Enum import Network.HTTP.Client -import qualified Text.ParserCombinators.ReadP as RP import Text.Read (Read(..)) import qualified Text.Read as TR @@ -98,7 +97,7 @@ data Version = Version { number :: VersionNumber -- | Traditional software versioning number newtype VersionNumber = VersionNumber - { versionNumber :: Vers.Version } + { versionNumber :: SemVer.Version } deriving (Eq, Ord, Show) {-| 'Status' is a data type for describing the JSON body returned by @@ -2398,12 +2397,12 @@ instance FromJSON Version where <*> o .: "lucene_version" instance ToJSON VersionNumber where - toJSON = toJSON . Vers.showVersion . versionNumber + toJSON = toJSON . SemVer.toText . versionNumber instance FromJSON VersionNumber where - parseJSON = withText "VersionNumber" (parse . T.unpack) + parseJSON = withText "VersionNumber" parse where - parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of - [(v, _)] -> pure (VersionNumber v) - [] -> fail ("Invalid version string " ++ s) - xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")") + parse t = + case SemVer.fromText t of + (Left err) -> fail err + (Right v) -> return (VersionNumber v) diff --git a/stack-8.2.yaml b/stack-8.2.yaml index 109c76c..ccd6fd3 100644 --- a/stack-8.2.yaml +++ b/stack-8.2.yaml @@ -7,9 +7,9 @@ packages: - './examples' extra-deps: - - quickcheck-properties-0.1 - - http-types-0.12.1 - aeson-1.3.0.0 + - http-types-0.12.1 - quickcheck-arbitrary-template-0.2.0.0 + - quickcheck-properties-0.1 resolver: lts-11.6 diff --git a/tests/V5/Test/Common.hs b/tests/V5/Test/Common.hs index 53bd8b2..bc19cc0 100644 --- a/tests/V5/Test/Common.hs +++ b/tests/V5/Test/Common.hs @@ -6,7 +6,7 @@ module Test.Common where import Test.Import import qualified Data.Map as M -import qualified Data.Version as Vers +import qualified Data.SemVer as SemVer import qualified Network.HTTP.Types.Status as NHTS testServer :: Server @@ -50,31 +50,31 @@ instance ToJSON ParentMapping where , "extra" .= object ["type" .= ("keyword" :: Text)] ]] -es13 :: Vers.Version -es13 = Vers.Version [1, 3, 0] [] +es11 :: SemVer.Version +es11 = SemVer.version 1 1 0 [] [] -es12 :: Vers.Version -es12 = Vers.Version [1, 2, 0] [] +es13 :: SemVer.Version +es13 = SemVer.version 1 3 0 [] [] -es11 :: Vers.Version -es11 = Vers.Version [1, 1, 0] [] +es12 :: SemVer.Version +es12 = SemVer.version 1 2 0 [] [] -es14 :: Vers.Version -es14 = Vers.Version [1, 4, 0] [] +es14 :: SemVer.Version +es14 = SemVer.version 1 4 0 [] [] -es15 :: Vers.Version -es15 = Vers.Version [1, 5, 0] [] +es15 :: SemVer.Version +es15 = SemVer.version 1 5 0 [] [] -es16 :: Vers.Version -es16 = Vers.Version [1, 6, 0] [] +es16 :: SemVer.Version +es16 = SemVer.version 1 6 0 [] [] -es20 :: Vers.Version -es20 = Vers.Version [2, 0, 0] [] +es20 :: SemVer.Version +es20 = SemVer.version 2 0 0 [] [] -es50 :: Vers.Version -es50 = Vers.Version [5, 0, 0] [] +es50 :: SemVer.Version +es50 = SemVer.version 5 0 0 [] [] -getServerVersion :: IO (Maybe Vers.Version) +getServerVersion :: IO (Maybe SemVer.Version) getServerVersion = fmap extractVersion <$> withTestEnv getStatus where extractVersion = versionNumber . number . version @@ -282,11 +282,11 @@ searchExpectSource src expected = do liftIO $ value `shouldBe` expected -atleast :: Vers.Version -> IO Bool +atleast :: SemVer.Version -> IO Bool atleast v = getServerVersion >>= \x -> return $ x >= Just v -atmost :: Vers.Version -> IO Bool +atmost :: SemVer.Version -> IO Bool atmost v = getServerVersion >>= \x -> return $ x <= Just v -is :: Vers.Version -> IO Bool +is :: SemVer.Version -> IO Bool is v = getServerVersion >>= \x -> return $ x == Just v diff --git a/tests/V5/Test/Generators.hs b/tests/V5/Test/Generators.hs index be15afd..1f80b76 100644 --- a/tests/V5/Test/Generators.hs +++ b/tests/V5/Test/Generators.hs @@ -14,7 +14,7 @@ import qualified Data.List as L import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import qualified Data.Text as T -import qualified Data.Version as Vers +import qualified Data.SemVer as SemVer import Test.QuickCheck.TH.Generators import Test.ApproxEq @@ -215,9 +215,13 @@ instance Arbitrary NodeAttrFilter where return (NodeAttrFilter n ts) instance Arbitrary VersionNumber where - arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary + arbitrary = do + major <- posInt + minor <- posInt + patch <- posInt + return $ VersionNumber $ SemVer.version major minor patch [] [] where - mk versions = VersionNumber (Vers.Version versions []) + posInt = getPositive <$> arbitrary instance Arbitrary TemplateQueryKeyValuePairs where arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary