@@ -1,6 +1,7 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE RecordWildCards #-}
33{-# LANGUAGE OverloadedLabels #-}
4+{-# LANGUAGE TemplateHaskell #-}
45
56module Data.Schematic.JsonSchema
67 ( toJsonSchema
@@ -8,9 +9,10 @@ module Data.Schematic.JsonSchema
89 ) where
910
1011import Control.Monad.State.Strict
11−import Data.Foldable
12+import Data.Aeson as J
13+import Data.Foldable as F
1214import Data.HashMap.Strict as H
13−import Data.List.NonEmpty
15+import Data.List.NonEmpty as NE
1416import Data.Schematic.Schema as S
1517import Data.Singletons
1618import Data.Text
@@ -19,24 +21,39 @@ import JSONSchema.Validator.Draft4 as D4
1921
2022
2123draft4 :: Text
22−draft4 = "http://Jason-schema.org/draft-04/schema#"
24+draft4 = "http://json-schema.org/draft-04/schema#"
2325
24−-- FIXME: implement all this later
2526textConstraint :: DemotedTextConstraint -> State D4.Schema ()
26−textConstraint (DTEq _) = pure ()
27−textConstraint (DTLt _) = pure ()
28−textConstraint (DTLe _) = pure ()
29−textConstraint (DTGt _) = pure ()
30−textConstraint (DTGe _) = pure ()
31−textConstraint (DTRegex _) = pure ()
32−textConstraint (DTEnum _) = pure ()
27+textConstraint (DTEq n) = modify $ \s -> s
28+ { _schemaMinLength = pure $ fromIntegral n
29+ , _schemaMaxLength = pure $ fromIntegral n }
30+textConstraint (DTLt n) = modify $ \s -> s
31+ { _schemaMaxLength = pure . fromIntegral $ n + 1 }
32+textConstraint (DTLe n) = modify $ \s -> s
33+ { _schemaMaxLength = pure . fromIntegral $ n }
34+textConstraint (DTGt n) =
35+ let n' = if n == 0 then 0 else n - 1
36+ in modify $ \s -> s { _schemaMinLength = pure . fromIntegral $ n' }
37+textConstraint (DTGe n) = modify $ \s -> s
38+ { _schemaMinLength = pure . fromIntegral $ n }
39+textConstraint (DTRegex r) = modify $ \s -> s { _schemaPattern = pure r }
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' }
3343
3444numberConstraint :: DemotedNumberConstraint -> State D4.Schema ()
35−numberConstraint (DNLe _) = pure ()
36−numberConstraint (DNLt _) = pure ()
37−numberConstraint (DNGt _) = pure ()
38−numberConstraint (DNGe _) = pure ()
39−numberConstraint (DNEq _) = pure ()
45+numberConstraint (DNLe n) = modify $ \s -> s
46+ { _schemaMaximum = pure . fromIntegral $ n }
47+numberConstraint (DNLt n) = modify $ \s -> s
48+ { _schemaMaximum = pure . fromIntegral $ n + 1 }
49+numberConstraint (DNGt n) = modify $ \s -> s
50+ { _schemaMinimum = pure . fromIntegral $ n }
51+numberConstraint (DNGe n) =
52+ let n' = if n == 0 then 0 else n - 1
53+ in modify $ \s -> s { _schemaMinimum = pure . fromIntegral $ n' }
54+numberConstraint (DNEq n) = modify $ \s -> s
55+ { _schemaMinimum = pure $ fromIntegral n
56+ , _schemaMaximum = pure $ fromIntegral n }
4057
4158arrayConstraint :: DemotedArrayConstraint -> State D4.Schema ()
4259arrayConstraint (DAEq _) = pure ()