Generating Swagger for Haskell union type - haskell

I have a data structure of the following form:
data MyType =
Foo Int String
| Bar Int Int
| Baz String
I've manually generated an aeson ToJSON instance:
instance ToJSON MyType where
toJSON (Foo i s) = object [
"tag" .= ("foo" :: Text),
"intField" .= i,
"stringField" = s]
-- and so on.
Now I want a Swagger schema for it. Because I have a custom ToJSON instance I'm going to have to define a matching instance of ToSchema. I could just declare it as a list of mostly-optional field names and a mandatory tag string, but it really ought to list the possible tag values and associate them with different fields.
The OpenAPI specification talks about the discriminator object for doing this, and I've found the corresponding function in the Haskell swagger2 package. But I can't see how to get the mapping from discriminator value to sub-schema. Does anyone have any examples of how to do this?

Related

How to parse a JSON string using Aeson that can be one of two different types

I'm currently struggling to parse some JSON data using the aeson library. There are a number of properties that have the value false when the data for that property is absent. So if the property's value is typically an array of integers and there happens to be no data for that property, instead of providing an empty array or null, the value is false. (The way that this data is structured isn't my doing so I'll have to work with it somehow.)
Ideally, I would like to end up with an empty list in cases where the value is a boolean. I've created a small test case below for demonstration. Because my Group data constructor expects a list, it fails to parse when it encounters false.
data Group = Group [Int] deriving (Eq, Show)
jsonData1 :: ByteString
jsonData1 = [r|
{
"group" : [1, 2, 4]
}
|]
jsonData2 :: ByteString
jsonData2 = [r|
{
"group" : false
}
|]
instance FromJSON Group where
parseJSON = withObject "group" $ \g -> do
items <- g .:? "group" .!= []
return $ Group items
test1 :: Either String Group
test1 = eitherDecode jsonData1
-- returns "Right (Group [1,2,4])"
test2 :: Either String Group
test2 = eitherDecode jsonData2
-- returns "Left \"Error in $.group: expected [a], encountered Boolean\""
I was initially hoping that the (.!=) operator would allow it to default to an empty list but that only works if the property is absent altogether or null. If it were "group": null, it would parse successfully and I would get Right (Group []).
Any advice for how to get it to successfully parse and return an empty list in these cases where it's false?
One way to solve this problem is to pattern match on the JSON data constructors that are valid for your dataset and raise invalid for all others.
For instance, you could write something like this for that particular field, keeping in mind that parseJSON is a function from Value -> Parser a:
instance FromJSON Group where
parseJSON (Bool False) = Group <$> pure []
parseJSON (Array arr) = pure (Group $ parseListOfInt arr)
parseJSON invalid = typeMismatch "Group" invalid
parseListOfInt :: Vector Value -> [Int]
parseListOfInt = undefined -- build this function
You can see an example of this in the Aeson docs, which are pretty good (but you kind of have to read them closely and a few times through).
I would probably then define a separate record to represent the top-level object that this key comes in and rely on generic deriving, but others may have a better suggestion there:
data GroupObj = GroupObj { group :: Group } deriving (Eq, Show)
instance FromJSON GroupObj
One thing to always keep in mind when working with Aeson are the core constructors (of which there are only 6) and the underlying data structures (HashMap for Object and Vector for Array, for instance).
For example, in the above, when you pattern match on Array arr, you have to be aware that you're getting a Vector Value there in arr and we still have some work to do to turn this into a list of integers, which is why I left that other function parseListOfInt undefined up above because I think it's probably a good exercise to build it?

Contextual generation of JSON in Haskell using Aeson

I have a complex nested data structure that I would like to convert to JSON in different ways depending on some provided context. My use case is that my server contains the full state of the world state, but depending on which client is asking for it I want to provide a redacted copy. Ideally I'd like to write something like:
instance ToJSON MyNestedType where
toJSON x = do
currentUser <- ask
return $ if owner x == currentUser then (defaultToJson x) else (toJSON "REDACTED")
encodeWithReader (UserId 123) myDataStructure
Looking at the type of toJSON :: a -> Value this doesn't appear to be possible with plain Aeson. What would be a good option for doing this? A couple of options I was thinking about:
Implementing my own typeclass ToJSONReader, and having a default implementation that simply passes through to ToJSON and overriding for the types that need redacting. Something like (this doesn't compile, just pseudocode. I don't actually know how to make this work.):
class ToJSONReader a where
toJSONReader :: a -> Reader b Value
instance ToJSON a => ToJSONReader a where
toJSONReader x = return $ toJSON x
instance ToJSONReader MyNestedType where
toJSONReader x = do
currentUser <- ask
return $ if owner x == currentUser then (toJSON x) else (toJSON "REDACTED")
Rather than use encode directly, use toJSON to get the intermediate Value then write code to redact that (kind of gross).
Extend my type to include tags for redaction, then pre-process a copy of the type before converting to JSON.
Create a new complex parent type RedactedMyType and duplicate the structure of the original type, but subbing in redacted options in the ADT as needed. Pretty gross also.
Does anyone have any recommendations?

Generic type for OO classes in Haskell

I want to have a generic type that can represent any class in a simple class diagram. In this case a class contains:
A name
Any number of arguments of any type
Any number of functions that takes any number of arguments of any type
I have only used simple ADT declarations which is not working in this case, for example this is what I have been stuck with but it gives me no where near the type of flexibility I'm after:
data Attr a = Attr { name :: String
, kind :: a}
deriving (Show)
data Action = Action { name1 :: String
, params :: [Attr Int]}
deriving (Show)
data Class a = NewC { name2 :: String
, attrs :: [Attr Int]
, actions :: [Action]}
deriving (Show)
So my question is now how would I go about representing any arbitrary class in Haskell?
I do not want to do OOP in haskell. Imaging that the class type I'm trying to make will be a node in a graph. However each node in the graph will be a different class.
I think you want to represent your class diagrams entirely as values rather than a mix of values and types. Instead of Attr Int, for example, you might use something like Attr { name="Int", kind=PrimitiveInt }. I've introduced an OopType type below.
data Attr = Attr { name :: String
, kind :: OopType}
deriving (Show)
data Action = Action { name1 :: String
, params :: [Attr]}
deriving (Show)
data Class = NewC { name2 :: String
, attrs :: [Attr]
, actions :: [Action]}
deriving (Show)
data OopType = ClassType Class
| InterfaceType Class -- TODO make a dedicated interface type
| Enum -- TODO make a dedicated enum type
| PrimitiveString
| PrimitiveInt
Note that this representation doesn't model 'generics' (that is, classes that are parameterised by types). To do that, you'd add another field to the Class type.

What's the difference between makeLenses and makeFields?

Pretty self-explanatory. I know that makeClassy should create typeclasses, but I see no difference between the two.
PS. Bonus points for explaining the default behaviour of both.
Note: This answer is based on lens 4.4 or newer. There were some changes to the TH in that version, so I don't know how much of it applies to older versions of lens.
Organization of the lens TH functions
The lens TH functions are all based on one function, makeLensesWith (also named makeFieldOptics inside lens). This function takes a LensRules argument, which describes exactly what is generated and how.
So to compare makeLenses and makeFields, we only need to compare the LensRules that they use. You can find them by looking at the source:
makeLenses
lensRules :: LensRules
lensRules = LensRules
{ _simpleLenses = False
, _generateSigs = True
, _generateClasses = False
, _allowIsos = True
, _classyLenses = const Nothing
, _fieldToDef = \_ n ->
case nameBase n of
'_':x:xs -> [TopName (mkName (toLower x:xs))]
_ -> []
}
makeFields
defaultFieldRules :: LensRules
defaultFieldRules = LensRules
{ _simpleLenses = True
, _generateSigs = True
, _generateClasses = True -- classes will still be skipped if they already exist
, _allowIsos = False -- generating Isos would hinder field class reuse
, _classyLenses = const Nothing
, _fieldToDef = camelCaseNamer
}
What do these mean?
Now we know that the differences are in the simpleLenses, generateClasses, allowIsos and fieldToDef options. But what do those options actually mean?
makeFields will never generate type-changing optics. This is controlled by the simpleLenses = True option. That option doesn't have haddocks in the current version of lens. However, lens HEAD added documentation for it:
-- | Generate "simple" optics even when type-changing optics are possible.
-- (e.g. 'Lens'' instead of 'Lens')
So makeFields will never generate type-changing optics, while makeLenses will if possible.
makeFields will generate classes for the fields. So for each field foo, we have a class:
class HasFoo t where
foo :: Lens' t <Type of foo field>
This is controlled by the generateClasses option.
makeFields will never generate Iso's, even if that would be possible (controlled by the allowIsos option, which doesn't seem to be exported from Control.Lens.TH)
While makeLenses simply generates a top-level lens for each field that starts with an underscore (lowercasing the first letter after the underscore), makeFields will instead generate instances for the HasFoo classes. It also uses a different naming scheme, explained in a comment in the source code:
-- | Field rules for fields in the form # prefixFieldname or _prefixFieldname #
-- If you want all fields to be lensed, then there is no reason to use an #_# before the prefix.
-- If any of the record fields leads with an #_# then it is assume a field without an #_# should not have a lens created.
camelCaseFields :: LensRules
camelCaseFields = defaultFieldRules
So makeFields also expect that all fields are not just prefixed with an underscore, but also include the data type name as a prefix (as in data Foo = { _fooBar :: Int, _fooBaz :: Bool }). If you want to generate lenses for all fields, you can leave out the underscore.
This is all controlled by the _fieldToDef (exported as lensField by Control.Lens.TH).
As you can see, the Control.Lens.TH module is very flexible. Using makeLensesWith, you can create your very own LensRules if you need a pattern not covered by the standard functions.
Disclaimer: this is based on experimenting with the working code; it gave me enough information to proceed with my project, but I'd still prefer a better-documented answer.
data Stuff = Stuff {
_foo
_FooBar
_stuffBaz
}
makeLenses
Will create foo as a lens accessor to Stuff
Will create fooBar (changing the capitalized name to lowercase);
makeFields
Will create baz and a class HasBaz; it will make Stuff an instance of that class.
Normal
makeLenses creates a single top-level optic for each field in the type. It looks for fields that start with an underscore (_) and it creates an optic that is as general as possible for that field.
If your type has one constructor and one field you'll get an Iso.
If your type has one constructor and multiple fields you'll get many Lens.
If your type has multiple constructors you'll get many Traversal.
Classy
makeClassy creates a single class containing all the optics for your type. This version is used to make it easy to embed your type in another larger type achieving a kind of subtyping. Lens and Traversal optics will be created according to the rules above (Iso is excluded because it hinders the subtyping behavior.)
In addition to one method in the class per field you'll get an extra method that makes it easy to derive instances of this class for other types. All of the other methods have default instances in terms of the top-level method.
data T = MkT { _field1 :: Int, _field2 :: Char }
class HasT a where
t :: Lens' a T
field1 :: Lens' a Int
field2 :: Lens' a Char
field1 = t . field1
field2 = t . field2
instance HasT T where
t = id
field1 f (MkT x y) = fmap (\x' -> MkT x' y) (f x)
field2 f (MkT x y) = fmap (\y' -> MkT x y') (f y)
data U = MkU { _subt :: T, _field3 :: Bool }
instance HasT U where
t f (MkU x y) = fmap (\x' -> MkU x' y) (f x)
-- field1 and field2 automatically defined
This has the additional benefit that it is easy to export/import all the lenses for a given type. import Module (HasT(..))
Fields
makeFields creates a single class per field which is intended to be reused between all types that have a field with the given name. This is more of a solution to record field names not being able to be shared between types.

ToJSON and FromJSON instances for nested Enum types

I am currently wrapping a Rest(ish) API. The JSON looks something like this, but more extensive:
{ 'a' : 'Bar1 Bar1B' }
{ 'a' : 'Bar2 Bar2A' }
This seems like it would be well represented by Enum types. For example:
data Foo = Foo { a :: Bar }
data Bar = Bar1 Bar1 | Bar2 Bar2
data Bar1 = Bar1A | Bar1B
data Bar2 = Bar2A | Bar2B
I'm having two problems.
While I can write ToJSON instances quite easily:
instance ToJSON Bar1 where
ToJSON Bar1A = String "Bar1A"
ToJSON Bar1B = String "Bar1B"
when I write the corresponding FromJSON instances, they fail to decode:
instance FromJSON Bar1 where
parseJSON (String "Bar1A") = return Bar1A
parseJSON (String "Bar1B") = return Bar1B
parseJSON _ = mzero
Why is this?
Secondly, this seems like it will involve me writing a huge amount of boilerplate. Is there any way around this? Using Show/Read, or template haskell, for example?
You can't decode a bare Bar1A value because a bare string is not valid JSON. Only arrays or objects are allowed at top-level.
Derived instances for simple examples like you're talking about here are quite straightforward using -XDeriveDataTypeable. See the Aeson docs for details.

Resources