NonEmpty ToSchema instance

src/Data/Swagger/Internal/Schema.hs

@@ -44,6 +44,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import Data.Int
 import Data.IntSet (IntSet)
 import Data.IntMap (IntMap)
+import Data.List.NonEmpty (NonEmpty)
 import Data.Map (Map)
 import Data.Proxy
 import Data.Scientific (Scientific)
@@ -561,6 +562,12 @@ instance ToSchema a => ToSchema (Set a) where
 
 instance ToSchema a => ToSchema (HashSet a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set a))
 
+instance ToSchema a => ToSchema (NonEmpty a) where
+  declareNamedSchema _ = do
+    schema <- declareSchema (Proxy :: Proxy [a])
+    return $ unnamed $ schema
+      & minItems .~ Just 1
+
 instance ToSchema All where declareNamedSchema = plain . paramSchemaToSchema
 instance ToSchema Any where declareNamedSchema = plain . paramSchemaToSchema
 

swagger2.cabal

@@ -71,6 +71,8 @@ library
                      , uuid-types >=1.0.2 && <1.1
   if !impl(ghc >= 7.10)
      build-depends:    nats >=1.1.1 && <1.2
+  if !impl(ghc >= 8.0)
+     build-depends:    semigroups >= 0.18.3 && <0.19
   default-language:    Haskell2010
 
 test-suite spec
@@ -96,6 +98,9 @@ test-suite spec
                   , unordered-containers
                   , vector
                   , lens
+  if !impl(ghc >= 8.0)
+     build-depends:    semigroups >= 0.18.3 && <0.19
+
   other-modules:
     SpecCommon
     Data.SwaggerSpec

test/Data/Swagger/Schema/ValidationSpec.hs

@@ -16,6 +16,7 @@ import "unordered-containers" Data.HashSet (HashSet)
 import qualified "unordered-containers" Data.HashSet as HashSet
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
 import Data.Map (Map)
 import Data.Monoid (mempty)
 import Data.Proxy
@@ -69,6 +70,7 @@ spec = do
     -- prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int]))
     prop "(IntMap String)" $ shouldValidate (Proxy :: Proxy (IntMap String))
     prop "(Set Bool)" $ shouldValidate (Proxy :: Proxy (Set Bool))
+    prop "(NonEmpty Bool)" $ shouldValidate (Proxy :: Proxy (NonEmpty Bool))
     prop "(HashSet Bool)" $ shouldValidate (Proxy :: Proxy (HashSet Bool))
     prop "(Either Int String)" $ shouldValidate (Proxy :: Proxy (Either Int String))
     prop "(Int, String)" $ shouldValidate (Proxy :: Proxy (Int, String))
@@ -260,3 +262,13 @@ instance Arbitrary ZonedTime where
 
 instance Arbitrary UTCTime where
   arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
+
+#if MIN_VERSION_QuickCheck(2,10,0)
+-- This instance was removed in QuickCheck 2.10 because of dependencies.
+-- The instance is available in `quickcheck-instances` package, but that
+-- introduces a ton of conflicts with the other instances here.
+
+instance Arbitrary a => Arbitrary (NonEmpty a) where
+  arbitrary = liftA2 (:|) arbitrary arbitrary
+  shrink (x :| xs) = mapMaybe nonEmpty (shrink (x:xs))
+#endif