Converts openapi.py in openapi_typed_2 to haskell

openapi_py_to_hs.py

from openapi import OpenAPIObject, Reference, APIKeySecurityScheme, APIKeySecurityScheme, HTTPSecurityScheme, OAuth2SecurityScheme, OpenIdConnectSecurityScheme, Response
import openapi
from collections.abc import Mapping, Sequence
from typing import Union, Any, ForwardRef
import typing

def px(a):
    return '(%s)' % a if (' ' in a) and (a[0] != '[') else a


def to_haskell(ipt, todo, done, toexpt, top=True):
    if hasattr(ipt, '__dataclass_fields__'):
        if top:
            nm = ipt.__name__
            comment = '-- |%s' % nm
            data = 'data %s = %s' % (nm, nm)
            accessors = []
            for k, v in ipt.__dataclass_fields__.items():
                srep, td, dn, txp = to_haskell(v.type, todo, done, toexpt, False)
                todo = {*td, *todo}
                done = {*dn, *done}
                toexpt = {*txp, *toexpt}
                cstr = (k if k[0] != '_' else '$ref' if k == '_ref' else k[1:])
                comment += ' %s' % cstr
                data += ' %s' % px(srep)
                accessors = [*accessors, (cstr, srep)]
            dashes = lambda pos, l : ' '.join(['r' if x == pos else '_' for x in range(l)])
            udashes = lambda pos, l : ' '.join(['_' if x == pos else '_%d' % x for x in range(l)])
            ndashes = lambda pos, l : ' '.join(['_new_' if x == pos else '_%d' % x for x in range(l)])
            dashproto = [('_'+cstr if cstr != '$ref' else '_ref', _) for cstr, _ in accessors]
            dashvars = [x for x, _ in dashproto]
            getters = ['get%s%s :: %s -> %s\nget%s%s (%s %s) = r\n' % (nm, cstr[0].upper() + cstr[1:] if cstr != '$ref' else 'Ref', nm, dstr, nm, cstr[0].upper() + cstr[1:] if cstr != '$ref' else 'Ref', nm, dashes(i, len(accessors))) for i, (cstr, dstr) in enumerate(accessors)]
            setters = ['set%s%s :: %s -> %s -> %s\nset%s%s (%s %s) _new_ = %s %s\n' % (nm, cstr[0].upper() + cstr[1:] if cstr != '$ref' else 'Ref', nm, dstr, nm, nm, cstr[0].upper() + cstr[1:] if cstr != '$ref' else 'Ref', nm, udashes(i, len(accessors)), nm, ndashes(i, len(accessors))) for i, (cstr, dstr) in enumerate(accessors)]
            lenses = ['lens%s%s = lens get%s%s set%s%s' % ((nm, cstr[0].upper() + cstr[1:] if cstr != '$ref' else 'Ref') * 3) for cstr, dstr in accessors]
            fromJSONs = 'instance FromJSON %s where\n  parseJSON = withObject "%s" $ \\v -> %s\n' % (nm, nm, nm) + '\n'.join([('    %s v %s "%s"' % ('<$>' if i == 0 else '<*>', '.:' if dstr[:5] != 'Maybe' else '.:?', cstr)) if cstr != 'x' else '    <*> (pure (xify v))' for i, (cstr, dstr) in enumerate(accessors)])
            toJSONs = 'instance ToJSON %s where\n  toJSON (%s %s) =\n    object $ %s\n' % (nm, nm, ' '.join(dashvars), ' ++ '.join([('["%s" .= %s]' % (cstr, '_'+cstr if cstr != '$ref' else '_ref')) if dstr[:5] != 'Maybe' else ('(maybe [] (\\x -> ["%s" .= x]) %s)' % (cstr, '_'+cstr if cstr != '$ref' else '_ref')) if cstr != 'x' else '(maybe [] (HM.toList . (HM.map toJSON)) _x)' for cstr, dstr in accessors]))
            makeShow = 'instance Show %s where\n  show (%s %s) = show (pack "%s" <> pack "(" <> intercalate ", " (P.filter (not . DT.null) [%s]) <> pack ")")' % (nm, nm, ' '.join(dashvars), nm, ', '.join(['pack ("%s = " <> show %s)' % (cstr[1:], cstr) if dstr[:5] != 'Maybe'  else 'maybe "" (\\x -> pack ("%s = Just " <> show x)) %s' % (cstr[1:], cstr) for cstr, dstr in dashproto]))
            toexpt = {*{'get%s%s, set%s%s, lens%s%s' % ((nm, cstr[0].upper() + cstr[1:] if cstr != '$ref' else 'Ref') * 3) for (cstr, dstr) in accessors}, '%s(..)' % nm, *toexpt}
            return comment + '\n' + data + ' deriving (Eq)\n\n' + '\n'.join(getters) + '\n' +'\n'.join(setters) + '\n' + '\n'.join(lenses) + '\n\n' + makeShow + '\n\n' + toJSONs + '\n' + fromJSONs + '\n', todo, {ipt, *done}, toexpt
        else:
            return (ipt.__name__, {ipt, *todo}, done, toexpt)
    elif ipt == str:
        return 'Text', todo, {ipt, *done}, toexpt
    elif ipt == int:
        return 'Int', todo, {ipt, *done}, toexpt
    elif ipt == Any:
        return 'Value', todo, {ipt, *done}, toexpt
    elif ipt == bool:
        return 'Bool', todo, {ipt, *done}, toexpt
    elif ipt == float:
        return 'Double', todo, {ipt, *done}, toexpt
    elif hasattr(ipt, '__origin__'):
        if ipt.__origin__ == Mapping:
            srep, td, dn, txp = to_haskell(ipt.__args__[1], todo, done, toexpt, False)
            return 'HashMap Text %s' % px(srep), {*td, *todo}, {*dn, *done}, {*txp, *toexpt}
        if ipt.__origin__ == Union:
            if len(ipt.__args__) == 4:
                # hack
                if bool in ipt.__args__:
                    if top:
                        out = 'data Additionals = AdditionalSchema Schema | AdditionalReference Reference | AdditionalBool Bool deriving (Show, Eq)\n\n'
                        out += 'instance FromJSON Additionals where\n  parseJSON obj@(Object o) | isRef o = AdditionalReference <$> parseJSON obj | otherwise = AdditionalSchema <$> parseJSON obj\n  parseJSON (Bool b) = pure (AdditionalBool b)\n\ninstance ToJSON Additionals where\n  toJSON (AdditionalSchema s) = toJSON s\n  toJSON (AdditionalReference r) = toJSON r\n  toJSON (AdditionalBool b) = toJSON b\n'
                        out += '''
eitherAdditionalSchema :: Additionals -> Either Additionals Schema
eitherAdditionalSchema (AdditionalSchema r) = Right r
eitherAdditionalSchema l = Left l
prismAdditionalSchema = prism AdditionalSchema eitherAdditionalSchema

eitherAdditionalReference :: Additionals -> Either Additionals Reference
eitherAdditionalReference (AdditionalReference r) = Right r
eitherAdditionalReference l = Left l
prismAdditionalReference = prism AdditionalReference eitherAdditionalReference

eitherAdditionalBool :: Additionals -> Either Additionals Bool
eitherAdditionalBool (AdditionalBool r) = Right r
eitherAdditionalBool l = Left l
prismAdditionalBool = prism AdditionalBool eitherAdditionalBool
'''
                        return out, todo, {ipt, *done}, {'Additionals(..)', 'prismAdditionalSchema', 'prismAdditionalReference', 'prismAdditionalBool', *toexpt}
                    else:
                        return 'Maybe Additionals', {ipt, *todo}, done, toexpt
                else:
                    if top:
                        out = 'data Items = Tuple [ReferenceOr Schema] | SingleItem Schema | SingleItemReference Reference deriving (Show, Eq)\n'
                        out += 'instance FromJSON Items where\n  parseJSON obj@(Object o) | isRef o = SingleItemReference <$> parseJSON obj | otherwise = SingleItem <$> parseJSON obj\n  parseJSON (Array a) = Tuple <$> (V.toList <$> mapM parseJSON a)\n\ninstance ToJSON Items where\n  toJSON (Tuple t) = toJSON t\n  toJSON (SingleItem i) = toJSON i\n  toJSON (SingleItemReference r) = toJSON r\n'
                        out += '''
eitherTuple :: Items -> Either Items [ReferenceOr Schema]
eitherTuple (Tuple r) = Right r
eitherTuple l = Left l
prismTuple = prism Tuple eitherTuple

eitherSingleItem :: Items -> Either Items Schema
eitherSingleItem (SingleItem r) = Right r
eitherSingleItem l = Left l
prismSingleItem = prism SingleItem eitherSingleItem

eitherSingleItemReference :: Items -> Either Items Reference
eitherSingleItemReference (SingleItemReference r) = Right r
eitherSingleItemReference l = Left l
prismSingleItemReference = prism SingleItemReference eitherSingleItemReference
'''
                        return out, todo, {ipt, *done}, {'Items(..)', 'prismTuple', 'prismSingleItem', 'prismSingleItemReference', *toexpt}
                    else:
                        return 'Maybe Items', {ipt, *todo}, done, toexpt
            if len(ipt.__args__) == 2 and (type(None) in ipt.__args__):
                notnone = [g for g in ipt.__args__ if g != type(None)][0]
                srep, td, dn, txp = to_haskell(notnone, todo, done, toexpt, False)
                return 'Maybe %s' % px(srep), {*td, *todo}, {*dn, *done}, {*txp, *toexpt}
            if len(ipt.__args__) == 2 and (Reference in ipt.__args__):
                ipt.__args__ = [x if x.__class__.__name__ != 'ForwardRef' else getattr(openapi, x.__forward_arg__) for x in ipt.__args__]
                notref = [g for g in ipt.__args__ if g != Reference][0]
                srep, td, dn, txp = to_haskell(notref, todo, done, toexpt, False)
                return 'ReferenceOr %s' % px(srep), {*td, *todo}, {*dn, *done}, toexpt
            if len(ipt.__args__) == 3 and (Reference in ipt.__args__) and (type(None) in ipt.__args__):
                notthing = [g for g in ipt.__args__ if (g != Reference) and (g != type(None))][0]
                srep, td, dn, txp = to_haskell(notthing, todo, done, toexpt, False)
                return 'Maybe (ReferenceOr %s)' % px(srep), {*td, *todo}, {*dn, *done}, {*txp, *toexpt}
            if ipt == Union[bool, int, type(None)]:
                return 'Maybe BoolInt', todo, done, toexpt
            if APIKeySecurityScheme in ipt.__args__:
                # hack for security schema
                if top:
                    out = 'data SecuritySchema = APIKeySS APIKeySecurityScheme | HTTPSS HTTPSecurityScheme | OAuth2SS OAuth2SecurityScheme | OpenIdConnectSS OpenIdConnectSecurityScheme | TextSS Text | ReferenceSS Reference deriving(Show, Eq)\n\n'
                    out += 'instance FromJSON SecuritySchema where\n  parseJSON obj@(Object o) = do\n    tp <- o .: "type" :: Parser Text\n    case tp of\n      "apiKey" -> APIKeySS <$> parseJSON obj\n      "http" -> HTTPSS <$> parseJSON obj\n      "oauth2" -> OAuth2SS <$> parseJSON obj\n      "openIdConnect" -> OpenIdConnectSS <$> parseJSON obj\n      _ -> ReferenceSS <$> parseJSON obj\n  parseJSON st@(String s) = TextSS <$> parseJSON st\n\ninstance ToJSON SecuritySchema where\n  toJSON (APIKeySS s) = toJSON s\n  toJSON (HTTPSS r) = toJSON r\n  toJSON (OAuth2SS r) = toJSON r\n  toJSON (OpenIdConnectSS r) = toJSON r\n  toJSON (TextSS r) = toJSON r\n  toJSON (ReferenceSS b) = toJSON b\n'
                    out += '''
eitherAPIKeySS :: SecuritySchema -> Either SecuritySchema APIKeySecurityScheme
eitherAPIKeySS (APIKeySS r) = Right r
eitherAPIKeySS l = Left l
prismAPIKeySS = prism APIKeySS eitherAPIKeySS

eitherHTTPSS :: SecuritySchema -> Either SecuritySchema HTTPSecurityScheme
eitherHTTPSS (HTTPSS r) = Right r
eitherHTTPSS l = Left l
prismHTTPSS = prism HTTPSS eitherHTTPSS

eitherOAuth2SS :: SecuritySchema -> Either SecuritySchema OAuth2SecurityScheme
eitherOAuth2SS (OAuth2SS r) = Right r
eitherOAuth2SS l = Left l
prismOAuth2SS = prism OAuth2SS eitherOAuth2SS

eitherOpenIdConnectSS :: SecuritySchema -> Either SecuritySchema OpenIdConnectSecurityScheme
eitherOpenIdConnectSS (OpenIdConnectSS r) = Right r
eitherOpenIdConnectSS l = Left l
prismOpenIdConnectSS = prism OpenIdConnectSS eitherHTTPSS
'''
                    return out, {APIKeySecurityScheme, HTTPSecurityScheme, OAuth2SecurityScheme, OpenIdConnectSecurityScheme, str, Reference, *todo}, {ipt, *done}, {'SecuritySchema(..)', 'prismAPIKeySS', 'prismHTTPSS', 'prismOAuth2SS', 'prismOpenIdConnectSS', *toexpt}
                else:
                    return 'SecuritySchema', {ipt, *todo}, done, toexpt
        if ipt.__origin__ == Sequence:
            srep, td, dn, txp = to_haskell(ipt.__args__[0], todo, done, toexpt, False)
            return '[%s]' % srep, {*td, *todo}, {*dn, *done}, {*txp, *toexpt}
    elif ipt == 'Responses':
        return to_haskell(typing.Mapping[str, Union[Response, Reference]], todo, done, toexpt, False)
    elif ipt.__class__.__name__ == 'ForwardRef':
        return to_haskell(getattr(openapi, ipt.__forward_arg__), todo, done, toexpt, False)
    raise ValueError('cannot figure out %s' % str(ipt))
        

if __name__ == '__main__':
    todo = {OpenAPIObject}
    done = {}
    out = '{-# LANGUAGE FlexibleInstances #-}\n{-# LANGUAGE OverloadedStrings #-}\nmodule Data.OpenAPI.V3_0_0 (FOOBAR) where\n\nimport Prelude hiding(lookup, take)\nimport qualified Prelude as P(filter)\nimport Optics.Lens\nimport Optics.Prism\nimport Data.Vector as V(toList)\nimport Data.Aeson hiding(Encoding)\nimport Data.Aeson.Types hiding(Encoding)\nimport Data.Text\nimport qualified Data.Text as DT(null)\nimport Data.HashMap.Strict\nimport qualified Data.HashMap.Strict as HM(toList, map)\n\n'
    out += 'hack :: (a -> c) -> (a -> b -> c)\nhack o = (\\x -> (\\y -> o x))\n\n'
    out += 'xify :: Object -> Maybe (HashMap Text Value)\n'
    out += 'xify = Just . filterWithKey (hack (\\k -> take 2 k == "x-"))\n\n'
    out += 'isRef :: Object -> Bool\n'
    out += 'isRef = (/=) Nothing . lookup "$ref"\n\n'
    out += 'data ReferenceOr a = Ref Reference | RealDeal a deriving (Show, Eq)\n\n'
    out += 'instance (FromJSON a) => FromJSON (ReferenceOr a) where\n  parseJSON obj@(Object o) | isRef o = Ref <$> parseJSON obj | otherwise = RealDeal <$> parseJSON obj\n\ninstance (ToJSON a) => ToJSON (ReferenceOr a) where\n  toJSON (Ref t) = toJSON t\n  toJSON (RealDeal r) = toJSON r\n\n'
    out += 'data BoolInt = ABool Bool | AnInt Int deriving (Show, Eq)\n\n'
    out += 'instance FromJSON BoolInt where\n  parseJSON boo@(Bool b) = ABool <$> pure b\n  parseJSON num@(Number n) = AnInt <$> parseJSON (toJSON n)\n\ninstance ToJSON BoolInt where\n  toJSON (ABool b) = toJSON b\n  toJSON (AnInt i) = toJSON i\n\n'
    out += '''eitherRef :: ReferenceOr a -> Either (ReferenceOr a) Reference
eitherRef (Ref r) = Right r
eitherRef l = Left l
prismRef = prism Ref eitherRef

eitherRealDeal :: ReferenceOr a -> Either (ReferenceOr a) a
eitherRealDeal (RealDeal r) = Right r
eitherRealDeal l = Left l
prismRealDeal = prism RealDeal eitherRealDeal

'''
    toexpt = []
    while len(todo) > 0:
        #print(todo, done, toexpt)
        todo = {x for x in todo if x not in done}
        for item in {*todo}:
            o, todo, done, toexpt = to_haskell(item, todo, done, toexpt)
            out += o+'\n'
    out = out.replace('FOOBAR', ',\n '.join({'ReferenceOr', 'BoolInt', 'prismRef', 'prismRealDeal', *toexpt}))
    with open('../../random-scripts/delete-me-haskell/src/Data/OpenAPI/V3_0_0.hs', 'w') as hask:
        hask.write(out)