a8ac1ae · schematic · git.iko.soy

git.iko.soy/schematic

on master help sign in

notes

a8ac1aeNikita8 years ago

src/Data/Schematic/Generator.hs+12−39

compare with master

unifiedsplit

@@ -1,15 +1,12 @@

1−{-# OPTIONS_GHC -fno-warn-orphans #-}

2module Data.Schematic.Generator where

1module Data.Schematic.Generator where

4import Data.Maybe

3import Data.Maybe

5−import Data.Schematic.Schema

4+import Data.Schematic.Generator.Regex

5+import {-# SOURCE #-} Data.Schematic.Schema

6+import Data.Schematic.Verifier

6import Data.Scientific

7import Data.Scientific

7−import Data.Singletons

8import Data.Text (Text, pack)

9import qualified Data.Vector as V

10−import Data.Vinyl

11−import Data.Schematic.Generator.Regex

12−import Data.Schematic.Verifier

13import Test.SmallCheck.Series

10import Test.SmallCheck.Series

15maxHigh :: Int

12maxHigh :: Int

@@ -21,13 +18,14 @@ minLow = 2

21textLengthSeries :: Monad m => [VerifiedTextConstraint] -> Series m Text

18textLengthSeries :: Monad m => [VerifiedTextConstraint] -> Series m Text

22textLengthSeries =

19textLengthSeries =

23 \case

20 \case

24− [VTEq eq] -> pure $ pack $ take (fromIntegral eq) $ cycle "sample"

21+ [VTEq eq] -> pure $ pack $ take (fromIntegral eq) $ cycle "sample"

25 [VTBounds ml mh] -> do

22 [VTBounds ml mh] -> do

23+ let

26− let l = fromMaybe minLow (fromIntegral <$> ml) + 1

24+ l = fromMaybe minLow (fromIntegral <$> ml) + 1

27− h = fromMaybe maxHigh (fromIntegral <$> mh) - 1

25+ h = fromMaybe maxHigh (fromIntegral <$> mh) - 1

28 n <- generate $ \depth -> take depth [l .. h]

26 n <- generate $ \depth -> take depth [l .. h]

29 pure $ pack $ take (fromIntegral n) $ cycle "sample"

27 pure $ pack $ take (fromIntegral n) $ cycle "sample"

30− _ -> pure "error"

28+ _ -> pure "error"

32textEnumSeries :: Monad m => [Text] -> Series m Text

30textEnumSeries :: Monad m => [Text] -> Series m Text

33textEnumSeries enum = generate $ \depth -> take depth enum

31textEnumSeries enum = generate $ \depth -> take depth enum

@@ -38,8 +36,8 @@ textSeries cs = do

38 case mvcs of

36 case mvcs of

39 Just vcs -> do

37 Just vcs -> do

40 n <- textSeries' vcs

38 n <- textSeries' vcs

41− pure $ n

39+ pure n

42− Nothing -> pure "error"

40+ Nothing -> pure "error"

44textSeries' :: Monad m => [VerifiedTextConstraint] -> Series m Text

42textSeries' :: Monad m => [VerifiedTextConstraint] -> Series m Text

45textSeries' [] = pure "sample"

43textSeries' [] = pure "sample"

@@ -50,7 +48,7 @@ textSeries' vcs = do

50 Nothing -> do

48 Nothing -> do

51 let regexps = listToMaybe [x | VTRegex x _ _ <- vcs]

49 let regexps = listToMaybe [x | VTRegex x _ _ <- vcs]

52 case regexps of

50 case regexps of

53− Just e -> regexSeries e

51+ Just e -> regexSeries e

54 Nothing -> textLengthSeries vcs

52 Nothing -> textLengthSeries vcs

56numberSeries :: Monad m => [DemotedNumberConstraint] -> Series m Scientific

54numberSeries :: Monad m => [DemotedNumberConstraint] -> Series m Scientific

@@ -80,7 +78,7 @@ arraySeries cs = do

80 let mvcs = verifyArrayConstraint cs

78 let mvcs = verifyArrayConstraint cs

81 case mvcs of

79 case mvcs of

82 Just vcs -> arraySeries' vcs

80 Just vcs -> arraySeries' vcs

83− Nothing -> pure V.empty

81+ Nothing -> pure V.empty

85arraySeries'

83arraySeries'

86 :: forall m s. (Monad m, Serial m (JsonRepr s))

84 :: forall m s. (Monad m, Serial m (JsonRepr s))

@@ -91,28 +89,3 @@ arraySeries' ml = do

91 pure $ objs

89 pure $ objs

92 where

90 where

93 f (VAEq l) = fromIntegral l

91 f (VAEq l) = fromIntegral l

94−

95−instance (Monad m, Serial m Text, SingI cs)

96− => Serial m (JsonRepr ('SchemaText cs)) where

97− series = decDepth $ fmap ReprText $ textSeries $ fromSing (sing :: Sing cs)

98−

99−instance (Monad m, Serial m Scientific, SingI cs)

100− => Serial m (JsonRepr ('SchemaNumber cs)) where

101− series = decDepth $ fmap ReprNumber

102− $ numberSeries $ fromSing (sing :: Sing cs)

103−

104−instance Monad m => Serial m (JsonRepr 'SchemaNull) where

105− series = cons0 ReprNull

106−

107−instance (Serial m (JsonRepr s), Serial m (V.Vector (JsonRepr s)), SingI cs)

108− => Serial m (JsonRepr ('SchemaArray cs s)) where

109− series = decDepth $ fmap ReprArray

110− $ arraySeries $ fromSing (sing :: Sing cs)

111−

112−instance (Serial m (JsonRepr s))

113− => Serial m (JsonRepr ('SchemaOptional s)) where

114− series = cons1 ReprOptional

115−

116−instance (Monad m, Serial m (Rec FieldRepr fs))

117− => Serial m (JsonRepr ('SchemaObject fs)) where

118− series = cons1 ReprObject

src/Data/Schematic/Generator/Regex.hs+10−10

@@ -1,15 +1,15 @@

1module Data.Schematic.Generator.Regex where

3−import Control.Monad

3+import Control.Monad

4−import Data.List

4+import Data.List

5−import Data.Maybe

5+import Data.Maybe

6import qualified Data.Set as S

7−import Data.Text (Text, unpack)

7+import Data.Text (Text, unpack)

8−import Data.Text.Lazy (toStrict)

8+import Data.Text.Lazy (toStrict)

9−import Data.Text.Lazy.Builder (Builder, singleton, toLazyText)

9+import Data.Text.Lazy.Builder (Builder, singleton, toLazyText)

10−import Test.SmallCheck.Series

10+import Test.SmallCheck.Series

11−import Text.Regex.TDFA.Pattern

11+import Text.Regex.TDFA.Pattern

12−import Text.Regex.TDFA.ReadRegex (parseRegex)

12+import Text.Regex.TDFA.ReadRegex (parseRegex)

15minRepeat :: Int

@@ -22,7 +22,7 @@ regexSeries :: (Monad m) => Text -> Series m Text

22regexSeries regexp =

23 case parseRegex . unpack $ regexp of

24 Right (p, _) -> toStrict . toLazyText <$> regexSeries' p

25− Left _ -> pure ""

25+ Left _ -> pure ""

27regexSeries' :: (Monad m) => Pattern -> Series m Builder

28regexSeries' pt =

src/Data/Schematic/Schema.hs+41−14

@@ -13,6 +13,7 @@ import Data.HashMap.Strict as H

13import Data.Kind

14import Data.Maybe

15import Data.Schematic.Instances ()

16+import Data.Schematic.Generator

16import Data.Scientific

17import Data.Scientific

17import Data.Singletons.Prelude.List hiding (All, Union)

18import Data.Singletons.Prelude.List hiding (All, Union)

18import Data.Singletons.TH

19import Data.Singletons.TH

@@ -24,7 +25,8 @@ import Data.Vinyl hiding (Dict)

24import qualified Data.Vinyl.TypeLevel as V

25import qualified Data.Vinyl.TypeLevel as V

25import GHC.Exts

26import GHC.Exts

26import GHC.Generics (Generic)

27import GHC.Generics (Generic)

28+import GHC.TypeLits

27−import GHC.TypeLits (SomeNat(..), SomeSymbol(..), someSymbolVal, someNatVal)

29+ (SomeNat(..), SomeSymbol(..), someNatVal, someSymbolVal)

28import Prelude as P

30import Prelude as P

29import Test.SmallCheck.Series

31import Test.SmallCheck.Series

@@ -56,25 +58,25 @@ instance SingKind TextConstraint where

56 STRegex s -> withKnownSymbol s (DTRegex $ T.pack $ symbolVal s)

58 STRegex s -> withKnownSymbol s (DTRegex $ T.pack $ symbolVal s)

57 STEnum s -> let

59 STEnum s -> let

58 d :: Sing (s :: [Symbol]) -> [Text]

60 d :: Sing (s :: [Symbol]) -> [Text]

59− d SNil = []

61+ d SNil = []

60 d (SCons ss@SSym fs) = T.pack (symbolVal ss) : d fs

62 d (SCons ss@SSym fs) = T.pack (symbolVal ss) : d fs

61 in DTEnum $ d s

63 in DTEnum $ d s

62 toSing = \case

64 toSing = \case

63 DTEq n -> case someNatVal n of

65 DTEq n -> case someNatVal n of

64 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STEq (SNat :: Sing n))

66 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STEq (SNat :: Sing n))

65− Nothing -> error "Negative singleton nat"

67+ Nothing -> error "Negative singleton nat"

66 DTLt n -> case someNatVal n of

68 DTLt n -> case someNatVal n of

67 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STLt (SNat :: Sing n))

69 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STLt (SNat :: Sing n))

68− Nothing -> error "Negative singleton nat"

70+ Nothing -> error "Negative singleton nat"

69 DTLe n -> case someNatVal n of

71 DTLe n -> case someNatVal n of

70 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STLe (SNat :: Sing n))

72 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STLe (SNat :: Sing n))

71− Nothing -> error "Negative singleton nat"

73+ Nothing -> error "Negative singleton nat"

72 DTGt n -> case someNatVal n of

74 DTGt n -> case someNatVal n of

73 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STGt (SNat :: Sing n))

75 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STGt (SNat :: Sing n))

74− Nothing -> error "Negative singleton nat"

76+ Nothing -> error "Negative singleton nat"

75 DTGe n -> case someNatVal n of

77 DTGe n -> case someNatVal n of

76 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STGe (SNat :: Sing n))

78 Just (SomeNat (_ :: Proxy n)) -> SomeSing (STGe (SNat :: Sing n))

77− Nothing -> error "Negative singleton nat"

79+ Nothing -> error "Negative singleton nat"

78 DTRegex s -> case someSymbolVal (T.unpack s) of

80 DTRegex s -> case someSymbolVal (T.unpack s) of

79 SomeSymbol (_ :: Proxy n) -> SomeSing (STRegex (SSym :: Sing n))

81 SomeSymbol (_ :: Proxy n) -> SomeSing (STRegex (SSym :: Sing n))

80 DTEnum ss -> case toSing ss of

82 DTEnum ss -> case toSing ss of

@@ -161,19 +163,19 @@ instance SingKind NumberConstraint where

161 toSing = \case

163 toSing = \case

162 DNEq n -> case someNatVal n of

164 DNEq n -> case someNatVal n of

163 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNEq (SNat :: Sing n))

165 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNEq (SNat :: Sing n))

164− Nothing -> error "Negative singleton nat"

166+ Nothing -> error "Negative singleton nat"

165 DNGt n -> case someNatVal n of

167 DNGt n -> case someNatVal n of

166 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNGt (SNat :: Sing n))

168 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNGt (SNat :: Sing n))

167− Nothing -> error "Negative singleton nat"

169+ Nothing -> error "Negative singleton nat"

168 DNGe n -> case someNatVal n of

170 DNGe n -> case someNatVal n of

169 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNGe (SNat :: Sing n))

171 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNGe (SNat :: Sing n))

170− Nothing -> error "Negative singleton nat"

172+ Nothing -> error "Negative singleton nat"

171 DNLt n -> case someNatVal n of

173 DNLt n -> case someNatVal n of

172 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNLt (SNat :: Sing n))

174 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNLt (SNat :: Sing n))

173− Nothing -> error "Negative singleton nat"

175+ Nothing -> error "Negative singleton nat"

174 DNLe n -> case someNatVal n of

176 DNLe n -> case someNatVal n of

175 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNLe (SNat :: Sing n))

177 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNLe (SNat :: Sing n))

176− Nothing -> error "Negative singleton nat"

178+ Nothing -> error "Negative singleton nat"

177

179

178data ArrayConstraint

180data ArrayConstraint

179 = AEq Nat

181 = AEq Nat

@@ -197,7 +199,7 @@ instance SingKind ArrayConstraint where

197 toSing = \case

199 toSing = \case

198 DAEq n -> case someNatVal n of

200 DAEq n -> case someNatVal n of

199 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SAEq (SNat :: Sing n))

201 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SAEq (SNat :: Sing n))

200− Nothing -> error "Negative singleton nat"

202+ Nothing -> error "Negative singleton nat"

201

203

202data Schema

204data Schema

203 = SchemaText [TextConstraint]

205 = SchemaText [TextConstraint]

@@ -334,6 +336,31 @@ data JsonRepr :: Schema -> Type where

334 ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)

336 ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)

335 ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))

337 ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))

336

338

339+instance (Monad m, Serial m Text, SingI cs)

340+ => Serial m (JsonRepr ('SchemaText cs)) where

341+ series = decDepth $ fmap ReprText $ textSeries $ fromSing (sing :: Sing cs)

342+

343+instance (Monad m, Serial m Scientific, SingI cs)

344+ => Serial m (JsonRepr ('SchemaNumber cs)) where

345+ series = decDepth $ fmap ReprNumber

346+ $ numberSeries $ fromSing (sing :: Sing cs)

347+

348+instance Monad m => Serial m (JsonRepr 'SchemaNull) where

349+ series = cons0 ReprNull

350+

351+instance (Serial m (JsonRepr s), Serial m (V.Vector (JsonRepr s)), SingI cs)

352+ => Serial m (JsonRepr ('SchemaArray cs s)) where

353+ series = decDepth $ fmap ReprArray

354+ $ arraySeries $ fromSing (sing :: Sing cs)

355+

356+instance (Serial m (JsonRepr s))

357+ => Serial m (JsonRepr ('SchemaOptional s)) where

358+ series = cons1 ReprOptional

359+

360+instance (Monad m, Serial m (Rec FieldRepr fs))

361+ => Serial m (JsonRepr ('SchemaObject fs)) where

362+ series = cons1 ReprObject

363+

337-- | Move to the union package

364-- | Move to the union package

338instance Show (JsonRepr ('SchemaText cs)) where

365instance Show (JsonRepr ('SchemaText cs)) where

339 show (ReprText t) = "ReprText " P.++ show t

366 show (ReprText t) = "ReprText " P.++ show t

@@ -479,7 +506,7 @@ instance J.ToJSON (JsonRepr a) where

479 toJSON (ReprText t) = J.String t

506 toJSON (ReprText t) = J.String t

480 toJSON (ReprNumber n) = J.Number n

507 toJSON (ReprNumber n) = J.Number n

481 toJSON (ReprOptional s) = case s of

508 toJSON (ReprOptional s) = case s of

482− Just v -> toJSON v

509+ Just v -> toJSON v

483 Nothing -> J.Null

510 Nothing -> J.Null

484 toJSON (ReprArray v) = J.Array $ toJSON <$> v

511 toJSON (ReprArray v) = J.Array $ toJSON <$> v

485 toJSON (ReprObject r) = J.Object . H.fromList . fold $ r

512 toJSON (ReprObject r) = J.Object . H.fromList . fold $ r

src/Data/Schematic/Schema.hs-bootnew file+87

@@ -0,0 +1,87 @@

1+module Data.Schematic.Schema where

3+import Data.Kind

4+import Data.Maybe

5+import Data.Schematic.Instances ()

6+import Data.Scientific

7+import Data.Singletons.TH

8+import Data.Singletons.TypeLits

9+import Data.Text as T

10+import Data.Union

11+import Data.Vector as V

12+import Data.Vinyl hiding (Dict)

13+import Prelude as P

14+

15+data TextConstraint

16+ = TEq Nat

17+ | TLt Nat

18+ | TLe Nat

19+ | TGt Nat

20+ | TGe Nat

21+ | TRegex Symbol

22+ | TEnum [Symbol]

23+

24+data DemotedTextConstraint

25+ = DTEq Integer

26+ | DTLt Integer

27+ | DTLe Integer

28+ | DTGt Integer

29+ | DTGe Integer

30+ | DTRegex Text

31+ | DTEnum [Text]

32+

33+data NumberConstraint

34+ = NLe Nat

35+ | NLt Nat

36+ | NGt Nat

37+ | NGe Nat

38+ | NEq Nat

39+

40+data DemotedNumberConstraint

41+ = DNLe Integer

42+ | DNLt Integer

43+ | DNGt Integer

44+ | DNGe Integer

45+ | DNEq Integer

46+

47+data ArrayConstraint

48+ = AEq Nat

49+

50+data DemotedArrayConstraint

51+ = DAEq Integer

52+

53+data Schema

54+ = SchemaText [TextConstraint]

55+ | SchemaBoolean

56+ | SchemaNumber [NumberConstraint]

57+ | SchemaObject [(Symbol, Schema)]

58+ | SchemaArray [ArrayConstraint] Schema

59+ | SchemaNull

60+ | SchemaOptional Schema

61+ | SchemaUnion [Schema]

62+

63+data DemotedSchema

64+ = DSchemaText [DemotedTextConstraint]

65+ | DSchemaNumber [DemotedNumberConstraint]

66+ | DSchemaBoolean

67+ | DSchemaObject [(Text, DemotedSchema)]

68+ | DSchemaArray [DemotedArrayConstraint] DemotedSchema

69+ | DSchemaNull

70+ | DSchemaOptional DemotedSchema

71+ | DSchemaUnion [DemotedSchema]

72+

73+data FieldRepr :: (Symbol, Schema) -> Type where

74+ FieldRepr

75+ :: (SingI schema, KnownSymbol name)

76+ => JsonRepr schema

77+ -> FieldRepr '(name, schema)

78+

79+data JsonRepr :: Schema -> Type where

80+ ReprText :: Text -> JsonRepr ('SchemaText cs)

81+ ReprNumber :: Scientific -> JsonRepr ('SchemaNumber cs)

82+ ReprBoolean :: Bool -> JsonRepr 'SchemaBoolean

83+ ReprNull :: JsonRepr 'SchemaNull

84+ ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)

85+ ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)

86+ ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)

87+ ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))

src/Data/Schematic/Verifier/Array.hs+1−1

@@ -1,6 +1,6 @@

1module Data.Schematic.Verifier.Array where

3−import Data.Schematic

3+import {-# SOURCE #-} Data.Schematic.Schema

4import Data.Schematic.Verifier.Common

6data VerifiedArrayConstraint =

src/Data/Schematic/Verifier/Common.hs+1−1

@@ -6,7 +6,7 @@ simplifyNumberConstraint :: ([Integer] -> Integer) -> [Integer] -> Maybe Integer

6simplifyNumberConstraint f =

7 \case

8 [] -> Nothing

9− x -> Just $ f x

9+ x -> Just $ f x

11simplifyDNLs :: [Integer] -> Maybe Integer

12simplifyDNLs = simplifyNumberConstraint minimum

src/Data/Schematic/Verifier/Number.hs+5−6

@@ -1,6 +1,6 @@

1module Data.Schematic.Verifier.Number where

3−import Data.Schematic

3+import {-# SOURCE #-} Data.Schematic.Schema

4import Data.Schematic.Verifier.Common

6toStrictNumber :: [DemotedNumberConstraint] -> [DemotedNumberConstraint]

@@ -8,16 +8,15 @@ toStrictNumber = map f

8 where

9 f (DNLe x) = DNLt (x + 1)

10 f (DNGe x) = DNGt (x - 1)

11− f x = x

11+ f x = x

13data VerifiedNumberConstraint

14 = VNEq Integer

15− | VNBounds (Maybe Integer)

15+ | VNBounds (Maybe Integer) (Maybe Integer)

16− (Maybe Integer)

17 deriving (Show)

16 deriving (Show)

19−verifyNumberConstraints ::

18+verifyNumberConstraints

20− [DemotedNumberConstraint]

19+ :: [DemotedNumberConstraint]

21 -> Maybe VerifiedNumberConstraint

20 -> Maybe VerifiedNumberConstraint

22verifyNumberConstraints cs' = do

21verifyNumberConstraints cs' = do

23 let

22 let

src/Data/Schematic/Verifier/Text.hs+13−14

@@ -2,7 +2,7 @@ module Data.Schematic.Verifier.Text where

3import Control.Monad

4import Data.Maybe

5−import Data.Schematic

5+import {-# SOURCE #-} Data.Schematic.Schema

6import Data.Schematic.Verifier.Common

7import Data.Text (Text, unpack)

8import Text.Regex.TDFA.Pattern

@@ -13,15 +13,12 @@ toStrictTextLength = map f

13 where

14 f (DTLe x) = DTLt (x + 1)

15 f (DTGe x) = DTGt (x - 1)

16− f x = x

16+ f x = x

18data VerifiedTextConstraint

19 = VTEq Integer

20− | VTBounds (Maybe Integer)

20+ | VTBounds (Maybe Integer) (Maybe Integer)

21− (Maybe Integer)

22− | VTRegex Text

23− Integer

24− (Maybe Integer)

21+ | VTRegex Text Integer (Maybe Integer)

25 | VTEnum [Text]

22 | VTEnum [Text]

26 deriving (Show)

23 deriving (Show)

@@ -29,9 +26,10 @@ verifyTextLengthConstraints

29 :: [DemotedTextConstraint]

26 :: [DemotedTextConstraint]

30 -> Maybe (Maybe VerifiedTextConstraint)

27 -> Maybe (Maybe VerifiedTextConstraint)

31verifyTextLengthConstraints cs' = do

28verifyTextLengthConstraints cs' = do

29+ let

32− let cs = toStrictTextLength cs'

30+ cs = toStrictTextLength cs'

33− mlt = simplifyDNLs [x | DTLt x <- cs]

31+ mlt = simplifyDNLs [x | DTLt x <- cs]

34− mgt = simplifyDNGs [x | DTGt x <- cs]

32+ mgt = simplifyDNGs [x | DTGt x <- cs]

35 meq <- verifyDNEq [x | DTEq x <- cs]

33 meq <- verifyDNEq [x | DTEq x <- cs]

36 verifyEquations mgt meq mlt

34 verifyEquations mgt meq mlt

37 case all isNothing ([mgt, meq, mlt] :: [Maybe Integer]) of

35 case all isNothing ([mgt, meq, mlt] :: [Maybe Integer]) of

@@ -113,10 +111,11 @@ verifyTextConstraints

113 -> Maybe [VerifiedTextConstraint]

111 -> Maybe [VerifiedTextConstraint]

114verifyTextConstraints cs = do

112verifyTextConstraints cs = do

115 regexp <- verifyTextRegexConstraint cs

113 regexp <- verifyTextRegexConstraint cs

114+ void $

116− void $ case regexp of

115+ case regexp of

117− Just (VTRegex _ l mh) ->

116+ Just (VTRegex _ l mh) ->

118− verifyTextLengthConstraints (DTGe l : cs ++ maybeToList (DTLe <$> mh))

117+ verifyTextLengthConstraints (DTGe l : cs ++ maybeToList (DTLe <$> mh))

119− _ -> pure Nothing

118+ _ -> pure Nothing

120 lengths <- verifyTextLengthConstraints cs

119 lengths <- verifyTextLengthConstraints cs

121 enums <- verifyTextEnumConstraint cs

120 enums <- verifyTextEnumConstraint cs

122 return $ catMaybes [lengths, enums, regexp]

121 return $ catMaybes [lengths, enums, regexp]