Semverification

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,
+                       microlens,
-                       hspec                >= 1.8,
+                       microlens-aeson,
-                       text,
-                       time,
-                       aeson,
-                       semigroups,
-                       QuickCheck,
-                       vector,
-                       unordered-containers >= 0.2.5.0 && <0.3,
                        mtl,
+                       network-uri,
                        pretty-simple,
                        quickcheck-arbitrary-template,
                        quickcheck-properties,
-                       errors,
+                       semigroups,
-                       exceptions,
+                       semver,
                        temporary,
+                       text,
+                       time,
                        unix-compat,
-                       network-uri,
+                       unordered-containers >= 0.2.5.0 && <0.3,
-                       microlens,
+                       vector
-                       microlens-aeson
   default-language:    Haskell2010

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
+      parse t =
-                  [(v, _)] -> pure (VersionNumber v)
+        case SemVer.fromText t of
-                  [] -> fail ("Invalid version string " ++ s)
+          (Left err) -> fail err
-                  xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
+          (Right v) -> return (VersionNumber v)

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

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
+es11 :: SemVer.Version
-es13 = Vers.Version [1, 3, 0] []
+es11 = SemVer.version 1 1 0 [] []
 
-es12 :: Vers.Version
+es13 :: SemVer.Version
-es12 = Vers.Version [1, 2, 0] []
+es13 = SemVer.version 1 3 0 [] []
 
-es11 :: Vers.Version
+es12 :: SemVer.Version
-es11 = Vers.Version [1, 1, 0] []
+es12 = SemVer.version 1 2 0 [] []
 
-es14 :: Vers.Version
+es14 :: SemVer.Version
-es14 = Vers.Version [1, 4, 0] []
+es14 = SemVer.version 1 4 0 [] []
 
-es15 :: Vers.Version
+es15 :: SemVer.Version
-es15 = Vers.Version [1, 5, 0] []
+es15 = SemVer.version 1 5 0 [] []
 
-es16 :: Vers.Version
+es16 :: SemVer.Version
-es16 = Vers.Version [1, 6, 0] []
+es16 = SemVer.version 1 6 0 [] []
 
-es20 :: Vers.Version
+es20 :: SemVer.Version
-es20 = Vers.Version [2, 0, 0] []
+es20 = SemVer.version 2 0 0 [] []
 
-es50 :: Vers.Version
+es50 :: SemVer.Version
-es50 = Vers.Version [5, 0, 0] []
+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

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