@@ -1,6 +1,7 @@
1{-# LANGUAGE AllowAmbiguousTypes #-}
1{-# LANGUAGE AllowAmbiguousTypes #-}
2{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE OverloadedLabels #-}
3{-# LANGUAGE OverloadedLabels #-}
4+{-# LANGUAGE TemplateHaskell #-}
5module Data.Schematic.JsonSchema
6module Data.Schematic.JsonSchema
6 ( toJsonSchema
7 ( toJsonSchema
@@ -8,9 +9,10 @@ module Data.Schematic.JsonSchema
10import Control.Monad.State.Strict
11import Control.Monad.State.Strict
11−import Data.Foldable
12+import Data.Aeson as J
13+import Data.Foldable as F
12import Data.HashMap.Strict as H
14import Data.HashMap.Strict as H
13−import Data.List.NonEmpty
15+import Data.List.NonEmpty as NE
14import Data.Schematic.Schema as S
16import Data.Schematic.Schema as S
15import Data.Singletons
17import Data.Singletons
16import Data.Text
18import Data.Text
@@ -19,24 +21,39 @@ import JSONSchema.Validator.Draft4 as D4
21draft4 :: Text
23draft4 :: Text
22−draft4 = "http://Jason-schema.org/draft-04/schema#"
24+draft4 = "http://json-schema.org/draft-04/schema#"
24−-- FIXME: implement all this later
25textConstraint :: DemotedTextConstraint -> State D4.Schema ()
26textConstraint :: DemotedTextConstraint -> State D4.Schema ()
26−textConstraint (DTEq _) = pure ()
27+textConstraint (DTEq n) = modify $ \s -> s
28+ { _schemaMinLength = pure $ fromIntegral n
29+ , _schemaMaxLength = pure $ fromIntegral n }
27−textConstraint (DTLt _) = pure ()
30+textConstraint (DTLt n) = modify $ \s -> s
31+ { _schemaMaxLength = pure . fromIntegral $ n + 1 }
28−textConstraint (DTLe _) = pure ()
32+textConstraint (DTLe n) = modify $ \s -> s
33+ { _schemaMaxLength = pure . fromIntegral $ n }
29−textConstraint (DTGt _) = pure ()
34+textConstraint (DTGt n) =
35+ let n' = if n == 0 then 0 else n - 1
36+ in modify $ \s -> s { _schemaMinLength = pure . fromIntegral $ n' }
30−textConstraint (DTGe _) = pure ()
37+textConstraint (DTGe n) = modify $ \s -> s
38+ { _schemaMinLength = pure . fromIntegral $ n }
31−textConstraint (DTRegex _) = pure ()
39+textConstraint (DTRegex r) = modify $ \s -> s { _schemaPattern = pure r }
32−textConstraint (DTEnum _) = pure ()
40+textConstraint (DTEnum ss) =
41+ let ss' = if F.length ss == 0 then [] else NE.fromList $ J.String <$> ss
42+ in modify $ \s -> s { _schemaEnum = pure ss' }
34numberConstraint :: DemotedNumberConstraint -> State D4.Schema ()
44numberConstraint :: DemotedNumberConstraint -> State D4.Schema ()
35−numberConstraint (DNLe _) = pure ()
45+numberConstraint (DNLe n) = modify $ \s -> s
46+ { _schemaMaximum = pure . fromIntegral $ n }
36−numberConstraint (DNLt _) = pure ()
47+numberConstraint (DNLt n) = modify $ \s -> s
48+ { _schemaMaximum = pure . fromIntegral $ n + 1 }
37−numberConstraint (DNGt _) = pure ()
49+numberConstraint (DNGt n) = modify $ \s -> s
50+ { _schemaMinimum = pure . fromIntegral $ n }
38−numberConstraint (DNGe _) = pure ()
51+numberConstraint (DNGe n) =
52+ let n' = if n == 0 then 0 else n - 1
53+ in modify $ \s -> s { _schemaMinimum = pure . fromIntegral $ n' }
39−numberConstraint (DNEq _) = pure ()
54+numberConstraint (DNEq n) = modify $ \s -> s
55+ { _schemaMinimum = pure $ fromIntegral n
56+ , _schemaMaximum = pure $ fromIntegral n }
41arrayConstraint :: DemotedArrayConstraint -> State D4.Schema ()
58arrayConstraint :: DemotedArrayConstraint -> State D4.Schema ()
42arrayConstraint (DAEq _) = pure ()
59arrayConstraint (DAEq _) = pure ()