@@ -26,32 +26,29 @@ module Gen.Types
2626 ( module Gen.Types
2727 , module Gen.Types.Map
2828 , module Gen.Types.NS
29+ , module Gen.Types.Id
2930 ) where
3031
3132import Control.Applicative
33+import Control.Lens hiding ((.=))
3234import Data.Aeson hiding (Bool, String)
3335import Data.Aeson.TH
34−import qualified Data.Attoparsec.Text as A
35−import Data.Bifunctor
3636import Data.Char
3737import Data.Function (on)
38−import Data.Hashable
39−import qualified Data.HashMap.Strict as Map
40−import Data.List (groupBy, nub, sort)
41−import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
38+import Data.List.NonEmpty (NonEmpty (..))
4239import qualified Data.List.NonEmpty as NE
40+import Data.Maybe
4341import Data.Ord
44−import Data.Semigroup hiding (Sum)
45−import Data.String
42+import Data.Semigroup ((<>))
4643import Data.Text (Text)
4744import qualified Data.Text as Text
4845import qualified Data.Text.Lazy as LText
4946import qualified Data.Text.Lazy.Builder as Build
50−import Data.Text.Manipulate
5147import qualified Data.Text.Read as Read
5248import qualified Filesystem.Path.CurrentOS as Path
5349import Formatting
5450import Gen.Text
51+import Gen.Types.Id
5552import Gen.Types.Map
5653import Gen.Types.NS
5754import GHC.Generics
@@ -144,10 +141,10 @@ data Location
144141deriveJSON (js "") ''Location
145142
146143data Info = Info
147− { _infoDescription :: Maybe Text
148− , _infoDefault :: Maybe Text
149− , _infoRequired :: !Bool
150− , _infoLocation :: Maybe Location
144+ { _description :: Maybe Text
145+ , _defaulted :: Maybe Text
146+ , _required :: !Bool
147+ , _location :: Maybe Location
151148 } deriving (Eq, Show)
152149
153150instance FromJSON Info where
@@ -159,6 +156,11 @@ instance FromJSON Info where
159156
160157deriveToJSON (js "_info") ''Info
161158
159+makeClassy ''Info
160+
161+parameter :: HasInfo a => a -> Bool
162+parameter s = s ^. required && isNothing (s ^. defaulted)
163+
162164data Lit
163165 = Text
164166 | Bool
@@ -170,7 +172,7 @@ data Lit
170172
171173instance FromJSON Lit where
172174 parseJSON = withObject "literal" $ \o -> do
173− n <- min =<< (o .:? "minimum" .!= "0")
175+ n <- num =<< (o .:? "minimum" .!= "0")
174176 (o .: "format" <|> o .: "type") >>= \case
175177 -- Types
176178 "string" -> pure Text
@@ -182,7 +184,7 @@ instance FromJSON Lit where
182184 e -> fail $
183185 "Unable to parse Lit from " ++ Text.unpack e
184186 where
185− min = either fail (pure . fst) . Read.decimal
187+ num = either fail (pure . fst) . Read.decimal
186188
187189 nat :: Int -> Lit -> Lit
188190 nat n | n > 0 = const Nat
@@ -196,65 +198,50 @@ instance FromJSON Lit where
196198
197199deriveToJSON (js "") ''Lit
198200
199−data Ref
200− = Opaque [Text]
201− | Direct Text
202− deriving (Eq, Show, Generic)
203−
204−instance Semigroup Ref where
205− a <> b = case (a, b) of
206− (Opaque xs, Opaque ys) -> Opaque (xs <> ys)
207− (Opaque xs, Direct y) -> Opaque (xs <> [y])
208− (Direct x, Opaque ys) -> Opaque (x : ys)
209− (Direct x, Direct y) -> Opaque [x, y]
210−
211−instance Hashable Ref
212−
213−instance IsString Ref where
214− fromString = Direct . fromString
215−
216−instance FromJSON Ref where parseJSON = withText "ref" (pure . Direct)
217−instance ToJSON Ref where toJSON = toJSON . refToText
218−
219−instance FromJSON a => FromJSON (Map Ref a) where
220− parseJSON = fmap (Map.fromList . map (first Direct) . Map.toList) . parseJSON
221−
222−instance ToJSON a => ToJSON (Map Ref a) where
223− toJSON = toJSON . Map.fromList . map (first refToText) . Map.toList
224−
225−refToText :: Ref -> Text
226−refToText = \case
227− Opaque xs -> mconcat (map upperHead xs)
228− Direct n -> n
229−
230−fref :: Format a (Ref -> a)
231−fref = later (Build.fromText . refToText)
232−
233201data Schema a
234− = Obj Info (Map Ref a)
202+ = Obj Info (Map Id a)
235203 | Arr Info a
236204 | Enum Info [Text] [Text]
237205 | Lit Info Lit
238− | Ref Ref
239− | Any' -- String or Number
206+ | Ref Info Id
207+ | Any Info -- String or Number
240208 deriving (Eq, Show, Functor, Foldable, Traversable)
241209
242210instance FromJSON (Fix Schema) where
243− parseJSON = withObject "schema" $ \o -> Fix <$> (ref o <|> schema o)
211+ parseJSON = withObject "schema" $ \o -> do
212+ i <- parseJSON (Object o)
213+ Fix <$> (ref i o <|> schema i o)
244214 where
245− schema o = do
246− i <- parseJSON (Object o)
247− o .: "type" >>= \case
248− "object" -> Obj i <$> o .: "properties"
249− "array" -> Arr i <$> o .: "items"
250− "any" -> pure Any'
251− _ -> enum i o <|> Lit i <$> parseJSON (Object o)
215+ schema i o = o .: "type" >>= \case
216+ "object" -> Obj i <$> o .: "properties"
217+ "array" -> Arr i <$> o .: "items"
218+ "any" -> pure (Any i)
219+ _ -> enm i o <|> Lit i <$> parseJSON (Object o)
252220
253− enum i o = Enum i <$> o .: "enum" <*> o .: "enumDescriptions"
254− ref o = Ref <$> o .: "$ref"
221+ enm i o = Enum i <$> o .: "enum" <*> o .: "enumDescriptions"
222+ ref i o = Ref i <$> o .: "$ref"
255223
256224deriveToJSON (js "") ''Schema
257225
226+instance HasInfo (Schema a) where
227+ info = lens f (flip g)
228+ where
229+ f = \case
230+ Obj i _ -> i
231+ Arr i _ -> i
232+ Enum i _ _ -> i
233+ Lit i _ -> i
234+ Ref i _ -> i
235+ Any i -> i
236+
237+ g i = \case
238+ Obj _ p -> Obj i p
239+ Arr _ e -> Arr i e
240+ Enum _ v d -> Enum i v d
241+ Lit _ l -> Lit i l
242+ Ref _ r -> Ref i r
243+ Any {} -> Any i
244+
258245data Param = Param Location -- (Fix Schema)
259246
260247instance FromJSON Param where
@@ -309,8 +296,8 @@ data Service a = Service
309296 , _svcServicePath :: Text
310297 , _svcBatchPath :: Text
311298 , _svcAuth :: Maybe Object
312− , _svcParameters :: Map Ref Param
313− , _svcSchemas :: Map Ref a
299+ , _svcParameters :: Map Id Param
300+ , _svcSchemas :: Map Id a
314301 , _svcResources :: Object
315302 } deriving (Generic)
316303