git.iko.soy/typeable/schematic
on master help sign in
naive json schema
d1c4a61Denis Redozubov
schematic.cabal+3
compare with master
unifiedsplit
@@ -18,6 +18,7 @@ cabal-version: >=1.10
18library
18library
19 exposed-modules: Data.Schematic
19 exposed-modules: Data.Schematic
20 , Data.Schematic.Instances
20 , Data.Schematic.Instances
21+ , Data.Schematic.JsonSchema
21 , Data.Schematic.Lens
22 , Data.Schematic.Lens
22 , Data.Schematic.Migration
23 , Data.Schematic.Migration
23 , Data.Schematic.Path
24 , Data.Schematic.Path
@@ -61,6 +62,7 @@ library
61 build-depends: base >=4.9 && <4.10
62 build-depends: base >=4.9 && <4.10
62 , bytestring
63 , bytestring
63 , aeson >= 1
64 , aeson >= 1
65+ , containers
64 , regex-compat
66 , regex-compat
65 , scientific
67 , scientific
66 , singletons
68 , singletons
@@ -110,6 +112,7 @@ test-suite spec
110 , aeson >= 1
112 , aeson >= 1
111 , base >=4.9 && <4.10
113 , base >=4.9 && <4.10
112 , bytestring
114 , bytestring
115+ , containers
113 , hspec >= 2.2.0
116 , hspec >= 2.2.0
114 , hspec-core
117 , hspec-core
115 , hspec-discover
118 , hspec-discover
src/Data/Schematic/JsonSchema.hsnew file+78
@@ -0,0 +1,78 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE OverloadedLabels #-}
3+
4+module Data.Schematic.JsonSchema where
5+
6+import Data.Aeson
7+import qualified Data.Map as M
8+import Data.Schematic.Schema
9+import Data.Text
10+
11+
12+draft6 :: Text
13+draft6 = "http://json-schema.org/draft-06/schema#"
14+
15+data JsonSchemaType
16+ = JObject
17+ | JArray
18+ | JNumber
19+ | JString
20+ | JNull
21+
22+instance ToJSON JsonSchemaType where
23+ toJSON JObject = "object"
24+ toJSON JArray = "array"
25+ toJSON JNumber = "number"
26+ toJSON JString = "string"
27+ toJSON JNull = "null"
28+
29+data JsonSchema
30+ = RootSchema
31+ { type_ :: JsonSchemaType
32+ , title :: Text
33+ , items :: Maybe Text
34+ , schemaDraft :: Text }
35+ | JsonObject
36+ { type_ :: JsonSchemaType
37+ , properties :: M.Map Text JsonSchema
38+ , additionalProperties :: Bool
39+ , required :: [Text]
40+ , schemaDraft :: Text }
41+ | JsonOptional JsonSchema
42+
43+jsonObject :: M.Map Text JsonSchema -> JsonSchema
44+jsonObject m = JsonObject
45+ { type_ = JObject
46+ , properties = m
47+ , additionalProperties = False
48+ , required = M.keys $ M.filter
49+ (\case; JsonOptional _ -> False; _ -> True) m
50+ , schemaDraft = draft6 }
51+
52+instance ToJSON JsonSchema where
53+ toJSON RootSchema{..} = object [ "type" .= type_, "title" .= title ]
54+ toJSON JsonObject{..} =
55+ object
56+ [ "type" .= type_
57+ , "properties" .= properties
58+ , "additionalProperties" .= additionalProperties
59+ , "required" .= required
60+ , "schemaDraft" .= schemaDraft]
61+
62+-- Root schema:
63+--
64+-- {
65+-- "title": "root",
66+-- "items": {
67+-- "title": "array item"
68+-- }
69+-- }
70+
71+-- toSchema :: JsonRepr a -> JsonSchema
72+-- toSchema = \case
73+-- ReprText t ->
74+-- ReprNumber n ->
75+-- ReprNull ->
76+-- ReprArray arr ->
77+-- ReprObject obj ->
78+-- ReprOptional mv ->