Get rid of the rest of union conversion

This commit is contained in:
Mark Probst 2017-08-30 13:28:13 -07:00
Родитель 2dcec64cd1
Коммит a5d083acae
9 изменённых файлов: 90 добавлений и 102 удалений

Просмотреть файл

@ -22,6 +22,7 @@
"purescript-either": "^3.1.0",
"purescript-filterable": "^2.2.0",
"purescript-foldable-traversable": "^3.4.0",
"purescript-identity": "^3.1.0",
"purescript-transformers": "^3.4.0",
"purescript-unicode": "^3.0.1"
},

Просмотреть файл

@ -134,7 +134,7 @@ runDoc (Doc w) t graph@(IRGraph { toplevels }) =
unionNamer :: Namer (Array String) -> Namer (Named (Set String)) -> Map Int String -> Namer IRUnionRep
unionNamer nameFromTypes properName classNames union@(IRUnionRep { names }) =
if namedValue names == S.empty then
let typeStrings = map (typeNameForUnion graph classNames) $ A.sort $ A.fromFoldable $ unionToSet union
let typeStrings = map (typeNameForUnion graph classNames) $ A.sort $ A.fromFoldable $ unionToList union
in
nameFromTypes typeStrings
else

Просмотреть файл

@ -13,7 +13,7 @@ module IRGraph
, irUnion_Double
, irUnion_Bool
, irUnion_String
, unionToSet
, unionToList
, Entry(..)
, makeClass
, emptyGraph
@ -35,12 +35,18 @@ module IRGraph
, isUnionMember
, forUnion_
, mapUnionM
, mapUnion
, unionHasArray
, unionHasClass
, unionHasMap
, emptyUnion
) where
import Prelude
import Control.Comonad (extract)
import Data.Foldable (all)
import Data.Identity (Identity(..))
import Data.Int.Bits as Bits
import Data.List (List, (:))
import Data.List as L
@ -322,28 +328,6 @@ regatherUnionNames graph@(IRGraph { classes, toplevels }) =
IRUnion $ IRUnionRep { names: newNames, primitives, arrayType: newArrayType, classRef, mapType: newMapType }
_ -> t
unionToSet :: IRUnionRep -> Set IRType
unionToSet (IRUnionRep { primitives, arrayType, classRef, mapType }) =
let types1 = addIfSet irUnion_Nothing IRNothing L.Nil
types2 = addIfSet irUnion_Null IRNull types1
types3 = addIfSet irUnion_Integer IRInteger types2
types4 = addIfSet irUnion_Double IRDouble types3
types5 = addIfSet irUnion_Bool IRBool types4
types6 = addIfSet irUnion_String IRString types5
types7 = addIfJust IRArray arrayType types6
types8 = addIfJust IRClass classRef types7
types9 = addIfJust IRMap mapType types8
in
S.fromFoldable types9
where
addIfSet bit t l =
if (Bits.and bit primitives) == 0 then l else t : l
addIfJust :: forall a. (a -> IRType) -> Maybe a -> List IRType -> List IRType
addIfJust c m l =
case m of
Just x -> c x : l
Nothing -> l
removeNullFromUnion :: IRUnionRep -> { hasNull :: Boolean, nonNullUnion :: IRUnionRep }
removeNullFromUnion union@(IRUnionRep ur@{ primitives }) =
if (Bits.and irUnion_Null primitives) == 0 then
@ -351,12 +335,21 @@ removeNullFromUnion union@(IRUnionRep ur@{ primitives }) =
else
{ hasNull: true, nonNullUnion: IRUnionRep $ ur { primitives = Bits.xor irUnion_Null primitives }}
unionHasArray :: IRUnionRep -> Maybe IRType
unionHasArray (IRUnionRep { arrayType }) = map IRArray arrayType
unionHasClass :: IRUnionRep -> Maybe IRType
unionHasClass (IRUnionRep { classRef }) = map IRClass classRef
unionHasMap :: IRUnionRep -> Maybe IRType
unionHasMap (IRUnionRep { mapType }) = map IRMap mapType
nullableFromUnion :: IRUnionRep -> Maybe IRType
nullableFromUnion union =
let { hasNull, nonNullUnion } = removeNullFromUnion union
in
if hasNull then
case L.fromFoldable $ unionToSet nonNullUnion of
case unionToList nonNullUnion of
x : L.Nil -> Just x
_ -> Nothing
else
@ -410,6 +403,12 @@ mapUnionM f (IRUnionRep { primitives, arrayType, classRef, mapType }) = do
result <- f $ convert x
pure $ result : l
mapUnion :: forall a. (IRType -> a) -> IRUnionRep -> List a
mapUnion f = extract <<< mapUnionM (Identity <<< f)
unionToList :: IRUnionRep -> List IRType
unionToList = mapUnion id
isUnionMember :: IRType -> IRUnionRep -> Boolean
isUnionMember t (IRUnionRep { primitives, arrayType, classRef, mapType }) =
case t of
@ -441,7 +440,7 @@ filterTypes predicate graph@(IRGraph { classes, toplevels }) =
IRArray t -> filterType t
IRMap t -> filterType t
IRUnion r ->
S.unions $ S.map filterType $ unionToSet r
S.unions $ mapUnion filterType r
_ -> S.empty
filterType :: IRType -> Set a
filterType t =

Просмотреть файл

@ -7,16 +7,13 @@ import IRGraph
import Prelude
import Data.Char.Unicode (GeneralCategory(..), generalCategory)
import Data.Foldable (find, for_, intercalate)
import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as M
import Data.Map (Map)
import Data.Maybe (Maybe(..), isJust, isNothing)
import Data.Set (Set)
import Data.Set as S
import Data.Maybe (Maybe(..))
import Data.String.Util (camelCase, legalizeCharacters, startWithLetter, stringEscape, isLetterOrLetterNumber)
import Utils (removeElement)
forbiddenNames :: Array String
forbiddenNames = ["Convert", "JsonConverter", "Type"]
@ -239,9 +236,9 @@ renderDoubleDeserializer union =
indent do
deserializeType IRDouble
renderGenericDeserializer :: (IRType -> Boolean) -> String -> Set IRType -> Doc Unit
renderGenericDeserializer predicate tokenType types =
case find predicate types of
renderGenericDeserializer :: (IRUnionRep -> Maybe IRType) -> String -> IRUnionRep -> Doc Unit
renderGenericDeserializer predicate tokenType union =
case predicate union of
Nothing -> pure unit
Just t -> do
tokenCase tokenType
@ -251,7 +248,6 @@ renderGenericDeserializer predicate tokenType types =
renderCSharpUnion :: String -> IRUnionRep -> Doc Unit
renderCSharpUnion name unionRep = do
let { hasNull, nonNullUnion } = removeNullFromUnion unionRep
let nonNullTypes = unionToSet nonNullUnion
line $ "public struct " <> name
line "{"
indent do
@ -275,9 +271,9 @@ renderCSharpUnion name unionRep = do
renderDoubleDeserializer nonNullUnion
renderPrimitiveDeserializer (L.singleton "Boolean") IRBool nonNullUnion
renderPrimitiveDeserializer ("String" : "Date" : L.Nil) IRString nonNullUnion
renderGenericDeserializer isArray "StartArray" nonNullTypes
renderGenericDeserializer isClass "StartObject" nonNullTypes
renderGenericDeserializer isMap "StartObject" nonNullTypes
renderGenericDeserializer unionHasArray "StartArray" nonNullUnion
renderGenericDeserializer unionHasClass "StartObject" nonNullUnion
renderGenericDeserializer unionHasMap "StartObject" nonNullUnion
line $ "default: throw new Exception(\"Cannot convert " <> name <> "\");"
line "}"
line "}"

Просмотреть файл

@ -12,11 +12,10 @@ import Data.List (List, (:))
import Data.List as L
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Maybe (Maybe(..))
import Data.String.Util (camelCase, capitalize, decapitalize, isLetterOrUnderscore, isLetterOrUnderscoreOrDigit, legalizeCharacters, startWithLetter, stringEscape)
import Data.Tuple (Tuple(..), fst)
import Utils (forEnumerated_, removeElement, sortByKey, sortByKeyM, mapM)
import Utils (forEnumerated_, sortByKey, sortByKeyM, mapM)
forbiddenNames :: Array String
forbiddenNames =
@ -318,8 +317,7 @@ typeRenderer renderer className properties = do
renderUnionDefinition :: String -> IRUnionRep -> Doc Unit
renderUnionDefinition unionName unionRep = do
let allTypes = unionToSet unionRep
fields <- L.fromFoldable allTypes # sortByKeyM (unionConstructorName unionName)
fields <- unionToList unionRep # sortByKeyM (unionConstructorName unionName)
line $ "type " <> unionName
forWithPrefix_ fields "=" "|" \equalsOrPipe t -> do
indent do
@ -332,14 +330,11 @@ renderUnionDefinition unionName unionRep = do
renderUnionFunctions :: String -> IRUnionRep -> Doc Unit
renderUnionFunctions unionName unionRep = do
let allTypes = unionToSet unionRep
let decoderName = decoderNameFromTypeName unionName
line $ decoderName <> " : Jdec.Decoder " <> unionName
line $ decoderName <> " ="
indent do
let { element: maybeArray, rest: nonArrayFields } = removeElement isArray allTypes
nonArrayDecFields <- L.fromFoldable nonArrayFields # sortByKeyM (unionConstructorName unionName)
let decFields = maybe nonArrayDecFields (\f -> f : nonArrayDecFields) maybeArray
let decFields = L.sortBy arrayFirstOrder $ unionToList unionRep
line "Jdec.oneOf"
indent do
forWithPrefix_ decFields "[" "," \bracketOrComma t -> do
@ -355,7 +350,7 @@ renderUnionFunctions unionName unionRep = do
line $ encoderName <> " : " <> unionName <> " -> Jenc.Value"
line $ encoderName <> " x = case x of"
indent do
fields <- L.fromFoldable allTypes # sortByKeyM (unionConstructorName unionName)
fields <- unionToList unionRep # sortByKeyM (unionConstructorName unionName)
for_ fields \t -> do
constructor <- unionConstructorName unionName t
when (t == IRNull) do
@ -363,3 +358,15 @@ renderUnionFunctions unionName unionRep = do
unless (t == IRNull) do
{ rendered: encoder } <- encoderNameForType t
line $ constructor <> " y -> " <> encoder <> " y"
where
arrayFirstOrder a b =
if isArray a then
if isArray b then
compare a b
else
LT
else
if isArray b then
GT
else
compare a b

Просмотреть файл

@ -12,12 +12,11 @@ import Data.List (List, (:))
import Data.List as L
import Data.Map as M
import Data.Map (Map)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Set (Set)
import Data.Maybe (Maybe(..), maybe)
import Data.String as Str
import Data.String.Util (camelCase, stringEscape, legalizeCharacters, isLetterOrUnderscore, isLetterOrUnderscoreOrDigit, startWithLetter)
import Data.Tuple (Tuple(..), fst)
import Utils (mapM, removeElement, sortByKeyM, sortByKey)
import Utils (mapM, sortByKeyM, sortByKey)
renderer :: Renderer
renderer =
@ -275,15 +274,14 @@ renderGolangType className properties = do
unionFieldName :: IRType -> Doc String
unionFieldName t = goNameStyle <$> getTypeNameForUnion t
compoundPredicates :: Array (IRType -> Boolean)
compoundPredicates = [isArray, isClass, isMap]
compoundPredicates :: Array (IRUnionRep -> Maybe IRType)
compoundPredicates = [unionHasArray, unionHasClass, unionHasMap]
renderGolangUnion :: String -> IRUnionRep -> Doc Unit
renderGolangUnion name unionRep = do
let { hasNull, nonNullUnion } = removeNullFromUnion unionRep
let nonNullTypes = unionToSet nonNullUnion
let isNullableString = if hasNull then "true" else "false"
fields <- L.fromFoldable nonNullTypes # sortByKeyM unionFieldName
fields <- unionToList nonNullUnion # sortByKeyM unionFieldName
columns <- fields # mapM \t -> do
{ rendered, comment } <- renderNullableToGolang t
field <- unionFieldName t
@ -315,11 +313,9 @@ renderGolangUnion name unionRep = do
line $ "return marshalUnion(" <> args <> ", " <> isNullableString <> ")"
line "}"
where
allTypes = unionToSet unionRep
ifClass :: (String -> String -> Doc Unit) -> Doc Unit
ifClass f =
let { element } = removeElement isClass allTypes
let element = unionHasClass unionRep
in
case element of
Just t -> do
@ -328,34 +324,33 @@ renderGolangUnion name unionRep = do
f name rendered
Nothing -> pure unit
maybeAssignNil p =
let { element } = removeElement p allTypes
in
case element of
Just t -> do
name <- unionFieldName t
line $ "x." <> name <> " = nil"
Nothing -> pure unit
makeArgs :: (IRType -> Doc String) -> ((IRType -> Boolean) -> Doc String) -> Doc String
case p unionRep of
Just t -> do
name <- unionFieldName t
line $ "x." <> name <> " = nil"
Nothing -> pure unit
predicateForType :: IRType -> IRUnionRep -> Maybe IRType
predicateForType t ur =
if isUnionMember t ur then Just t else Nothing
makeArgs :: ((IRUnionRep -> Maybe IRType) -> Doc String) -> ((IRUnionRep -> Maybe IRType) -> Doc String) -> Doc String
makeArgs primitive compound = do
primitiveArgs <- mapM primitive $ L.fromFoldable [IRInteger, IRDouble, IRBool, IRString]
compoundArgs <- mapM compound $ L.fromFoldable compoundPredicates
pure $ intercalate ", " $ A.concat [A.fromFoldable primitiveArgs, A.fromFoldable compoundArgs]
memberArg :: String -> (IRType -> String -> String) -> (IRType -> Boolean) -> Doc String
primitiveArgs <- mapM primitive $ map predicateForType [IRInteger, IRDouble, IRBool, IRString]
compoundArgs <- mapM compound compoundPredicates
pure $ intercalate ", " $ A.concat [primitiveArgs, compoundArgs]
memberArg :: String -> (IRType -> String -> String) -> (IRUnionRep -> Maybe IRType) -> Doc String
memberArg notPresentValue renderPresent p =
let { element } = removeElement p allTypes
in
case element of
Just t -> do
name <- unionFieldName t
pure $ renderPresent t name
Nothing -> pure notPresentValue
primitiveUnmarshalArg t =
memberArg "nil" (\_ n -> "&x." <> n) (eq t)
case p unionRep of
Just t -> do
name <- unionFieldName t
pure $ renderPresent t name
Nothing -> pure notPresentValue
primitiveUnmarshalArg p =
memberArg "nil" (\_ n -> "&x." <> n) p
compoundUnmarshalArg p =
memberArg "false, nil" (\t n -> if isClass t then "true, &c" else "true, &x." <> n) p
primitiveMarshalArg :: IRType -> Doc String
primitiveMarshalArg t =
memberArg "nil" (\_ n -> "x." <> n) (eq t)
compoundMarshalArg :: (IRType -> Boolean) -> Doc String
primitiveMarshalArg :: (IRUnionRep -> Maybe IRType) -> Doc String
primitiveMarshalArg p =
memberArg "nil" (\_ n -> "x." <> n) p
compoundMarshalArg :: (IRUnionRep -> Maybe IRType) -> Doc String
compoundMarshalArg p =
memberArg "false, nil" (\t n -> "x." <> n <> " != nil, x." <> n) p

Просмотреть файл

@ -16,7 +16,6 @@ import Data.Set (Set)
import Data.Set as S
import Data.String.Util (camelCase, capitalize, isLetterOrLetterNumber, legalizeCharacters, startWithLetter, stringEscape)
import Data.Tuple (Tuple(..))
import Utils (removeElement)
forbiddenNames :: Array String
forbiddenNames =
@ -287,9 +286,9 @@ renderDoubleCase union =
indent do
deserializeType IRDouble
renderGenericCase :: (IRType -> Boolean) -> String -> Set IRType -> Doc Unit
renderGenericCase predicate tokenType types =
case find predicate types of
renderGenericCase :: (IRUnionRep -> Maybe IRType) -> String -> IRUnionRep -> Doc Unit
renderGenericCase predicate tokenType union =
case predicate union of
Nothing -> pure unit
Just t -> do
tokenCase tokenType
@ -299,7 +298,6 @@ renderGenericCase predicate tokenType types =
renderUnionDefinition :: String -> IRUnionRep -> Doc Unit
renderUnionDefinition unionName unionRep = do
let { hasNull, nonNullUnion } = removeNullFromUnion unionRep
let nonNullTypes = unionToSet nonNullUnion
renderFileHeader unionName ["java.io.IOException", "java.util.Map", "com.fasterxml.jackson.core.*", "com.fasterxml.jackson.databind.*", "com.fasterxml.jackson.databind.annotation.*"]
line $ "@JsonDeserialize(using = " <> unionName <> ".Deserializer.class)"
line $ "@JsonSerialize(using = " <> unionName <> ".Serializer.class)"
@ -321,9 +319,9 @@ renderUnionDefinition unionName unionRep = do
renderDoubleCase nonNullUnion
renderPrimitiveCase ["VALUE_TRUE", "VALUE_FALSE"] IRBool nonNullUnion
renderPrimitiveCase ["VALUE_STRING"] IRString nonNullUnion
renderGenericCase isArray "START_ARRAY" nonNullTypes
renderGenericCase isClass "START_OBJECT" nonNullTypes
renderGenericCase isMap "START_OBJECT" nonNullTypes
renderGenericCase unionHasArray "START_ARRAY" nonNullUnion
renderGenericCase unionHasClass "START_OBJECT" nonNullUnion
renderGenericCase unionHasMap "START_OBJECT" nonNullUnion
line $ "default: throw new IOException(\"Cannot deserialize " <> unionName <> "\");"
line "}"
line "return value;"

Просмотреть файл

@ -9,15 +9,12 @@ import Prelude
import Data.Array as A
import Data.Char.Unicode (isAlphaNum, isDigit)
import Data.Foldable (for_, null)
import Data.List as L
import Data.Map (Map)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.Set (Set)
import Data.Set as S
import Data.String as String
import Data.String.Util (camelCase, capitalize, decapitalize, genericStringEscape, intToHex, legalizeCharacters, startWithLetter)
import Data.Tuple (Tuple(..))
import Utils (removeElement)
keywords :: Array String
keywords =
@ -425,7 +422,6 @@ renderUnionDefinition unionName unionRep = do
renderUnionExtension :: String -> IRUnionRep -> Doc Unit
renderUnionExtension unionName unionRep = do
let { hasNull, nonNullUnion } = removeNullFromUnion unionRep
let nonNullTypes = unionToSet nonNullUnion
line $ "extension " <> unionName <> " {"
indent do
line $ "fileprivate static func fromJson(_ v: Any) -> " <> unionName <> "? {"
@ -441,7 +437,8 @@ renderUnionExtension unionName unionRep = do
renderCase IRBool
when (isUnionMember IRInteger nonNullUnion) do
renderCase IRInteger
for_ (S.difference nonNullTypes $ S.fromFoldable [IRBool, IRInteger]) \typ -> do
-- FIXME: this is ugly and inefficient
for_ (L.difference (unionToList nonNullUnion) $ L.fromFoldable [IRBool, IRInteger]) \typ -> do
renderCase typ
line "return nil"
line "}"

Просмотреть файл

@ -6,7 +6,6 @@ module Utils
, sortByKeyM
, sortByKey
, lookupOrDefault
, removeElement
, forEnumerated_
, forStrMap_
, forMapM
@ -75,10 +74,6 @@ sortByKeyM keyF items = do
lookupOrDefault :: forall k v. Ord k => v -> k -> Map k v -> v
lookupOrDefault default key m = maybe default id $ M.lookup key m
removeElement :: forall a. Ord a => (a -> Boolean) -> Set a -> { element :: Maybe a, rest :: Set a }
removeElement p s = { element, rest: maybe s (\x -> S.delete x s) element }
where element = find p s
forEnumerated_ :: forall a b m. Applicative m => List a -> (Int -> a -> m b) -> m Unit
forEnumerated_ l f =
let lWithIndexes = L.zip (L.range 0 ((L.length l) - 1)) l