shwifty 0.0.1.0 → 0.0.2.0

raw patch · 7 files changed

+2575/−2180 lines, 7 filesdep ~primitivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: primitive

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• shwifty.cabal +7/−2
• src/Shwifty.hs +1668/−2178
• src/Shwifty/Class.hs +154/−0
• src/Shwifty/Codec.hs +210/−0
• src/Shwifty/Pretty.hs +204/−0
• src/Shwifty/Types.hs +314/−0

@@ -1,5 +1,23 @@ # Revision history for shwifty +## 0.0.2.0 - 2020-02-26++* Primitive lower bound: 0.7 -> 0.6.4+* Fix issue with type defaulting in disambiguate+* Add docs to 'toSwift'+* Add 'Codec' API for cleaner deriving+* Remove usage of -XDuplicateRecordFields+* Add getShwiftyCodecTags +* Cleanup internal code (organise but maintain external API)+* Add support for private enums/structs +* Add support for 'base' types+* Add support for omitting fields and cases +* Remove indent option +* Fix pretty-printing for functions in swift+* Remove instance for Void+* Make 'prettySwiftData' a top-level function+* Remove 'Comparable' protocol+ ## 0.0.1.0 -- 2020-02-03  * First version. Released on an unsuspecting world.

@@ -2,7 +2,7 @@ name:   shwifty version:-  0.0.1.0+  0.0.2.0 synopsis:   Generate swift types from haskell types. description:@@ -35,13 +35,18 @@   exposed-modules:     Shwifty     --Test+  other-modules:+    Shwifty.Class+    Shwifty.Codec+    Shwifty.Pretty+    Shwifty.Types   build-depends:     , base >= 4.11 && < 4.14     , bytestring >= 0.10 && < 0.11     , case-insensitive >= 1.2 && < 1.3     , containers >= 0.5.9 && < 0.7     , mtl >= 2.2 && < 2.3-    , primitive >= 0.7 && < 0.8+    , primitive >= 0.6.4 && < 0.8     , template-haskell >= 2.11 && < 2.17     , text >= 1.2 && < 1.3     , th-abstraction >= 0.3 && < 0.4

@@ -1,2181 +1,1671 @@ {-# language     AllowAmbiguousTypes   , BangPatterns-  , CPP-  , DataKinds-  , DefaultSignatures-  , DeriveFoldable-  , DeriveFunctor-  , DeriveGeneric-  , DeriveLift-  , DeriveTraversable-  , DerivingStrategies-  , DuplicateRecordFields-  , FlexibleInstances-  , GADTs-  , KindSignatures-  , LambdaCase-  , MultiWayIf-  , NamedFieldPuns-  , OverloadedStrings-  , PolyKinds-  , RecordWildCards-  , ScopedTypeVariables-  , TemplateHaskell-  , TypeApplications-  , ViewPatterns-#-}--{-# options_ghc-  -Wall-  -fno-warn-duplicate-exports-#-}---- | The Shwifty library allows generation of---   Swift types (structs and enums) from Haskell---   ADTs, using Template Haskell. The main---   entry point to the library should be the---   documentation and examples of 'getShwifty'.---   See also 'getShwiftyWith'---   and 'getShwiftyWithTags'.------   This library is in alpha and there are a number---   of known bugs which shouldn't affect most users.---   See the issue tracker to see what those are.------   There are probably many bugs/some weird behaviour---   when it comes to data families. Please report---   any issues on the issue tracker.-module Shwifty-  ( -- * Classes for conversion-    ToSwift(..)-  , ToSwiftData(..)--    -- * Generating instances-  , getShwifty-  , getShwiftyWith-  , getShwiftyWithTags--    -- * Types-  , Ty(..)-  , SwiftData(..)-  , Protocol(..)--    -- * Options for encoding types-    -- ** Option type-  , Options-    -- ** Actual Options-  , fieldLabelModifier-  , constructorModifier-  , optionalExpand-  , indent-  , generateToSwift-  , generateToSwiftData-  , dataProtocols-  , dataRawValue-  , typeAlias-  , newtypeTag-  , lowerFirstCase-  , lowerFirstField-    -- ** Default 'Options'-  , defaultOptions--    -- * Pretty-printing-    -- ** Functions-  , prettyTy-  , prettySwiftData-    -- ** Re-exports-  , X-  ) where--#include "MachDeps.h"--import Control.Monad.Except-import Data.CaseInsensitive (CI)-import Data.Foldable (foldlM,foldr',foldl')-import Data.Functor ((<&>))-import Data.Int (Int8,Int16,Int32,Int64)-import Data.List (intercalate)-import Data.List.NonEmpty ((<|), NonEmpty(..))-import Data.Maybe (mapMaybe, catMaybes)-import Data.Proxy (Proxy(..))-import Data.Time (UTCTime)-import Data.UUID.Types (UUID)-import Data.Vector (Vector)-import Data.Void (Void)-import Data.Word (Word8,Word16,Word32,Word64)-import GHC.Generics (Generic)-import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)-import Language.Haskell.TH hiding (stringE)-import Language.Haskell.TH.Datatype-import Language.Haskell.TH.Syntax (Lift)-import Prelude hiding (Enum(..))-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import qualified Data.Char as Char-import qualified Data.HashMap.Strict as HM-import qualified Data.List as L-import qualified Data.List.NonEmpty as NE-import qualified Data.Map as M-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import qualified Data.Primitive as Prim---- | An AST representing a Swift type.-data Ty-  = Unit-    -- ^ Unit (called "Unit/Void" in swift). Empty struct type.-  | Bool-    -- ^ Bool-  | Character-    -- ^ Character-  | Str-    -- ^ String. Named 'Str' to avoid conflicts with-    --   'Data.Aeson.String'.-  | I-    -- ^ signed machine integer-  | I8-    -- ^ signed 8-bit integer-  | I16-    -- ^ signed 16-bit integer-  | I32-    -- ^ signed 32-bit integer-  | I64-    -- ^ signed 64-bit integer-  | U-    -- ^ unsigned machine integer-  | U8-    -- ^ unsigned 8-bit integer-  | U16-    -- ^ unsigned 16-bit integer-  | U32-    -- ^ unsigned 32-bit integer-  | U64-    -- ^ unsigned 64-bit integer-  | F32-    -- ^ 32-bit floating point-  | F64-    -- ^ 64-bit floating point-  | Decimal-    -- ^ Increased-precision floating point-  | BigSInt32-    -- ^ 32-bit big integer-  | BigSInt64-    -- ^ 64-bit big integer-  | Tuple2 Ty Ty-    -- ^ 2-tuple-  | Tuple3 Ty Ty Ty-    -- ^ 3-tuple-  | Optional Ty-    -- ^ Maybe type-  | Result Ty Ty-    -- ^ Either type-    ---    --   /Note/: The error type in Swift must-    --   implement the @Error@ protocol. This library-    --   currently does not enforce this.-  | Set Ty-    -- ^ Set type-  | Dictionary Ty Ty-    -- ^ Dictionary type-  | Array Ty-    -- ^ array type-  | App Ty Ty-    -- ^ function type-  | Poly String-    -- ^ polymorphic type variable-  | Concrete-      { name :: String-        -- ^ the name of the type-      , tyVars :: [Ty]-        -- ^ the type's type variables-      }-    -- ^ a concrete type variable, and its-    --   type variables. Will typically be generated-    --   by 'getShwifty'.-  | Tag-      { name :: String-        -- ^ the name of the type-      , parent :: String-        -- ^ the type constructor of the type-        --   to which this alias belongs-      , typ :: Ty-        -- ^ the type that this represents-      , disambiguate :: Bool-        -- ^ does the type need disambiguation?-        ---        --   This will happen if there are multiple-        --   tags with the same type. This is needed-        --   to maintain safety.-      }-    -- ^ A @Tagged@ typealias, for newtyping-    --   in a way that doesn't break Codable.-    ---    --   See 'getShwiftyWithTags' for examples.-  deriving stock (Eq, Show, Read)-  deriving stock (Generic)-  deriving stock (Lift)---- | A Swift datatype, either a struct (product type)---   or enum (sum type). Haskll types are---   sums-of-products, so the way we differentiate---   when doing codegen,---   is that types with a single constructor---   will be converted to a struct, and those with---   two or more constructors will be converted to an---   enum. Types with 0 constructors will be converted---   to an empty enum.------   /Note/: There seems to be a haddock bug related---   to `-XDuplicateRecordFields` which---   causes the haddocks for the fields of 'SwiftEnum'---   to refer to struct.-data SwiftData-  = SwiftStruct-      { name :: String-        -- ^ The name of the struct-      , tyVars :: [String]-        -- ^ The struct's type variables-      , protocols :: [Protocol]-        -- ^ The protocols which the struct-        --   implements-      , fields :: [(String, Ty)]-        -- ^ The fields of the struct. the pair-        --   is interpreted as (name, type).-      , tags :: [Ty]-        -- ^ The tags of the struct. See 'Tag'.-      }-    -- ^ A struct (product type)-  | SwiftEnum-      { name :: String-        -- ^ The name of the enum-      , tyVars :: [String]-        -- ^ The enum's type variables-      , protocols :: [Protocol]-        -- ^ The protocols which the enum-        --   implements-      , cases :: [(String, [(Maybe String, Ty)])]-        -- ^ The cases of the enum. the type-        --   can be interpreted as-        --   (name, [(label, type)]).-      , rawValue :: Maybe Ty-        -- ^ The rawValue of an enum. See-        --   https://developer.apple.com/documentation/swift/rawrepresentable/1540698-rawvalue-        ---        --   Typically the 'Ty' will be-        --   'I' or 'String'.-        ---        --   /Note/: Currently, nothing will prevent-        --   you from putting something-        --   nonsensical here.-      , tags :: [Ty]-        -- ^ The tags of the struct. See 'Tag'.-      }-    -- ^ An enum (sum type)-  | TypeAlias-      { name :: String-        -- ^ the name of the type alias-      , tyVars :: [String]-        -- ^ the type variables of the type alias-      , typ :: Ty-        -- ^ the type this represents (RHS)-      }-    -- ^ A /top-level/ type alias-  deriving stock (Eq, Read, Show, Generic)---- | The class for things which can be converted to---   'SwiftData'.------   Typically the instance will be generated by---   'getShwifty'.-class ToSwiftData a where-  -- | Convert a type to 'SwiftData'-  toSwiftData :: Proxy a -> SwiftData-  -- | Pretty-print a type as its 'SwiftData'.-  prettySwiftData :: Proxy a -> String-  default prettySwiftData :: Proxy a -> String-  prettySwiftData = prettySwiftDataWith (indent defaultOptions) . toSwiftData---- | Swift protocols.---   Only a few are supported right now.-data Protocol-  = Hashable-    -- ^ The 'Hashable' protocol.-    --   See https://developer.apple.com/documentation/swift/hashable-  | Codable-    -- ^ The 'Codable' protocol.-    --   See https://developer.apple.com/documentation/swift/hashable-  | Equatable-    -- ^ The 'Equatable' protocol.-    --   See https://developer.apple.com/documentation/swift/hashable-  deriving stock (Eq, Read, Show, Generic)-  deriving stock (Lift)---- | Options that specify how to---   encode your 'SwiftData' to a swift type.------   Options can be set using record syntax on---   'defaultOptions' with the fields below.-data Options = Options-  { typeConstructorModifier :: String -> String-    -- ^ Function applied to type constructor names.-    --   The default ('id') makes no changes.-  , fieldLabelModifier :: String -> String-    -- ^ Function applied to field labels.-    --   Handy for removing common record prefixes,-    --   for example. The default ('id') makes no-    --   changes.-  , constructorModifier :: String -> String-    -- ^ Function applied to value constructor names.-    --   The default ('id') makes no changes.-  , optionalExpand :: Bool-    -- ^ Whether or not to truncate Optional types.-    --   Normally, an Optional ('Maybe') is encoded-    --   as "A?", which is syntactic sugar for-    --   "Optional\<A\>". The default value ('False')-    --   will keep it as sugar. A value of 'True'-    --   will expand it to be desugared.-  , indent :: Int-    -- ^ Number of spaces to indent field names-    --   and cases. The default is 4.-  , generateToSwift :: Bool-    -- ^ Whether or not to generate a 'ToSwift'-    --   instance. Sometime this can be desirable-    --   if you want to define the instance by hand,-    --   or the instance exists elsewhere.-    --   The default is 'True', i.e., to generate-    --   the instance.-  , generateToSwiftData :: Bool-    -- ^ Whether or not to generate a 'ToSwiftData'-    --   instance. Sometime this can be desirable-    --   if you want to define the instance by hand,-    --   or the instance exists elsewhere.-    --   The default is 'True', i.e., to generate-    --   the instance.-  , dataProtocols :: [Protocol]-    -- ^ Protocols to add to a type.-    --   The default (@[]@) will add none.-  , dataRawValue :: Maybe Ty-    -- ^ The rawValue of an enum. See-    --   https://developer.apple.com/documentation/swift/rawrepresentable/1540698-rawvalue-    ---    --   The default ('Nothing') will not-    --   include any rawValue.-    ---    --   Typically, if the type does have-    --   a 'rawValue', the 'Ty' will be-    --   'I' or 'Str'.-    ---    --   /Note/: Currently, nothing will prevent-    --   you from putting something-    --   nonsensical here.-  , typeAlias :: Bool-    -- ^ Whether or not to generate a newtype as-    --   a type alias. Consider if you want this-    --   or to use 'getShwiftyWithTags' instead.-    ---    --   The default ('False') will generate newtypes-    --   as their own structs.-  , newtypeTag :: Bool-    -- ^ Whether or not to generate a newtype as an-    --   empty enum with a tag. This is for type-    --   safety reasons, but with retaining the-    --   ability to have Codable conformance.-    ---    --   The default ('False') will not do this.-    ---    --   /Note/: This takes priority over 'typeAlias'.-    ---    --   /Note/: This option is not currently-    --   supported for newtype instances.-    ---    -- === __Examples__-    ---    -- > newtype NonEmptyText = MkNonEmptyText String-    -- > $(getShwiftyWith (defaultOptions { newtypeTag = True }) ''NonEmpyText)-    ---    -- @-    -- enum NonEmptyTextTag {-    --     typealias NonEmptyText = Tagged\<NonEmptyTextTag, String\>-    -- }-    -- @-  , lowerFirstField :: Bool-    -- ^ Whether or not to lower-case the first-    --   character of a field after applying all-    --   modifiers to it.-    ---    --   The default ('True') will do so.-  , lowerFirstCase :: Bool-    -- ^ Whether or not to lower-case the first-    --   character of a case after applying all-    --   modifiers to it.-    ---    --   The default ('True') will do so.-  }---- | The default 'Options'.------ @--- defaultOptions :: Options--- defaultOptions = Options---   { typeConstructorModifier = id---   , fieldLabelModifier = id---   , constructorModifier = id---   , optionalExpand= False---   , indent = 4---   , generateToSwift = True---   , generateToSwiftData = True---   , dataProtocols = []---   , dataRawValue = Nothing---   , typeAlias = False---   , newtypeTag = False---   , lowerFirstField = True---   , lowerFirstCase = True---   }--- @----defaultOptions :: Options-defaultOptions = Options-  { typeConstructorModifier = id-  , fieldLabelModifier = id-  , constructorModifier = id-  , optionalExpand = False-  , indent = 4-  , generateToSwift = True-  , generateToSwiftData = True-  , dataProtocols = []-  , dataRawValue = Nothing-  , typeAlias = False-  , newtypeTag = False-  , lowerFirstField = True-  , lowerFirstCase = True-  }---- | The class for things which can be converted to---   a Swift type ('Ty').------   Typically the instance will be generated by---   'getShwifty'.-class ToSwift a where-  toSwift :: Proxy a -> Ty---- Used internally to reflect polymorphic type--- variables into TH, then reify them into 'Poly'.------ See the Rose tree section below-data SingSymbol (x :: Symbol)-instance KnownSymbol x => ToSwift (SingSymbol x) where-  toSwift _ = Poly (symbolVal (Proxy @x))---- | A filler type to be used when pretty-printing.---   The codegen used by shwifty doesn't look at---   at what a type's type variables are instantiated---   to, but rather at the type's top-level---   definition. However,---   to make GHC happy, you will have to fill in type---   variables with unused types. To get around this,---   you could also use something like---   `-XQuantifiedConstraints`, or existential types,---   but we leave that to the user to handle.-type X = Void--instance ToSwift Void where-  toSwift = const (Concrete "Void" [])--instance ToSwift () where-  toSwift = const Unit--instance ToSwift Bool where-  toSwift = const Bool--instance ToSwift UUID where-  toSwift = const (Concrete "UUID" [])--instance ToSwift UTCTime where-  toSwift = const (Concrete "Date" [])--instance forall a b. (ToSwift a, ToSwift b) => ToSwift (a -> b) where-  toSwift = const (App (toSwift (Proxy @a)) (toSwift (Proxy @b)))--instance forall a. ToSwift a => ToSwift (Maybe a) where-  toSwift = const (Optional (toSwift (Proxy @a)))---- | /Note/: In Swift, the ordering of the type---   variables is flipped - Shwifty has made the---   design choice to flip them for you. If you---   take issue with this, please open an issue---   for discussion on GitHub.-instance forall a b. (ToSwift a, ToSwift b) => ToSwift (Either a b) where-  toSwift = const (Result (toSwift (Proxy @b)) (toSwift (Proxy @a)))--instance ToSwift Integer where-  toSwift = const-#if WORD_SIZE_IN_BITS == 32-    BigSInt32-#else-    BigSInt64-#endif--instance ToSwift Int   where toSwift = const I-instance ToSwift Int8  where toSwift = const I8-instance ToSwift Int16 where toSwift = const I16-instance ToSwift Int32 where toSwift = const I32-instance ToSwift Int64 where toSwift = const I64--instance ToSwift Word   where toSwift = const U-instance ToSwift Word8  where toSwift = const U8-instance ToSwift Word16 where toSwift = const U16-instance ToSwift Word32 where toSwift = const U32-instance ToSwift Word64 where toSwift = const U64--instance ToSwift Float  where toSwift = const F32-instance ToSwift Double where toSwift = const F64--instance ToSwift Char where toSwift = const Character--instance forall a. (ToSwift a) => ToSwift (Prim.Array a) where-  toSwift = const (Array (toSwift (Proxy @a)))--instance forall a. (ToSwift a) => ToSwift (Prim.SmallArray a) where-  toSwift = const (Array (toSwift (Proxy @a)))--instance ToSwift Prim.ByteArray where-  toSwift = const (Array U8)--instance forall a. (ToSwift a) => ToSwift (Prim.PrimArray a) where-  toSwift = const (Array (toSwift (Proxy @a)))--instance forall a. ToSwift a => ToSwift (Vector a) where-  toSwift = const (Array (toSwift (Proxy @a)))--instance {-# overlappable #-} forall a. ToSwift a => ToSwift [a] where-  toSwift = const (Array (toSwift (Proxy @a)))--instance {-# overlapping #-} ToSwift [Char] where toSwift = const Str--instance ToSwift TL.Text where toSwift = const Str-instance ToSwift TS.Text where toSwift = const Str--instance ToSwift BL.ByteString where toSwift = const (Array U8)-instance ToSwift BS.ByteString where toSwift = const (Array U8)--instance ToSwift (CI s) where toSwift = const Str--instance forall k v. (ToSwift k, ToSwift v) => ToSwift (M.Map k v) where toSwift = const (Dictionary (toSwift (Proxy @k)) (toSwift (Proxy @v)))--instance forall k v. (ToSwift k, ToSwift v) => ToSwift (HM.HashMap k v) where toSwift = const (Dictionary (toSwift (Proxy @k)) (toSwift (Proxy @v)))--instance forall a b. (ToSwift a, ToSwift b) => ToSwift ((,) a b) where-  toSwift = const (Tuple2 (toSwift (Proxy @a)) (toSwift (Proxy @b)))--instance forall a b c. (ToSwift a, ToSwift b, ToSwift c) => ToSwift ((,,) a b c) where-  toSwift = const (Tuple3 (toSwift (Proxy @a)) (toSwift (Proxy @b)) (toSwift (Proxy @c)))--labelCase :: Maybe String -> Ty -> String-labelCase Nothing ty = prettyTy ty-labelCase (Just label) ty = "_ " ++ label ++ ": " ++ prettyTy ty--prettyTypeHeader :: String -> [String] -> String-prettyTypeHeader name [] = name-prettyTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">"---- | Pretty-print a 'Ty'.-prettyTy :: Ty -> String-prettyTy = \case-  Str -> "String"-  Unit -> "()"-  Bool -> "Bool"-  Character -> "Character"-  Tuple2 e1 e2 -> "(" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ")"-  Tuple3 e1 e2 e3 -> "(" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ", " ++ prettyTy e3 ++ ")"-  Optional e -> prettyTy e ++ "?"-  Result e1 e2 -> "Result<" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ">"-  Set e -> "Set<" ++ prettyTy e ++ ">"-  Dictionary e1 e2 -> "Dictionary<" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ">"-  Array e -> "[" ++ prettyTy e ++ "]"-  -- App is special, we recurse until we no longer-  -- any applications.-  App e1 e2 -> prettyApp e1 e2-  I -> "Int"-  I8 -> "Int8"-  I16 -> "Int16"-  I32 -> "Int32"-  I64 -> "Int64"-  U -> "UInt"-  U8 -> "UInt8"-  U16 -> "UInt16"-  U32 -> "UInt32"-  U64 -> "UInt64"-  F32 -> "Float"-  F64 -> "Double"-  Decimal -> "Decimal"-  BigSInt32 -> "BigSInt32"-  BigSInt64 -> "BigSInt64"-  Poly ty -> ty-  Concrete ty [] -> ty-  Concrete ty tys -> ty-    ++ "<"-    ++ intercalate ", " (map prettyTy tys)-    ++ ">"-  Tag {name,parent} -> parent ++ "." ++ name--prettyApp :: Ty -> Ty -> String-prettyApp t1 t2 = "(("-  ++ intercalate ", " (map prettyTy as)-  ++ ") -> "-  ++ prettyTy r-  ++ ")"-  where-    (as, r) = go t1 t2-    go e1 (App e2 e3) = case go e2 e3 of-      (args, ret) -> (e1 : args, ret)-    go e1 e2 = ([e1], e2)--prettyRawValueAndProtocols :: Maybe Ty -> [Protocol] -> String-prettyRawValueAndProtocols Nothing ps = prettyProtocols ps-prettyRawValueAndProtocols (Just ty) [] = ": " ++ prettyTy ty-prettyRawValueAndProtocols (Just ty) ps = ": " ++ prettyTy ty ++ ", " ++ intercalate ", " (map show ps)--prettyProtocols :: [Protocol] -> String-prettyProtocols = \case-  [] -> ""-  ps -> ": " ++ intercalate ", " (map show ps)--prettyTags :: String -> [Ty] -> String-prettyTags indents = go where-  go [] = ""-  go (Tag{name,parent,typ,disambiguate}:ts) = []-    ++ "\n"-    ++ prettyTagDisambiguator disambiguate indents name-    ++ indents-    ++ "typealias "-    ++ name-    ++ " = Tagged<"-    ++ (if disambiguate then name ++ "Tag" else parent)-    ++ ", "-    ++ prettyTy typ-    ++ ">"-    ++ go ts-  go _ = error "non-tag supplied to prettyTags"--prettyTagDisambiguator :: ()-  => Bool-     -- ^ disambiguate?-  -> String-     -- ^ indents-  -> String-     -- ^ parent type name-  -> String-prettyTagDisambiguator disambiguate indents parent-  = if disambiguate-      then []-        ++ indents-        ++ "enum "-        ++ parent-        ++ "Tag { }\n"-      else ""---- | Pretty-print a 'SwiftData'.---   This function cares about indent.-prettySwiftDataWith :: ()-  => Int -- ^ indent-  -> SwiftData-  -> String-prettySwiftDataWith indent = \case--  SwiftEnum {name,tyVars,protocols,cases,rawValue,tags} -> []-    ++ "enum "-    ++ prettyTypeHeader name tyVars-    ++ prettyRawValueAndProtocols rawValue protocols-    ++ " {"-    ++ newlineNonEmpty cases-    ++ go cases-    ++ prettyTags indents tags-    ++ newlineNonEmpty tags-    ++ "}"-    where-      go [] = ""-      go ((caseNm, []):xs) = []-        ++ indents-        ++ "case "-        ++ caseNm-        ++ "\n"-        ++ go xs-      go ((caseNm, cs):xs) = []-        ++ indents-        ++ "case "-        ++ caseNm-        ++ "("-        ++ (intercalate ", " (map (uncurry labelCase) cs))-        ++ ")\n"-        ++ go xs-  SwiftStruct {name,tyVars,protocols,fields,tags} -> []-    ++ "struct "-    ++ prettyTypeHeader name tyVars-    ++ prettyProtocols protocols-    ++ " {"-    ++ newlineNonEmpty fields-    ++ go fields-    ++ prettyTags indents tags-    ++ newlineNonEmpty tags-    ++ "}"-    where-      go [] = ""-      go ((fieldName,ty):fs) = indents ++ "let " ++ fieldName ++ ": " ++ prettyTy ty ++ "\n" ++ go fs-  TypeAlias {name, tyVars, typ} -> []-    ++ "typealias "-    ++ prettyTypeHeader name tyVars-    ++ " = "-    ++ prettyTy typ-  where-    indents = replicate indent ' '--    newlineNonEmpty [] = ""-    newlineNonEmpty _ = "\n"--ensureEnabled :: Extension -> ShwiftyM ()-ensureEnabled ext = do-  enabled <- lift $ isExtEnabled ext-  unless enabled $ do-    throwError $ ExtensionNotEnabled ext---- | Generate 'ToSwiftData' and 'ToSwift' instances---   for your type. 'ToSwift' instances are typically---   used to build cases or fields, whereas---   'ToSwiftData' instances are for building structs---   and enums. Click the @Examples@ button to see---   examples of what Swift gets generated in---   different scenarios. To get access to the---   generated code, you will have to use one of---   the pretty-printing functions provided.------ === __Examples__------ > -- A simple sum type--- > data SumType = Sum1 | Sum2 | Sum3--- > getShwifty ''SumType------ @--- enum SumType {---     case sum1---     case sum2---     case sum3--- }--- @------ > -- A simple product type--- > data ProductType = ProductType { x :: Int, y :: Int }--- > getShwifty ''ProductType------ @--- struct ProductType {---     let x: Int---     let y: Int--- }--- @------ > -- A sum type with type variables--- > data SumType a b = SumL a | SumR b--- > getShwifty ''SumType------ @--- enum SumType\<A, B\> {---     case sumL(A)---     case sumR(B)--- }--- @------ > -- A product type with type variables--- > data ProductType a b = ProductType { aField :: a, bField :: b }--- > getShwifty ''ProductType------ @--- struct ProductType\<A, B\> {---     let aField: A---     let bField: B--- }--- @------ > -- A newtype--- > newtype Newtype a = Newtype { getNewtype :: a }--- > getShwifty ''Newtype------ @--- struct Newtype\<A\> {---     let getNewtype: A--- }--- @------ > -- A type with a function field--- > newtype Endo a = Endo { appEndo :: a -> a }--- > getShwifty ''Endo------ @--- struct Endo\<A\> {---     let appEndo: ((A) -> A)--- }--- @------ > -- A type with a kookier function field--- > newtype Fun a = Fun { fun :: Int -> Char -> Bool -> String -> Maybe a }--- > getShwifty ''Fun------ @--- struct Fun<A> {---     let fun: ((Int, Char, Bool, String) -> A?)--- }--- @------ > -- A weird type with nested fields. Also note the Result's types being flipped from that of the Either.--- > data YouveGotProblems a b = YouveGotProblems { field1 :: Maybe (Maybe (Maybe a)), field2 :: Either (Maybe a) (Maybe b) }--- > getShwifty ''YouveGotProblems------ @--- struct YouveGotProblems\<A, B\> {---     let field1: Option\<Option\<Option\<A\>\>\>---     let field2: Result\<Option\<B\>,Option\<A\>\>--- }--- @------ > -- A type with polykinded type variables--- > -- Also note that there is no newline because--- > -- of the absence of fields--- > data PolyKinded (a :: k) = PolyKinded--- > getShwifty ''PolyKinded------ @--- struct PolyKinded\<A\> { }--- @------ > -- A sum type where constructors might be records--- > data SumType a b (c :: k) = Sum1 Int a (Maybe b) | Sum2 b | Sum3 { x :: Int, y :: Int }--- > getShwifty ''SumType------ @--- enum SumType\<A, B, C\> {---   case field1(Int, A, Optional\<B\>)---   case field2(B)---   case field3(_ x: Int, _ y: Int)--- }--- @------ > -- A type containing another type with instance generated by 'getShwifty'--- > newtype MyFirstType a = MyFirstType { getMyFirstType :: a }--- > getShwifty ''MyFirstType--- >--- > data Contains a = Contains { x :: MyFirstType Int, y :: MyFirstType a }--- > getShwifty ''Contains------ @--- struct MyFirstType\<A\> {---   let getMyFirstType: A--- }------ struct Contains\<A\> {---   let x: MyFirstType\<Int\>---   let y: MyFirstType\<A\>--- }--- @-getShwifty :: Name -> Q [Dec]-getShwifty = getShwiftyWith defaultOptions---- | Like 'getShwifty', but lets you supply---   your own 'Options'. Click the examples---   for some clarification of what you can do.------ === __Examples__------ > data PrefixedFields = MkPrefixedFields { prefixedFieldsX :: Int, prefixedFieldsY :: Int }--- > $(getShwiftyWith (defaultOptions { fieldLabelModifier = drop (length "PrefixedFields") }) ''PrefixedFields)------ @--- struct PrefixedFields {---     let x: Int---     let y: Int--- }--- @------ > data PrefixedCons = MkPrefixedConsLeft | MkPrefixedConsRight--- > $(getShwiftyWith (defaultOptions { constructorModifier = drop (length "MkPrefixedCons"), dataProtocols = [Codable] }) ''PrefixedCons)------ @--- enum PrefixedCons: Codable {---     case left---     case right--- }--- @-getShwiftyWith :: Options -> Name -> Q [Dec]-getShwiftyWith o n = getShwiftyWithTags o [] n--data NewtypeInfo = NewtypeInfo-  { newtypeName :: Name-    -- ^ Type constructor-  , newtypeVars :: [TyVarBndr]-    -- ^ Type parameters-  , newtypeInstTypes :: [Type]-    -- ^ Argument types-  , newtypeVariant :: DatatypeVariant-    -- ^ Whether or not the type is a-    --   newtype or newtype instance-  , newtypeCon :: ConstructorInfo-  }--reifyNewtype :: Name -> ShwiftyM NewtypeInfo-reifyNewtype n = do-  DatatypeInfo{..} <- lift $ reifyDatatype n-  case datatypeCons of-    [c] -> do-      pure NewtypeInfo {-        newtypeName = datatypeName-      , newtypeVars = datatypeVars-      , newtypeInstTypes = datatypeInstTypes-      , newtypeVariant = datatypeVariant-      , newtypeCon = c-      }-    _ -> do-      throwError $ NotANewtype n---- Generate the tags for a type.--- Also generate the ToSwift instance for each tag--- type. We can't just expect people to do this--- with a separate 'getShwifty' call, because--- they will generate the wrong code, since other--- types with a tag that isn't theirs won't generate--- well-scoped fields.-getTags :: ()-  => Name-     -- ^ name of parent type-  -> [Name]-     -- ^ tags-  -> ShwiftyM ([Exp], [Dec])-getTags parentName ts = do-  let len = length ts-  disambiguate <- lift $ [||len > 1||]-  tags <- foldlM-    (\(es,ds) n -> do--      NewtypeInfo{..} <- reifyNewtype n-      let ConstructorInfo{..} = newtypeCon--      -- generate the tag-      let tyconName = case newtypeVariant of-            NewtypeInstance -> constructorName-            _ -> newtypeName-      typ <- case constructorFields of-        [ty] -> pure ty-        _ -> throwError $ NotANewtype newtypeName-      let tag = RecConE 'Tag-            [ (mkName "name", unqualName tyconName)-            , (mkName "parent", unqualName parentName)-            , (mkName "typ", toSwiftEPoly typ)-            , (mkName "disambiguate", unType disambiguate)-            ]--      -- generate the instance-      !instHeadTy-        <- buildTypeInstance newtypeName ClassSwift newtypeInstTypes newtypeVars newtypeVariant-      -- we do not want to strip here-      clauseTy <- tagToSwift tyconName typ parentName-      swiftTyInst <- lift $ instanceD-        (pure [])-        (pure instHeadTy)-        [ funD 'toSwift-          [ clause [] (normalB (pure clauseTy)) []-          ]-        ]--      pure $ (es ++ [tag], ds ++ [swiftTyInst])-    ) ([], []) ts-  pure tags--getToSwift :: ()-  => Options-     -- ^ options-  -> Name-     -- ^ type name-  -> [Type]-     -- ^ type variables-  -> [TyVarBndr]-     -- ^ type binders-  -> DatatypeVariant-     -- ^ type variant-  -> [ConstructorInfo]-     -- ^ constructors-  -> ShwiftyM [Dec]-getToSwift Options{..} parentName instTys tyVarBndrs variant cons = if generateToSwift-  then do-    instHead <- buildTypeInstance parentName ClassSwift instTys tyVarBndrs variant-    clauseTy <- case variant of-      NewtypeInstance -> case cons of-        [ConstructorInfo{..}] -> do-          newtypToSwift constructorName instTys-        _ -> do-          throwError ExpectedNewtypeInstance-      _ -> do-        typToSwift newtypeTag parentName instTys-    inst <- lift $ instanceD-      (pure [])-      (pure instHead)-      [ funD 'toSwift-        [ clause [] (normalB (pure clauseTy)) []-        ]-      ]-    pure [inst]-  else do-    pure []--getToSwiftData :: ()-  => Options-     -- ^ options-  -> Name-     -- ^ type name-  -> [Type]-     -- ^ type variables-  -> [TyVarBndr]-     -- ^ type binders-  -> DatatypeVariant-     -- ^ type variant-  -> [Exp]-     -- ^ tags-  -> [ConstructorInfo]-     -- ^ constructors-  -> ShwiftyM [Dec]-getToSwiftData o@Options{..} parentName instTys tyVarBndrs variant tags cons = if generateToSwiftData-  then do-    instHead <- buildTypeInstance parentName ClassSwiftData instTys tyVarBndrs variant-    clauseData <- consToSwift o parentName instTys variant tags cons-    clausePretty <- mkClausePretty o-    inst <- lift $ instanceD-      (pure [])-      (pure instHead)-        [ funD 'toSwiftData-          [ clause [] (normalB (pure clauseData)) []-          ]-        , funD 'prettySwiftData-          [ clause [] (normalB (pure clausePretty)) []-          ]-        ]-    pure [inst]-  else do-    pure []---- | Like 'getShwiftyWith', but lets you supply---   tags. Tags are type-safe typealiases that---   are akin to newtypes in Haskell. The---   introduction of a struct around something---   which is, say, a UUID in Swift means that---   the default Codable instance will not work---   correctly. So we introduce a tag(s). See the---   examples to see how this looks. Also, see---   https://github.com/pointfreeco/swift-tagged,---   the library which these tags use. The library---   is not included in any generated code.------ === __Examples__------ > -- Example of using the swift-tagged library:--- > -- A type containing a database key--- > data User = User { id :: UserId, name :: Text }--- > -- the user key--- > newtype UserId = UserId UUID--- > $(getShwiftyWithTags defaultOptions [ ''UserId ] ''User)--- > -- A type that also contains the UserId--- > data UserDetails = UserDetails { id :: UserId, lastName :: Text }--- > getShwifty ''UserDetails------ @--- struct User {---   let id: UserId---   let name: String------   typealias UserId = Tagged\<User,UUID\>--- }------ struct UserDetails {---   let id: User.UserId---   let lastName: String--- }--- @------ > -- Example type with multiple tags--- > newtype Name = MkName String--- > newtype Email = MkEmail String--- > data Person = Person { name :: Name, email :: Email }--- > $(getShwiftyWithTags defaultOptions [ ''Name, ''Email ] ''Person)------ @--- struct Person {---     let name: Name---     let email: Email------     enum NameTag {}---     typealias Name = Tagged\<NameTag, String\>------     enum EmailTag {}---     typealias Email = Tagged\<EmailTag, String\>--- }--- @-getShwiftyWithTags :: ()-  => Options-  -> [Name]-  -> Name-  -> Q [Dec]-getShwiftyWithTags o@Options{..} ts name = do-  r <- runExceptT $ do-    ensureEnabled ScopedTypeVariables-    ensureEnabled DataKinds-    ensureEnabled DuplicateRecordFields-    DatatypeInfo-      { datatypeName = parentName-      , datatypeVars = tyVarBndrs-      , datatypeInstTypes = instTys-      , datatypeVariant = variant-      , datatypeCons = cons-      } <- lift $ reifyDatatype name-    noExistentials cons--    -- get tags/ToSwift instances for tags-    (tags, extraDecs) <- getTags parentName ts--    swiftDataInst <- getToSwiftData o parentName instTys tyVarBndrs variant tags cons--    swiftTyInst <- getToSwift o parentName instTys tyVarBndrs variant cons-    pure $ swiftDataInst ++ swiftTyInst ++ extraDecs-  case r of-    Left e -> fail $ prettyShwiftyError e-    Right d -> pure d--noExistentials :: [ConstructorInfo] -> ShwiftyM ()-noExistentials cs = forM_ cs $ \ConstructorInfo{..} ->-  case (constructorName, constructorVars) of-    (_, []) -> do-      pure ()-    (cn, cvs) -> do-      throwError $ ExistentialTypes cn cvs--data ShwiftyError-  = SingleConNonRecord-      { _conName :: Name-      }-  | EncounteredInfixConstructor-      { _conName :: Name-      }-  | KindVariableCannotBeRealised-      { _typName :: Name-      , _kind :: Kind-      }-  | ExtensionNotEnabled-      { _ext :: Extension-      }-  | ExistentialTypes-      { _conName :: Name-      , _types :: [TyVarBndr]-      }-  | ExpectedNewtypeInstance-  | NotANewtype-      { _typName :: Name-      }--prettyShwiftyError :: ShwiftyError -> String-prettyShwiftyError = \case-  SingleConNonRecord (nameStr -> n) -> mempty-    ++ n-    ++ ": Cannot get shwifty with single-constructor "-    ++ "non-record types. This is due to a "-    ++ "restriction of Swift that prohibits structs "-    ++ "from not having named fields. Try turning "-    ++ n ++ " into a record!"-  EncounteredInfixConstructor (nameStr -> n) -> mempty-    ++ n-    ++ ": Cannot get shwifty with infix constructors. "-    ++ "Swift doesn't support them. Try changing "-    ++ n ++ " into a prefix constructor!"-  KindVariableCannotBeRealised (nameStr -> n) typ ->-    let (typStr, kindStr) = prettyKindVar typ-    in mempty-      ++ n-      ++ ": Encountered a type variable ("-      ++ typStr-      ++ ") with a kind ("-      ++ kindStr-      ++ ") that can't "-      ++ "get shwifty! Shwifty needs to be able "-      ++ "to realise your kind variables to `*`, "-      ++ "since that's all that makes sense in "-      ++ "Swift. The only kinds that can happen with "-      ++ "are `*` and the free-est kind, `k`."-  ExtensionNotEnabled ext -> mempty-    ++ show ext-    ++ " is not enabled. Shwifty needs it to work!"-  -- TODO: make this not print out implicit kinds.-  -- e.g. for `data Ex = forall x. Ex x`, there are-  -- no implicit `TyVarBndr`s, but for-  -- `data Ex = forall x y z. Ex x`, there are two:-  -- the kinds inferred by `y` and `z` are both `k`.-  -- We print these out - this could be confusing to-  -- the end user. I'm not immediately certain how to-  -- be rid of them.-  ExistentialTypes (nameStr -> n) tys -> mempty-    ++ n-    ++ " has existential type variables ("-    ++ L.intercalate ", " (map prettyTyVarBndrStr tys)-    ++ ")! Shwifty doesn't support these."-  ExpectedNewtypeInstance -> mempty-    ++ "Expected a newtype instance. This is an "-    ++ "internal logic error. Please report it as a "-    ++ "bug."-  NotANewtype (nameStr -> n) -> mempty-    ++ n-    ++ " is not a newtype. This is an internal logic "-    ++ "error. Please report it as a bug."--prettyTyVarBndrStr :: TyVarBndr -> String-prettyTyVarBndrStr = \case-  PlainTV n -> go n-  KindedTV n _ -> go n-  where-    go = TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show---- prettify the type and kind.-prettyKindVar :: Type -> (String, String)-prettyKindVar = \case-  SigT typ k -> (go typ, go k)-  VarT n -> (nameStr n, "*")-  typ -> error $ "Shwifty.prettyKindVar: used on a type without a kind signature. Type was: " ++ show typ-  where-    go = TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show . ppr--type ShwiftyM = ExceptT ShwiftyError Q--tagToSwift :: ()-  => Name-     -- ^ name of the type constructor-  -> Type-     -- ^ type variables-  -> Name-     -- ^ parent name-  -> ShwiftyM Exp-tagToSwift tyconName typ parentName = do-  -- TODO: use '_' instead of matching-  value <- lift $ newName "value"-  matches <- lift $ fmap ((:[]) . pure) $ do-    match-      (conP 'Proxy [])-      (normalB-        $ pure-        $ RecConE 'Tag-        $ [ (mkName "name", unqualName tyconName)-          , (mkName "parent", unqualName parentName)-          , (mkName "typ", toSwiftECxt typ)-          , (mkName "disambiguate", (ConE 'False))-          ]-      )-      []-  lift $ lamE [varP value] (caseE (varE value) matches)-newtypToSwift :: ()-  => Name-     -- ^ name of the constructor-  -> [Type]-     -- ^ type variables-  -> ShwiftyM Exp-newtypToSwift conName (stripConT -> instTys) = do-  typToSwift False conName instTys--typToSwift :: ()-  => Bool-     -- ^ is this a newtype tag?-  -> Name-     -- ^ name of the type-  -> [Type]-     -- ^ type variables-  -> ShwiftyM Exp-typToSwift newtypeTag parentName instTys = do-  -- TODO: use '_' instead of matching-  value <- lift $ newName "value"-  let tyVars = map toSwiftECxt instTys-  let name =-        let parentStr = nameStr parentName-            accessedName = if newtypeTag-              then parentStr ++ "Tag." ++ parentStr-              else parentStr-        in stringE accessedName-  matches <- lift $ fmap ((:[]) . pure) $ do-    match-      (conP 'Proxy [])-      (normalB-        $ pure-        $ RecConE 'Concrete-        $ [ (mkName "name", name)-          , (mkName "tyVars", ListE tyVars)-          ]-      )-      []-  lift $ lamE [varP value] (caseE (varE value) matches)--rawValueE :: Maybe Ty -> Exp-rawValueE = \case-  Nothing -> ConE 'Nothing-  Just ty -> AppE (ConE 'Just) (ParensE (tyE ty))---- god this is annoying. write a cleaner--- version of this-tyE :: Ty -> Exp-tyE = \case-  Unit -> ConE 'Unit-  Bool -> ConE 'Bool-  Character -> ConE 'Character-  Str -> ConE 'Str-  I -> ConE 'I-  I8 -> ConE 'I8-  I16 -> ConE 'I16-  I32 -> ConE 'I32-  I64 -> ConE 'I64-  U -> ConE 'U-  U8 -> ConE 'U8-  U16 -> ConE 'U16-  U32 -> ConE 'U32-  U64 -> ConE 'U64-  F32 -> ConE 'F32-  F64 -> ConE 'F64-  Decimal -> ConE 'Decimal-  BigSInt32 -> ConE 'BigSInt32-  BigSInt64 -> ConE 'BigSInt64-  Poly s -> AppE (ConE 'Poly) (stringE s)-  Concrete tyCon tyVars -> AppE (AppE (ConE 'Concrete) (stringE tyCon)) (ListE (map tyE tyVars))-  Tuple2 e1 e2 -> AppE (AppE (ConE 'Tuple2) (tyE e1)) (tyE e2)-  Tuple3 e1 e2 e3 -> AppE (AppE (AppE (ConE 'Tuple3) (tyE e1)) (tyE e2)) (tyE e3)-  Optional e -> AppE (ConE 'Optional) (tyE e)-  Result e1 e2 -> AppE (AppE (ConE 'Result) (tyE e1)) (tyE e2)-  Set e -> AppE (ConE 'Set) (tyE e)-  Dictionary e1 e2 -> AppE (AppE (ConE 'Dictionary) (tyE e1)) (tyE e2)-  App e1 e2 -> AppE (AppE (ConE 'App) (tyE e1)) (tyE e2)-  Array e -> AppE (ConE 'Array) (tyE e)-  Tag{name,parent,typ,disambiguate} -> AppE (AppE (AppE (AppE (ConE 'Tag) (stringE name)) (stringE parent)) (tyE typ)) (if disambiguate then ConE 'True else ConE 'False)--mkClausePretty :: ()-  => Options-  -> ShwiftyM Exp-mkClausePretty Options{..} = do-  value <- lift $ newName "value"-  matches <- lift $ do-    x <- match-      (conP 'Proxy [])-      (normalB-        $ pure-        $ AppE-            (AppE-              (VarE 'prettySwiftDataWith)-              (LitE (IntegerL (fromIntegral indent)))-            )-        $ ParensE-            (AppE-              (VarE 'toSwiftData)-              (VarE value)-            )-      )-      []-    pure [pure x]-  lift $ lamE [varP value] (caseE (varE value) matches)--consToSwift :: ()-  => Options-     -- ^ options about how to encode things-  -> Name-     -- ^ name of type-  -> [Type]-     -- ^ type variables-  -> DatatypeVariant-     -- ^ data type variant-  -> [Exp]-     -- ^ tags-  -> [ConstructorInfo]-     -- ^ constructors-  -> ShwiftyM Exp-consToSwift o@Options{..} parentName instTys variant ts = \case-  [] -> do-    value <- lift $ newName "value"-    matches <- liftCons (mkVoid parentName instTys ts)-    lift $ lamE [varP value] (caseE (varE value) matches)-  cons -> do-    -- TODO: use '_' instead of matching-    value <- lift $ newName "value"-    matches <- matchesWorker-    lift $ lamE [varP value] (caseE (varE value) matches)-    where-      -- bad name-      matchesWorker :: ShwiftyM [Q Match]-      matchesWorker = case cons of-        [con] -> liftCons $ do-          case variant of-            NewtypeInstance -> do-              if | typeAlias -> do-                     mkNewtypeInstanceAlias instTys con-                 | otherwise -> do-                     mkNewtypeInstance o instTys ts con-            Newtype -> do-              if | newtypeTag -> do-                     mkTypeTag o parentName instTys con-                 | typeAlias -> do-                     mkTypeAlias parentName instTys con-                 | otherwise -> do-                     mkProd o parentName instTys ts con-            _ -> do-              mkProd o parentName instTys ts con-        _ -> do-          let tyVars = prettyTyVars instTys-          let protos = map (ConE . mkName . show) dataProtocols-          let raw = rawValueE dataRawValue-          let tags = ListE ts-          cases <- forM cons (liftEither . mkCase o)-          pure $ (:[]) $ match-            (conP 'Proxy [])-            (normalB-               $ pure-               $ RecConE 'SwiftEnum-               $ [ (mkName "name", unqualName parentName)-                 , (mkName "tyVars", tyVars)-                 , (mkName "protocols", ListE protos)-                 , (mkName "cases", ListE cases)-                 , (mkName "rawValue", raw)-                 , (mkName "tags", tags)-                 ]-            )-            []--liftCons :: (Functor f, Applicative g) => f a -> f ([g a])-liftCons x = ((:[]) . pure) <$> x---- Create the case (String, [(Maybe String, Ty)])-mkCaseHelper :: Options -> Name -> [Exp] -> Exp-mkCaseHelper o name es = TupE [ caseName o name, ListE es ]--mkCase :: ()-  => Options-  -> ConstructorInfo-  -> Either ShwiftyError Exp-mkCase o = \case-  -- non-record-  ConstructorInfo-    { constructorVariant = NormalConstructor-    , constructorName = name-    , constructorFields = fields-    , ..-    } -> Right $ mkCaseHelper o name $ fields <&>-        (\typ -> TupE-          [ ConE 'Nothing-          , toSwiftEPoly typ-          ]-        )-  ConstructorInfo-    { constructorVariant = InfixConstructor-    , constructorName = name-    , ..-    } -> Left $ EncounteredInfixConstructor name-  -- records-  -- we turn names into labels-  ConstructorInfo-    { constructorVariant = RecordConstructor fieldNames-    , constructorName = name-    , constructorFields = fields-    , ..-    } ->-       let cases = zipWith (caseField o) fieldNames fields-       in Right $ mkCaseHelper o name cases--caseField :: Options -> Name -> Type -> Exp-caseField o n typ = TupE-  [ mkLabel o n-  , toSwiftEPoly typ-  ]--onHeadWith :: Bool -> String -> String-onHeadWith toLower = if toLower-  then onHead Char.toLower-  else id---- apply a function only to the head of a string-onHead :: (Char -> Char) -> String -> String-onHead f = \case { [] -> []; (x:xs) -> f x : xs }--mkLabel :: Options -> Name -> Exp-mkLabel Options{..} = AppE (ConE 'Just)-  . stringE-  . fieldLabelModifier-  . onHeadWith lowerFirstField-  . TS.unpack-  . last-  . TS.splitOn "."-  . TS.pack-  . show--mkNewtypeInstanceAlias :: ()-  => [Type]-     -- ^ type variables-  -> ConstructorInfo-     -- ^ constructor info-  -> ShwiftyM Match-mkNewtypeInstanceAlias (stripConT -> instTys) = \case-  ConstructorInfo-    { constructorFields = [field]-    , ..-    } -> do-      let tyVars = prettyTyVars instTys-      lift $ match-        (conP 'Proxy [])-        (normalB-          $ pure-          $ RecConE 'TypeAlias-          $ [ (mkName "name", unqualName constructorName)-            , (mkName "tyVars", tyVars)-            , (mkName "typ", toSwiftECxt field)-            ]-        )-        []-  _ -> throwError $ ExpectedNewtypeInstance--mkNewtypeInstance :: ()-  => Options-     -- ^ encoding options-  -> [Type]-     -- ^ type variables-  -> [Exp]-     -- ^ tags-  -> ConstructorInfo-     -- ^ constructor info-  -> ShwiftyM Match-mkNewtypeInstance o@Options{dataProtocols} (stripConT -> instTys) ts = \case-  ConstructorInfo-    { constructorVariant = RecordConstructor [fieldName]-    , constructorFields = [field]-    , ..-    } -> do-      let tyVars = prettyTyVars instTys-      let protos = ListE $ map (ConE . mkName . show) dataProtocols-      let fields = ListE $ [prettyField o fieldName field]-      let tags = ListE ts-      lift $ match-        (conP 'Proxy [])-        (normalB-          $ pure-          $ RecConE 'SwiftStruct-          $ [ (mkName "name", unqualName constructorName)-            , (mkName "tyVars", tyVars)-            , (mkName "protocols", protos)-            , (mkName "fields", fields)-            , (mkName "tags", tags)-            ]-        )-       []-  _ -> throwError ExpectedNewtypeInstance---- make a newtype into an empty enum--- with a tag-mkTypeTag :: ()-  => Options-     -- ^ options-  -> Name-     -- ^ type name-  -> [Type]-     -- ^ type variables-  -> ConstructorInfo-     -- ^ constructor info-  -> ShwiftyM Match-mkTypeTag Options{..} typName instTys = \case-  ConstructorInfo-    { constructorFields = [field]-    , ..-    } -> do-      let tyVars = prettyTyVars instTys-      let protos = map (ConE . mkName . show) dataProtocols-      let raw = rawValueE dataRawValue-      let parentName = nameStr typName ++ "Tag"-      let tag = RecConE 'Tag-            [ (mkName "name", unqualName typName)-            , (mkName "parent", stringE parentName)-            , (mkName "typ", toSwiftEPoly field)-            , (mkName "disambiguate", ConE 'False)-            ]-      lift $ match-        (conP 'Proxy [])-        (normalB-          $ pure-          $ RecConE 'SwiftEnum-          $ [ (mkName "name", stringE parentName)-            , (mkName "tyVars", tyVars)-            , (mkName "protocols", ListE protos)-            , (mkName "cases", ListE [])-            , (mkName "rawValue", raw)-            , (mkName "tags", ListE [tag])-            ]-        )-        []-  _ -> throwError $ NotANewtype typName---- make a newtype into a type alias-mkTypeAlias :: ()-  => Name-     -- ^ type name-  -> [Type]-     -- ^ type variables-  -> ConstructorInfo-     -- ^ constructor info-  -> ShwiftyM Match-mkTypeAlias typName instTys = \case-  ConstructorInfo-    { constructorFields = [field]-    , ..-    } -> do-      let tyVars = prettyTyVars instTys-      lift $ match-        (conP 'Proxy [])-        (normalB-          $ pure-          $ RecConE 'TypeAlias-          $ [ (mkName "name", unqualName typName)-            , (mkName "tyVars", tyVars)-            , (mkName "typ", toSwiftECxt field)-            ]-        )-        []-  _ -> throwError $ NotANewtype typName---- | Make a void type (empty enum)-mkVoid :: ()-  => Name-     -- ^ type name-  -> [Type]-     -- ^ type variables-  -> [Exp]-     -- ^ tags-  -> ShwiftyM Match-mkVoid typName instTys ts = do-  let tyVars = prettyTyVars instTys-  lift $ match-    (conP 'Proxy [])-    (normalB-      $ pure-      $ RecConE 'SwiftEnum-      $ [ (mkName "name", unqualName typName)-        , (mkName "tyVars", tyVars)-        , (mkName "protocols", ListE [])-        , (mkName "cases", ListE [])-        , (mkName "rawValue", ConE 'Nothing)-        , (mkName "tags", ListE ts)-        ]-    )-    []---- | Make a single-constructor product (struct)-mkProd :: ()-  => Options-     -- ^ encoding options-  -> Name-     -- ^ type name-  -> [Type]-     -- ^ type variables-  -> [Exp]-     -- ^ tags-  -> ConstructorInfo-     -- ^ constructor info-  -> ShwiftyM Match-mkProd o@Options{dataProtocols} typName instTys ts = \case-  -- single constructor, no fields-  ConstructorInfo-    { constructorVariant = NormalConstructor-    , constructorFields = []-    , ..-    } -> do-      let tyVars = prettyTyVars instTys-      let protos = map (ConE . mkName . show) dataProtocols-      let tags = ListE ts-      lift $ match-        (conP 'Proxy [])-        (normalB-          $ pure-          $ RecConE 'SwiftStruct-          $ [ (mkName "name", unqualName typName)-            , (mkName "tyVars", tyVars)-            , (mkName "protocols", ListE protos)-            , (mkName "fields", ListE [])-            , (mkName "tags", tags)-            ]-        )-        []-  -- single constructor, non-record (Normal)-  ConstructorInfo-    { constructorVariant = NormalConstructor-    , constructorName = name-    } -> do-      throwError $ SingleConNonRecord name-  -- single constructor, non-record (Infix)-  ConstructorInfo-    { constructorVariant = InfixConstructor-    , constructorName = name-    } -> do-      throwError $ EncounteredInfixConstructor name-  -- single constructor, record-  ConstructorInfo-    { constructorVariant = RecordConstructor fieldNames-    , ..-    } -> do-      let tyVars = prettyTyVars instTys-      let protos = map (ConE . mkName . show) dataProtocols-      let fields = ListE $ zipWith (prettyField o) fieldNames constructorFields-      let tags = ListE ts-      lift $ match-        (conP 'Proxy [])-        (normalB-          $ pure-          $ RecConE 'SwiftStruct-          $ [ (mkName "name", unqualName typName)-            , (mkName "tyVars", tyVars)-            , (mkName "protocols", ListE protos)-            , (mkName "fields", fields)-            , (mkName "tags", tags)-            ]-        )-        []---- turn a field name into a swift case name.--- examples:------   data Foo = A | B | C---   =>---   enum Foo {---     case a---     case b---     case c---   }------   data Bar a = MkBar1 a | MkBar2---   =>---   enum Bar<A> {---     case mkBar1(A)---     case mkBar2---   }-caseName :: Options -> Name -> Exp-caseName Options{..} = id-  . stringE-  . onHeadWith lowerFirstCase-  . constructorModifier-  . TS.unpack-  . last-  . TS.splitOn "."-  . TS.pack-  . show---- remove qualifiers from a name, turn into String-nameStr :: Name -> String-nameStr = TS.unpack . last . TS.splitOn "." . TS.pack . show---- remove qualifiers from a name, turn into Exp-unqualName :: Name -> Exp-unqualName = stringE . nameStr---- prettify a type variable as an Exp-prettyTyVar :: Name -> Exp-prettyTyVar = stringE . map Char.toUpper . TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show---- prettify a bunch of type variables as an Exp-prettyTyVars :: [Type] -> Exp-prettyTyVars = ListE . map prettyTyVar . getTyVars---- get the free type variables from many types-getTyVars :: [Type] -> [Name]-getTyVars = mapMaybe getFreeTyVar---- get the free type variables in a type-getFreeTyVar :: Type -> Maybe Name-getFreeTyVar = \case-  VarT name -> Just name-  SigT (VarT name) _kind -> Just name-  _ -> Nothing---- make a struct field pretty-prettyField :: Options -> Name -> Type -> Exp-prettyField Options{..} name ty = TupE-  [ (stringE (onHeadWith lowerFirstField (fieldLabelModifier (nameStr name))))-  , toSwiftEPoly ty-  ]---- build the instance head for a type-buildTypeInstance :: ()-  => Name-     -- ^ name of the type-  -> ShwiftyClass-     -- ^ which class instance head we are building-  -> [Type]-     -- ^ type variables-  -> [TyVarBndr]-     -- ^ the binders for our tyvars-  -> DatatypeVariant-     -- ^ variant (datatype, newtype, data family, newtype family)-  -> ShwiftyM Type-buildTypeInstance tyConName cls varTysOrig tyVarBndrs variant = do-  -- Make sure to expand through type/kind synonyms!-  -- Otherwise, the eta-reduction check might get-  -- tripped up over type variables in a synonym-  -- that are actually dropped.-  -- (See GHC Trac #11416 for a scenario where this-  -- actually happened)-  varTysExp <- lift $ mapM resolveTypeSynonyms varTysOrig--  -- get the kind status of all of our types.-  -- we must realise them all to *.-  starKindStats :: [KindStatus] <- foldlM-    (\stats k -> case canRealiseKindStar k of-      NotKindStar -> do-        throwError $ KindVariableCannotBeRealised tyConName k-      s -> pure (stats ++ [s])-    ) [] varTysExp--  let -- get the names of our kind vars-      kindVarNames :: [Name]-      kindVarNames = flip mapMaybe starKindStats-        (\case-            IsKindVar n -> Just n-            _ -> Nothing-        )--  let-      -- instantiate polykinded things to star.-      varTysExpSubst :: [Type]-      varTysExpSubst = map (substNamesWithKindStar kindVarNames) varTysExp--      -- the constraints needed on type variables-      preds :: [Maybe Pred]-      preds = map (deriveConstraint cls) varTysExpSubst--      -- We now sub all of the specialised-to-* kind-      -- variable names with *, but in the original types,-      -- not the synonym-expanded types. The reason we-      -- do this is superficial: we want the derived-      -- instance to resemble the datatype written in-      -- source code as closely as possible. For example,-      ---      --   data family Fam a-      --   newtype instance Fam String = Fam String-      ---      -- We'd want to generate the instance:-      ---      --   instance C (Fam String)-      ---      -- Not:-      ---      --   instance C (Fam [Char])-      varTysOrigSubst :: [Type]-      varTysOrigSubst =-        map (substNamesWithKindStar kindVarNames) $ varTysOrig--      -- if we are working on a data family-      -- or newtype family, we need to peel off-      -- the kinds. See Note [Kind signatures in-      -- derived instances]-      varTysOrigSubst' :: [Type]-      varTysOrigSubst' = if isDataFamily variant-        then varTysOrigSubst-        else map unSigT varTysOrigSubst--      -- the constraints needed on type variables-      -- makes up the constraint part of the-      -- instance head.-      instanceCxt :: Cxt-      instanceCxt = catMaybes preds--      -- the class and type in the instance head.-      instanceType :: Type-      instanceType = AppT (ConT (shwiftyClassName cls))-        $ applyTyCon tyConName varTysOrigSubst'--  -- forall <tys>. ctx tys => Cls ty-  lift $ forallT-    (map tyVarBndrNoSig tyVarBndrs)-    (pure instanceCxt)-    (pure instanceType)---- the class we're generating an instance of-data ShwiftyClass-  = ClassSwift -- ToSwift-  | ClassSwiftData -- ToSwiftData---- turn a 'ShwiftyClass' into a 'Name'-shwiftyClassName :: ShwiftyClass -> Name-shwiftyClassName = \case-  ClassSwift -> ''ToSwift-  ClassSwiftData -> ''ToSwiftData---- derive the constraint needed on a type variable--- in order to build the instance head for a class.-deriveConstraint :: ()-  => ShwiftyClass-     -- ^ class name-  -> Type-     -- ^ type-  -> Maybe Pred-     -- ^ constraint on type-deriveConstraint c@ClassSwift typ-  | not (isTyVar typ) = Nothing-  | hasKindStar typ = Just (applyCon (shwiftyClassName c) tName)-  | otherwise = Nothing-  where-    tName :: Name-    tName = varTToName typ-    varTToName = \case-      VarT n -> n-      SigT t _ -> varTToName t-      _ -> error "Shwifty.varTToName: encountered non-type variable"-deriveConstraint ClassSwiftData _ = Nothing---- apply a type constructor to a type variable.--- this can be useful for letting the kind--- inference engine doing work for you. see--- 'toSwiftECxt' for an example of this.-applyCon :: Name -> Name -> Pred-applyCon con t = AppT (ConT con) (VarT t)---- peel off a kind signature from a Type-unSigT :: Type -> Type-unSigT = \case-  SigT t _ -> t-  t -> t---- is the type a type variable?-isTyVar :: Type -> Bool-isTyVar = \case-  VarT _ -> True-  SigT t _ -> isTyVar t-  _ -> False---- does the type have kind *?-hasKindStar :: Type -> Bool-hasKindStar = \case-  VarT _ -> True-  SigT _ StarT -> True-  _ -> False---- perform the substitution of type variables--- who have kinds which can be realised to *,--- with the same type variable where its kind--- has been turned into *-substNamesWithKindStar :: [Name] -> Type -> Type-substNamesWithKindStar ns t = foldr' (`substNameWithKind` starK) t ns-  where-    substNameWithKind :: Name -> Kind -> Type -> Type-    substNameWithKind n k = applySubstitution (M.singleton n k)---- | The status of a kind variable w.r.t. its---   ability to be realised into *.-data KindStatus-  = KindStar-    -- ^ kind * (or some k which can be realised to *)-  | NotKindStar-    -- ^ any other kind-  | IsKindVar Name-    -- ^ is actually a kind variable-  | IsCon Name-    -- ^ is a constructor - this will typically-    --   happen in a data family instance, because-    --   we often have to construct a-    --   FlexibleInstance. our old check for-    --   canRealiseKindStar didn't check for-    --   `ConT` - where this would happen.-    ---    --   TODO: Now i think this might need to be-    --   removed in favour of something smarter.---- can we realise the type's kind to *?-canRealiseKindStar :: Type -> KindStatus-canRealiseKindStar = \case-  VarT{} -> KindStar-  SigT _ StarT -> KindStar-  SigT _ (VarT n) -> IsKindVar n-  ConT n -> IsCon n-  _ -> NotKindStar---- discard the kind signature from a TyVarBndr.-tyVarBndrNoSig :: TyVarBndr -> TyVarBndr-tyVarBndrNoSig = \case-  PlainTV n -> PlainTV n-  KindedTV n _k -> PlainTV n---- fully applies a type constructor to its--- type variables-applyTyCon :: Name -> [Type] -> Type-applyTyCon = foldl' AppT . ConT---- Turn a String into an Exp string literal-stringE :: String -> Exp-stringE = LitE . StringL---- convert a type into a 'Ty'.--- we respect constraints here - e.g. in--- `(Swift a, Swift b) => Swift (Foo a b)`,--- we don't just fill in holes like in--- `toSwiftEPoly`, we actually turn `a`--- and `b` into `Ty`s directly. Consequently,--- the implementation is much simpler - just--- an application.------ Note the use of unSigT - see Note--- [Kind signatures in derived instances].-toSwiftECxt :: Type -> Exp-toSwiftECxt (unSigT -> typ) = AppE-  (VarE 'toSwift)-  (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) typ))---- convert a type into a 'Ty'.--- polymorphic types do not require a 'ToSwift'--- instance, since we fill them in with 'SingSymbol'.------ We do this by stretching out a type along its--- spine, completely. we then fill in any polymorphic--- variables with 'SingSymbol', reflecting the type--- Name to a Symbol. then we compress the spine to--- get the original type. the 'ToSwift' instance for--- 'SingSymbol' gets us where we need to go.------ Note that @compress . decompress@ is not--- actually equivalent to the identity function on--- Type because of ForallT, where we discard some--- context. However, for any types we care about,--- there shouldn't be a ForallT, so this *should*--- be fine.-toSwiftEPoly :: Type -> Exp-toSwiftEPoly = \case-  -- we don't need to special case VarT and SigT-  VarT n-    -> AppE (ConE 'Poly) (prettyTyVar n)-  SigT (VarT n) _-    -> AppE (ConE 'Poly) (prettyTyVar n)-  typ ->-    let decompressed = decompress typ-        prettyName = map Char.toUpper . TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show-        filledInHoles = decompressed <&>-          (\case-            VarT name -> AppT-              (ConT ''Shwifty.SingSymbol)-              (LitT (StrTyLit (prettyName name)))-            SigT (VarT name) _ -> AppT-              (ConT ''Shwifty.SingSymbol)-              (LitT (StrTyLit (prettyName name)))-            t -> t-          )-        typ' = compress filledInHoles-     in AppE-      (VarE 'toSwift)-      (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) typ'))--decompress :: Type -> Rose Type-decompress typ = case unapplyTy typ of-  tyCon :| tyArgs -> Rose tyCon (decompress <$> tyArgs)--compress :: Rose Type -> Type-compress (Rose typ []) = typ-compress (Rose t ts) = foldl' AppT t (compress <$> ts)--unapplyTy :: Type -> NonEmpty Type-unapplyTy = NE.reverse . go-  where-    go = \case-      AppT t1 t2 -> t2 <| go t1-      SigT t _ -> go t-      ForallT _ _ t -> go t-      t -> t :| []---- | Types can be stretched out into a Rose tree.---   decompress will stretch a type out completely,---   in such a way that it cannot be stretched out---   further. compress will reconstruct a type from---   its stretched form.------   Also note that this is equivalent to---   Cofree NonEmpty Type.------   Examples:------   Maybe a---   =>---   AppT (ConT Maybe) (VarT a)---------   Either a b---   =>---   AppT (AppT (ConT Either) (VarT a)) (VarT b)---   =>---   Rose (ConT Either)---     [ Rose (VarT a)---         [---         ]---     , Rose (VarT b)---         [---         ]---     ]---------   Either (Maybe a) (Maybe b)---   =>---   AppT (AppT (ConT Either) (AppT (ConT Maybe) (VarT a))) (AppT (ConT Maybe) (VarT b))---   =>---   Rose (ConT Either)---     [ Rose (ConT Maybe)---         [ Rose (VarT a)---             [---             ]---         ]---     , Rose (ConT Maybe)---         [ Rose (VarT b)---             [---             ]---         ]---     ]-data Rose a = Rose a [Rose a]-  deriving stock (Eq, Show)-  deriving stock (Functor,Foldable,Traversable)--{--Note [Kind signatures in derived instances]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--It is possible to put explicit kind signatures into the derived instances, e.g.,--  instance C a => C (Data (f :: * -> *)) where ...--But it is preferable to avoid this if possible. If we come up with an incorrect-kind signature (which is entirely possible, since Template Haskell doesn't always-have the best track record with reifying kind signatures), then GHC will flat-out-reject the instance, which is quite unfortunate.--Plain old datatypes have the advantage that you can avoid using any kind signatures-at all in their instances. This is because a datatype declaration uses all type-variables, so the types that we use in a derived instance uniquely determine their-kinds. As long as we plug in the right types, the kind inferencer can do the rest-of the work. For this reason, we use unSigT to remove all kind signatures before-splicing in the instance context and head.--Data family instances are trickier, since a data family can have two instances that-are distinguished by kind alone, e.g.,--  data family Fam (a :: k)-  data instance Fam (a :: * -> *)-  data instance Fam (a :: *)--If we dropped the kind signatures for C (Fam a), then GHC will have no way of-knowing which instance we are talking about. To avoid this scenario, we always-include explicit kind signatures in data family instances. There is a chance that-the inferred kind signatures will be incorrect, in which case we have to write the instance manually.--}---- are we working on a data family--- or newtype family?-isDataFamily :: DatatypeVariant -> Bool-isDataFamily = \case-  NewtypeInstance -> True-  DataInstance -> True-  _ -> False--stripConT :: [Type] -> [Type]-stripConT = mapMaybe noConT-  where-    noConT = \case-      ConT {} -> Nothing-      t -> Just t+  , DataKinds+  , DeriveFoldable+  , DeriveFunctor+  , DeriveGeneric+  , DeriveTraversable+  , DerivingStrategies+  , FlexibleInstances+  , LambdaCase+  , MultiWayIf+  , NamedFieldPuns+  , OverloadedStrings+  , RecordWildCards+  , ScopedTypeVariables+  , TemplateHaskell+  , TypeApplications+  , TypeFamilies+  , TypeOperators+  , UndecidableInstances+  , ViewPatterns+#-}++{-# options_ghc+  -Wall+  -fno-warn-duplicate-exports+#-}++-- | The Shwifty library allows generation of+--   Swift types (structs and enums) from Haskell+--   ADTs, using Template Haskell. The main+--   entry point to the library should be the+--   documentation and examples of 'getShwifty'.+--   See also 'getShwiftyWith'+--   and 'getShwiftyWithTags'.+--+--   This library is in alpha and there are a number+--   of known bugs which shouldn't affect most users.+--   See the issue tracker to see what those are.+--+--   There are probably many bugs/some weird behaviour+--   when it comes to data families. Please report+--   any issues on the issue tracker.+module Shwifty+  ( -- * Classes for conversion+    ToSwift(..)+  , ToSwiftData(..)++    -- * Generating instances+  , getShwifty+  , getShwiftyWith+  , getShwiftyWithTags++  , getShwiftyCodec+  , getShwiftyCodecTags++    -- * Types+  , Ty(..)+  , SwiftData(..)+  , Protocol(..)++    -- * Options for encoding types+    -- ** Option type+  , Options+    -- ** Actual Options+  , fieldLabelModifier+  , constructorModifier+  , optionalExpand+  , generateToSwift+  , generateToSwiftData+  , dataProtocols+  , dataRawValue+  , typeAlias+  , newtypeTag+  , lowerFirstCase+  , lowerFirstField+  , omitFields+  , omitCases+  , makeBase+    -- ** Default 'Options'+  , defaultOptions++    -- ** Codec options+  , Codec(..)+  , ModifyOptions(..)+  , AsIs+  , type (&)+  , Label(..)+  , Drop+  , DontGenerate+  , Implement+  , RawValue+  , CanBeRawValue+  , TypeAlias+  , NewtypeTag+  , DontLowercase+  , OmitField+  , OmitCase+  , MakeBase++    -- * Pretty-printing+    -- ** Functions+  , prettyTy+  , prettySwiftData+    -- ** Re-exports+  , X+  ) where++import Control.Monad.Except+import Data.Foldable (foldlM,foldr',foldl')+import Data.Functor ((<&>))+import Data.List.NonEmpty ((<|), NonEmpty(..))+import Data.Maybe (mapMaybe, catMaybes)+import Data.Proxy (Proxy(..))+import Data.Void (Void)+import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)+import Language.Haskell.TH hiding (stringE)+import Language.Haskell.TH.Datatype+import Prelude hiding (Enum(..))+import qualified Data.Char as Char+import qualified Data.List as L+import qualified Data.List.NonEmpty as NE+import qualified Data.Map as M+import qualified Data.Text as TS++import Shwifty.Class+import Shwifty.Codec+import Shwifty.Pretty+import Shwifty.Types++-- | The default 'Options'.+--+-- @+-- defaultOptions :: Options+-- defaultOptions = Options+--   { typeConstructorModifier = id+--   , fieldLabelModifier = id+--   , constructorModifier = id+--   , optionalExpand= False+--   , generateToSwift = True+--   , generateToSwiftData = True+--   , dataProtocols = []+--   , dataRawValue = Nothing+--   , typeAlias = False+--   , newtypeTag = False+--   , lowerFirstField = True+--   , lowerFirstCase = True+--   , omitFields = []+--   , omitCases = []+--   , makeBase = (False, Nothing, [])+--   }+-- @+--+defaultOptions :: Options+defaultOptions = Options+  { typeConstructorModifier = id+  , fieldLabelModifier = id+  , constructorModifier = id+  , optionalExpand = False+  , generateToSwift = True+  , generateToSwiftData = True+  , dataProtocols = []+  , dataRawValue = Nothing+  , typeAlias = False+  , newtypeTag = False+  , lowerFirstField = True+  , lowerFirstCase = True+  , omitFields = []+  , omitCases = []+  , makeBase = (False, Nothing, [])+  }++-- Used internally to reflect polymorphic type+-- variables into TH, then reify them into 'Poly'.+--+-- See the Rose tree section below+data SingSymbol (x :: Symbol)+instance KnownSymbol x => ToSwift (SingSymbol x) where+  toSwift _ = Poly (symbolVal (Proxy @x))++-- | A filler type to be used when pretty-printing.+--   The codegen used by shwifty doesn't look at+--   at what a type's type variables are instantiated+--   to, but rather at the type's top-level+--   definition. However,+--   to make GHC happy, you will have to fill in type+--   variables with unused types. To get around this,+--   you could also use something like+--   `-XQuantifiedConstraints`, or existential types,+--   but we leave that to the user to handle.+type X = Void++ensureEnabled :: Extension -> ShwiftyM ()+ensureEnabled ext = do+  enabled <- lift $ isExtEnabled ext+  unless enabled $ do+    throwError $ ExtensionNotEnabled ext++-- | Generate 'ToSwiftData' and 'ToSwift' instances+--   for your type. 'ToSwift' instances are typically+--   used to build cases or fields, whereas+--   'ToSwiftData' instances are for building structs+--   and enums. Click the @Examples@ button to see+--   examples of what Swift gets generated in+--   different scenarios. To get access to the+--   generated code, you will have to use one of+--   the pretty-printing functions provided.+--+-- === __Examples__+--+-- > -- A simple sum type+-- > data SumType = Sum1 | Sum2 | Sum3+-- > getShwifty ''SumType+--+-- @+-- enum SumType {+--     case sum1+--     case sum2+--     case sum3+-- }+-- @+--+-- > -- A simple product type+-- > data ProductType = ProductType { x :: Int, y :: Int }+-- > getShwifty ''ProductType+--+-- @+-- struct ProductType {+--     let x: Int+--     let y: Int+-- }+-- @+--+-- > -- A sum type with type variables+-- > data SumType a b = SumL a | SumR b+-- > getShwifty ''SumType+--+-- @+-- enum SumType\<A, B\> {+--     case sumL(A)+--     case sumR(B)+-- }+-- @+--+-- > -- A product type with type variables+-- > data ProductType a b = ProductType { aField :: a, bField :: b }+-- > getShwifty ''ProductType+--+-- @+-- struct ProductType\<A, B\> {+--     let aField: A+--     let bField: B+-- }+-- @+--+-- > -- A newtype+-- > newtype Newtype a = Newtype { getNewtype :: a }+-- > getShwifty ''Newtype+--+-- @+-- struct Newtype\<A\> {+--     let getNewtype: A+-- }+-- @+--+-- > -- A type with a function field+-- > newtype Endo a = Endo { appEndo :: a -> a }+-- > getShwifty ''Endo+--+-- @+-- struct Endo\<A\> {+--     let appEndo: ((A) -> A)+-- }+-- @+--+-- > -- A type with a kookier function field+-- > newtype Fun a = Fun { fun :: Int -> Char -> Bool -> String -> Maybe a }+-- > getShwifty ''Fun+--+-- @+-- struct Fun<A> {+--     let fun: ((Int, Char, Bool, String) -> A?)+-- }+-- @+--+-- > -- A weird type with nested fields. Also note the Result's types being flipped from that of the Either.+-- > data YouveGotProblems a b = YouveGotProblems { field1 :: Maybe (Maybe (Maybe a)), field2 :: Either (Maybe a) (Maybe b) }+-- > getShwifty ''YouveGotProblems+--+-- @+-- struct YouveGotProblems\<A, B\> {+--     let field1: Option\<Option\<Option\<A\>\>\>+--     let field2: Result\<Option\<B\>,Option\<A\>\>+-- }+-- @+--+-- > -- A type with polykinded type variables+-- > -- Also note that there is no newline because+-- > -- of the absence of fields+-- > data PolyKinded (a :: k) = PolyKinded+-- > getShwifty ''PolyKinded+--+-- @+-- struct PolyKinded\<A\> { }+-- @+--+-- > -- A sum type where constructors might be records+-- > data SumType a b (c :: k) = Sum1 Int a (Maybe b) | Sum2 b | Sum3 { x :: Int, y :: Int }+-- > getShwifty ''SumType+--+-- @+-- enum SumType\<A, B, C\> {+--   case field1(Int, A, Optional\<B\>)+--   case field2(B)+--   case field3(_ x: Int, _ y: Int)+-- }+-- @+--+-- > -- A type containing another type with instance generated by 'getShwifty'+-- > newtype MyFirstType a = MyFirstType { getMyFirstType :: a }+-- > getShwifty ''MyFirstType+-- >+-- > data Contains a = Contains { x :: MyFirstType Int, y :: MyFirstType a }+-- > getShwifty ''Contains+--+-- @+-- struct MyFirstType\<A\> {+--   let getMyFirstType: A+-- }+--+-- struct Contains\<A\> {+--   let x: MyFirstType\<Int\>+--   let y: MyFirstType\<A\>+-- }+-- @+getShwifty :: Name -> Q [Dec]+getShwifty = getShwiftyWith defaultOptions++-- | Like 'getShwifty', but lets you supply+--   your own 'Options'. Click the examples+--   for some clarification of what you can do.+--+-- === __Examples__+--+-- > data PrefixedFields = MkPrefixedFields { prefixedFieldsX :: Int, prefixedFieldsY :: Int }+-- > $(getShwiftyWith (defaultOptions { fieldLabelModifier = drop (length "PrefixedFields") }) ''PrefixedFields)+--+-- @+-- struct PrefixedFields {+--     let x: Int+--     let y: Int+-- }+-- @+--+-- > data PrefixedCons = MkPrefixedConsLeft | MkPrefixedConsRight+-- > $(getShwiftyWith (defaultOptions { constructorModifier = drop (length "MkPrefixedCons"), dataProtocols = [Codable] }) ''PrefixedCons)+--+-- @+-- enum PrefixedCons: Codable {+--     case left+--     case right+-- }+-- @+getShwiftyWith :: Options -> Name -> Q [Dec]+getShwiftyWith o n = getShwiftyWithTags o [] n++data NewtypeInfo = NewtypeInfo+  { newtypeName :: Name+    -- ^ Type constructor+  , newtypeVars :: [TyVarBndr]+    -- ^ Type parameters+  , newtypeInstTypes :: [Type]+    -- ^ Argument types+  , newtypeVariant :: DatatypeVariant+    -- ^ Whether or not the type is a+    --   newtype or newtype instance+  , newtypeCon :: ConstructorInfo+  }++-- | Reify a newtype.+reifyNewtype :: Name -> ShwiftyM NewtypeInfo+reifyNewtype n = do+  DatatypeInfo{..} <- lift $ reifyDatatype n+  case (datatypeCons, datatypeVariant) of+    ([c], Newtype) -> do+      pure NewtypeInfo {+        newtypeName = datatypeName+      , newtypeVars = datatypeVars+      , newtypeInstTypes = datatypeInstTypes+      , newtypeVariant = datatypeVariant+      , newtypeCon = c+      }+    ([c], NewtypeInstance) -> do+      pure NewtypeInfo {+        newtypeName = datatypeName+      , newtypeVars = datatypeVars+      , newtypeInstTypes = datatypeInstTypes+      , newtypeVariant = datatypeVariant+      , newtypeCon = c+      }+    _ -> do+      throwError $ NotANewtype n++-- Generate the tags for a type.+-- Also generate the ToSwift instance for each tag+-- type. We can't just expect people to do this+-- with a separate 'getShwifty' call, because+-- they will generate the wrong code, since other+-- types with a tag that isn't theirs won't generate+-- well-scoped fields.+getTags :: ()+  => Name+     -- ^ name of parent type+  -> [Name]+     -- ^ tags+  -> ShwiftyM ([Exp], [Dec])+getTags parentName ts = do+  let b = length ts > 1+  disambiguate <- lift $ [||b||]+  tags <- foldlM+    (\(es,ds) n -> do++      NewtypeInfo{..} <- reifyNewtype n+      let ConstructorInfo{..} = newtypeCon++      -- generate the tag+      let tyconName = case newtypeVariant of+            NewtypeInstance -> constructorName+            _ -> newtypeName+      typ <- case constructorFields of+        [ty] -> pure ty+        _ -> throwError $ NotANewtype newtypeName+      let tag = RecConE 'Tag+            [ (mkName "tagName", unqualName tyconName)+            , (mkName "tagParent", unqualName parentName)+            , (mkName "tagTyp", toSwiftEPoly typ)+            , (mkName "tagDisambiguate", unType disambiguate)+            ]++      -- generate the instance+      !instHeadTy+        <- buildTypeInstance newtypeName ClassSwift newtypeInstTypes newtypeVars newtypeVariant+      -- we do not want to strip here+      clauseTy <- tagToSwift tyconName typ parentName+      swiftTyInst <- lift $ instanceD+        (pure [])+        (pure instHeadTy)+        [ funD 'toSwift+          [ clause [] (normalB (pure clauseTy)) []+          ]+        ]++      pure $ (es ++ [tag], ds ++ [swiftTyInst])+    ) ([], []) ts+  pure tags++getToSwift :: ()+  => Options+     -- ^ options+  -> Name+     -- ^ type name+  -> [Type]+     -- ^ type variables+  -> [TyVarBndr]+     -- ^ type binders+  -> DatatypeVariant+     -- ^ type variant+  -> [ConstructorInfo]+     -- ^ constructors+  -> ShwiftyM [Dec]+getToSwift Options{..} parentName instTys tyVarBndrs variant cons = if generateToSwift+  then do+    instHead <- buildTypeInstance parentName ClassSwift instTys tyVarBndrs variant+    clauseTy <- case variant of+      NewtypeInstance -> case cons of+        [ConstructorInfo{..}] -> do+          newtypToSwift constructorName instTys+        _ -> do+          throwError ExpectedNewtypeInstance+      _ -> do+        typToSwift newtypeTag parentName instTys+    inst <- lift $ instanceD+      (pure [])+      (pure instHead)+      [ funD 'toSwift+        [ clause [] (normalB (pure clauseTy)) []+        ]+      ]+    pure [inst]+  else do+    pure []++getToSwiftData :: ()+  => Options+     -- ^ options+  -> Name+     -- ^ type name+  -> [Type]+     -- ^ type variables+  -> [TyVarBndr]+     -- ^ type binders+  -> DatatypeVariant+     -- ^ type variant+  -> [Exp]+     -- ^ tags+  -> [ConstructorInfo]+     -- ^ constructors+  -> ShwiftyM [Dec]+getToSwiftData o@Options{..} parentName instTys tyVarBndrs variant tags cons = if generateToSwiftData+  then do+    instHead <- buildTypeInstance parentName ClassSwiftData instTys tyVarBndrs variant+    clauseData <- consToSwift o parentName instTys variant tags makeBase cons+    inst <- lift $ instanceD+      (pure [])+      (pure instHead)+        [ funD 'toSwiftData+          [ clause [] (normalB (pure clauseData)) []+          ]+        ]+    pure [inst]+  else do+    pure []++-- | Like 'getShwiftyWith', but lets you supply+--   tags. Tags are type-safe typealiases that+--   are akin to newtypes in Haskell. The+--   introduction of a struct around something+--   which is, say, a UUID in Swift means that+--   the default Codable instance will not work+--   correctly. So we introduce a tag(s). See the+--   examples to see how this looks. Also, see+--   https://github.com/pointfreeco/swift-tagged,+--   the library which these tags use. The library+--   is not included in any generated code.+--+-- === __Examples__+--+-- > -- Example of using the swift-tagged library:+-- > -- A type containing a database key+-- > data User = User { id :: UserId, name :: Text }+-- > -- the user key+-- > newtype UserId = UserId UUID+-- > $(getShwiftyWithTags defaultOptions [ ''UserId ] ''User)+-- > -- A type that also contains the UserId+-- > data UserDetails = UserDetails { id :: UserId, lastName :: Text }+-- > getShwifty ''UserDetails+--+-- @+-- struct User {+--   let id: UserId+--   let name: String+--+--   typealias UserId = Tagged\<User,UUID\>+-- }+--+-- struct UserDetails {+--   let id: User.UserId+--   let lastName: String+-- }+-- @+--+-- > -- Example type with multiple tags+-- > newtype Name = MkName String+-- > newtype Email = MkEmail String+-- > data Person = Person { name :: Name, email :: Email }+-- > $(getShwiftyWithTags defaultOptions [ ''Name, ''Email ] ''Person)+--+-- @+-- struct Person {+--     let name: Name+--     let email: Email+--+--     enum NameTag {}+--     typealias Name = Tagged\<NameTag, String\>+--+--     enum EmailTag {}+--     typealias Email = Tagged\<EmailTag, String\>+-- }+-- @+getShwiftyWithTags :: ()+  => Options+  -> [Name]+  -> Name+  -> Q [Dec]+getShwiftyWithTags o@Options{..} ts name = do+  r <- runExceptT $ do+    ensureEnabled ScopedTypeVariables+    ensureEnabled DataKinds+    DatatypeInfo+      { datatypeName = parentName+      , datatypeVars = tyVarBndrs+      , datatypeInstTypes = instTys+      , datatypeVariant = variant+      , datatypeCons = cons+      } <- lift $ reifyDatatype name+    noExistentials cons++    -- get tags/ToSwift instances for tags+    (tags, extraDecs) <- getTags parentName ts++    swiftDataInst <- getToSwiftData o parentName instTys tyVarBndrs variant tags cons++    swiftTyInst <- getToSwift o parentName instTys tyVarBndrs variant cons+    pure $ swiftDataInst ++ swiftTyInst ++ extraDecs+  case r of+    Left e -> fail $ prettyShwiftyError e+    Right d -> pure d++noExistentials :: [ConstructorInfo] -> ShwiftyM ()+noExistentials cs = forM_ cs $ \ConstructorInfo{..} ->+  case (constructorName, constructorVars) of+    (_, []) -> do+      pure ()+    (cn, cvs) -> do+      throwError $ ExistentialTypes cn cvs++data ShwiftyError+  = SingleConNonRecord+      { _conName :: Name+      }+  | EncounteredInfixConstructor+      { _conName :: Name+      }+  | KindVariableCannotBeRealised+      { _typName :: Name+      , _kind :: Kind+      }+  | ExtensionNotEnabled+      { _ext :: Extension+      }+  | ExistentialTypes+      { _conName :: Name+      , _types :: [TyVarBndr]+      }+  | ExpectedNewtypeInstance+  | NotANewtype+      { _typName :: Name+      }++prettyShwiftyError :: ShwiftyError -> String+prettyShwiftyError = \case+  SingleConNonRecord (nameStr -> n) -> mempty+    ++ n+    ++ ": Cannot get shwifty with single-constructor "+    ++ "non-record types. This is due to a "+    ++ "restriction of Swift that prohibits structs "+    ++ "from not having named fields. Try turning "+    ++ n ++ " into a record!"+  EncounteredInfixConstructor (nameStr -> n) -> mempty+    ++ n+    ++ ": Cannot get shwifty with infix constructors. "+    ++ "Swift doesn't support them. Try changing "+    ++ n ++ " into a prefix constructor!"+  KindVariableCannotBeRealised (nameStr -> n) typ ->+    let (typStr, kindStr) = prettyKindVar typ+    in mempty+      ++ n+      ++ ": Encountered a type variable ("+      ++ typStr+      ++ ") with a kind ("+      ++ kindStr+      ++ ") that can't "+      ++ "get shwifty! Shwifty needs to be able "+      ++ "to realise your kind variables to `*`, "+      ++ "since that's all that makes sense in "+      ++ "Swift. The only kinds that can happen with "+      ++ "are `*` and the free-est kind, `k`."+  ExtensionNotEnabled ext -> mempty+    ++ show ext+    ++ " is not enabled. Shwifty needs it to work!"+  -- TODO: make this not print out implicit kinds.+  -- e.g. for `data Ex = forall x. Ex x`, there are+  -- no implicit `TyVarBndr`s, but for+  -- `data Ex = forall x y z. Ex x`, there are two:+  -- the kinds inferred by `y` and `z` are both `k`.+  -- We print these out - this could be confusing to+  -- the end user. I'm not immediately certain how to+  -- be rid of them.+  ExistentialTypes (nameStr -> n) tys -> mempty+    ++ n+    ++ " has existential type variables ("+    ++ L.intercalate ", " (map prettyTyVarBndrStr tys)+    ++ ")! Shwifty doesn't support these."+  ExpectedNewtypeInstance -> mempty+    ++ "Expected a newtype instance. This is an "+    ++ "internal logic error. Please report it as a "+    ++ "bug."+  NotANewtype (nameStr -> n) -> mempty+    ++ n+    ++ " is not a newtype. This is an internal logic "+    ++ "error. Please report it as a bug."++prettyTyVarBndrStr :: TyVarBndr -> String+prettyTyVarBndrStr = \case+  PlainTV n -> go n+  KindedTV n _ -> go n+  where+    go = TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show++-- prettify the type and kind.+prettyKindVar :: Type -> (String, String)+prettyKindVar = \case+  SigT typ k -> (go typ, go k)+  VarT n -> (nameStr n, "*")+  typ -> error $ "Shwifty.prettyKindVar: used on a type without a kind signature. Type was: " ++ show typ+  where+    go = TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show . ppr++type ShwiftyM = ExceptT ShwiftyError Q++tagToSwift :: ()+  => Name+     -- ^ name of the type constructor+  -> Type+     -- ^ type variables+  -> Name+     -- ^ parent name+  -> ShwiftyM Exp+tagToSwift tyconName typ parentName = do+  -- TODO: use '_' instead of matching+  value <- lift $ newName "value"+  ourMatch <- matchProxy+    $ tagExp tyconName parentName typ False+  let matches = [pure ourMatch]+  lift $ lamE [varP value] (caseE (varE value) matches)+newtypToSwift :: ()+  => Name+     -- ^ name of the constructor+  -> [Type]+     -- ^ type variables+  -> ShwiftyM Exp+newtypToSwift conName (stripConT -> instTys) = do+  typToSwift False conName instTys++typToSwift :: ()+  => Bool+     -- ^ is this a newtype tag?+  -> Name+     -- ^ name of the type+  -> [Type]+     -- ^ type variables+  -> ShwiftyM Exp+typToSwift newtypeTag parentName instTys = do+  -- TODO: use '_' instead of matching+  value <- lift $ newName "value"+  let tyVars = map toSwiftECxt instTys+  let name =+        let parentStr = nameStr parentName+            accessedName = if newtypeTag+              then parentStr ++ "Tag." ++ parentStr+              else parentStr+        in stringE accessedName+  ourMatch <- matchProxy+    $ RecConE 'Concrete+    $ [ (mkName "concreteName", name)+      , (mkName "concreteTyVars", ListE tyVars)+      ]+  let matches = [pure ourMatch]+  lift $ lamE [varP value] (caseE (varE value) matches)++rawValueE :: Maybe Ty -> Exp+rawValueE = \case+  Nothing -> ConE 'Nothing+  Just ty -> AppE (ConE 'Just) (ParensE (tyE ty))++-- god this is annoying. write a cleaner+-- version of this+tyE :: Ty -> Exp+tyE = \case+  Unit -> ConE 'Unit+  Bool -> ConE 'Bool+  Character -> ConE 'Character+  Str -> ConE 'Str+  I -> ConE 'I+  I8 -> ConE 'I8+  I16 -> ConE 'I16+  I32 -> ConE 'I32+  I64 -> ConE 'I64+  U -> ConE 'U+  U8 -> ConE 'U8+  U16 -> ConE 'U16+  U32 -> ConE 'U32+  U64 -> ConE 'U64+  F32 -> ConE 'F32+  F64 -> ConE 'F64+  Decimal -> ConE 'Decimal+  BigSInt32 -> ConE 'BigSInt32+  BigSInt64 -> ConE 'BigSInt64+  Poly s -> AppE (ConE 'Poly) (stringE s)+  Concrete tyCon tyVars -> AppE (AppE (ConE 'Concrete) (stringE tyCon)) (ListE (map tyE tyVars))+  Tuple2 e1 e2 -> AppE (AppE (ConE 'Tuple2) (tyE e1)) (tyE e2)+  Tuple3 e1 e2 e3 -> AppE (AppE (AppE (ConE 'Tuple3) (tyE e1)) (tyE e2)) (tyE e3)+  Optional e -> AppE (ConE 'Optional) (tyE e)+  Result e1 e2 -> AppE (AppE (ConE 'Result) (tyE e1)) (tyE e2)+  Set e -> AppE (ConE 'Set) (tyE e)+  Dictionary e1 e2 -> AppE (AppE (ConE 'Dictionary) (tyE e1)) (tyE e2)+  App e1 e2 -> AppE (AppE (ConE 'App) (tyE e1)) (tyE e2)+  Array e -> AppE (ConE 'Array) (tyE e)+  Tag{..} -> AppE (AppE (AppE (AppE (ConE 'Tag) (stringE tagName)) (stringE tagParent)) (tyE tagTyp)) (if tagDisambiguate then ConE 'True else ConE 'False)++consToSwift :: ()+  => Options+     -- ^ options about how to encode things+  -> Name+     -- ^ name of type+  -> [Type]+     -- ^ type variables+  -> DatatypeVariant+     -- ^ data type variant+  -> [Exp]+     -- ^ tags+  -> (Bool, Maybe Ty, [Protocol])+     -- ^ Make base?+  -> [ConstructorInfo]+     -- ^ constructors+  -> ShwiftyM Exp+consToSwift o@Options{..} parentName instTys variant ts bs = \case+  [] -> do+    value <- lift $ newName "value"+    matches <- liftCons (mkVoid parentName instTys ts)+    lift $ lamE [varP value] (caseE (varE value) matches)+  cons -> do+    -- TODO: use '_' instead of matching+    value <- lift $ newName "value"+    matches <- matchesWorker+    lift $ lamE [varP value] (caseE (varE value) matches)+    where+      -- bad name+      matchesWorker :: ShwiftyM [Q Match]+      matchesWorker = case cons of+        [con] -> liftCons $ do+          case variant of+            NewtypeInstance -> do+              if | typeAlias -> do+                     mkNewtypeInstanceAlias instTys con+                 | otherwise -> do+                     mkNewtypeInstance o instTys ts con+            Newtype -> do+              if | newtypeTag -> do+                     mkTypeTag o parentName instTys con+                 | typeAlias -> do+                     mkTypeAlias parentName instTys con+                 | otherwise -> do+                     mkProd o parentName instTys ts con+            _ -> do+              mkProd o parentName instTys ts con+        _ -> do+          -- omit the cases we don't want+          let cons' = flip filter cons $ \ConstructorInfo{..} -> not (nameStr constructorName `elem` omitCases)+          cases <- forM cons' (liftEither . mkCase o)+          ourMatch <- matchProxy+            $ enumExp parentName instTys dataProtocols cases dataRawValue ts bs+          pure [pure ourMatch]++liftCons :: (Functor f, Applicative g) => f a -> f ([g a])+liftCons x = ((:[]) . pure) <$> x++-- Create the case (String, [(Maybe String, Ty)])+mkCaseHelper :: Options -> Name -> [Exp] -> Exp+mkCaseHelper o name es = TupE [ caseName o name, ListE es ]++mkCase :: ()+  => Options+  -> ConstructorInfo+  -> Either ShwiftyError Exp+mkCase o = \case+  -- non-record+  ConstructorInfo+    { constructorVariant = NormalConstructor+    , constructorName = name+    , constructorFields = fields+    , ..+    } -> Right $ mkCaseHelper o name $ fields <&>+        (\typ -> TupE+          [ ConE 'Nothing+          , toSwiftEPoly typ+          ]+        )+  ConstructorInfo+    { constructorVariant = InfixConstructor+    , constructorName = name+    , ..+    } -> Left $ EncounteredInfixConstructor name+  -- records+  -- we turn names into labels+  ConstructorInfo+    { constructorVariant = RecordConstructor fieldNames+    , constructorName = name+    , constructorFields = fields+    , ..+    } ->+       let cases = zipWith (caseField o) fieldNames fields+       in Right $ mkCaseHelper o name cases++caseField :: Options -> Name -> Type -> Exp+caseField o n typ = TupE+  [ mkLabel o n+  , toSwiftEPoly typ+  ]++onHeadWith :: Bool -> String -> String+onHeadWith toLower = if toLower+  then onHead Char.toLower+  else id++-- apply a function only to the head of a string+onHead :: (Char -> Char) -> String -> String+onHead f = \case { [] -> []; (x:xs) -> f x : xs }++mkLabel :: Options -> Name -> Exp+mkLabel Options{..} = AppE (ConE 'Just)+  . stringE+  . fieldLabelModifier+  . onHeadWith lowerFirstField+  . TS.unpack+  . last+  . TS.splitOn "."+  . TS.pack+  . show++mkNewtypeInstanceAlias :: ()+  => [Type]+     -- ^ type variables+  -> ConstructorInfo+     -- ^ constructor info+  -> ShwiftyM Match+mkNewtypeInstanceAlias (stripConT -> instTys) = \case+  ConstructorInfo+    { constructorName = conName+    , constructorFields = [field]+    , ..+    } -> do+      lift $ match+        (conP 'Proxy [])+        (normalB+          (pure+            (aliasExp conName instTys field)))+        []+  _ -> throwError $ ExpectedNewtypeInstance++mkNewtypeInstance :: ()+  => Options+     -- ^ encoding options+  -> [Type]+     -- ^ type variables+  -> [Exp]+     -- ^ tags+  -> ConstructorInfo+     -- ^ constructor info+  -> ShwiftyM Match+mkNewtypeInstance o@Options{..} (stripConT -> instTys) ts = \case+  ConstructorInfo+    { constructorVariant = RecordConstructor [fieldName]+    , constructorFields = [field]+    , ..+    } -> do+      let fields = [prettyField o fieldName field]+      matchProxy $ structExp constructorName instTys dataProtocols fields ts makeBase+  _ -> throwError ExpectedNewtypeInstance++-- make a newtype into an empty enum+-- with a tag+mkTypeTag :: ()+  => Options+     -- ^ options+  -> Name+     -- ^ type name+  -> [Type]+     -- ^ type variables+  -> ConstructorInfo+     -- ^ constructor info+  -> ShwiftyM Match+mkTypeTag Options{..} typName instTys = \case+  ConstructorInfo+    { constructorFields = [field]+    , ..+    } -> do+      let parentName = mkName+            (nameStr typName ++ "Tag")+      let tag = tagExp typName parentName field False+      matchProxy $ enumExp parentName instTys dataProtocols [] dataRawValue [tag] (False, Nothing, [])++  _ -> throwError $ NotANewtype typName++-- make a newtype into a type alias+mkTypeAlias :: ()+  => Name+     -- ^ type name+  -> [Type]+     -- ^ type variables+  -> ConstructorInfo+     -- ^ constructor info+  -> ShwiftyM Match+mkTypeAlias typName instTys = \case+  ConstructorInfo+    { constructorFields = [field]+    , ..+    } -> do+      lift $ match+        (conP 'Proxy [])+        (normalB+          (pure (aliasExp typName instTys field)))+        []+  _ -> throwError $ NotANewtype typName++-- | Make a void type (empty enum)+mkVoid :: ()+  => Name+     -- ^ type name+  -> [Type]+     -- ^ type variables+  -> [Exp]+     -- ^ tags+  -> ShwiftyM Match+mkVoid typName instTys ts = matchProxy+  $ enumExp typName instTys [] [] Nothing ts (False, Nothing, [])++-- | Make a single-constructor product (struct)+mkProd :: ()+  => Options+     -- ^ encoding options+  -> Name+     -- ^ type name+  -> [Type]+     -- ^ type variables+  -> [Exp]+     -- ^ tags+  -> ConstructorInfo+     -- ^ constructor info+  -> ShwiftyM Match+mkProd o@Options{..} typName instTys ts = \case+  -- single constructor, no fields+  ConstructorInfo+    { constructorVariant = NormalConstructor+    , constructorFields = []+    , ..+    } -> do+      matchProxy $ structExp typName instTys dataProtocols [] ts makeBase+  -- single constructor, non-record (Normal)+  ConstructorInfo+    { constructorVariant = NormalConstructor+    , constructorName = name+    } -> do+      throwError $ SingleConNonRecord name+  -- single constructor, non-record (Infix)+  ConstructorInfo+    { constructorVariant = InfixConstructor+    , constructorName = name+    } -> do+      throwError $ EncounteredInfixConstructor name+  -- single constructor, record+  ConstructorInfo+    { constructorVariant = RecordConstructor fieldNames+    , ..+    } -> do+      let fields = zipFields o fieldNames constructorFields+      matchProxy $ structExp typName instTys dataProtocols fields ts makeBase++zipFields :: Options -> [Name] -> [Type] -> [Exp]+zipFields o = zipWithPred p (prettyField o)+  where+    p :: Name -> Type -> Bool+    p n _ = not $ nameStr n `elem` omitFields o++zipWithPred :: (a -> b -> Bool) -> (a -> b -> c) -> [a] -> [b] -> [c]+zipWithPred _ _ [] _ = []+zipWithPred _ _ _ [] = []+zipWithPred p f (x:xs) (y:ys)+  | p x y = f x y : zipWithPred p f xs ys+  | otherwise = zipWithPred p f xs ys++-- turn a field name into a swift case name.+-- examples:+--+--   data Foo = A | B | C+--   =>+--   enum Foo {+--     case a+--     case b+--     case c+--   }+--+--   data Bar a = MkBar1 a | MkBar2+--   =>+--   enum Bar<A> {+--     case mkBar1(A)+--     case mkBar2+--   }+caseName :: Options -> Name -> Exp+caseName Options{..} = id+  . stringE+  . onHeadWith lowerFirstCase+  . constructorModifier+  . TS.unpack+  . last+  . TS.splitOn "."+  . TS.pack+  . show++-- remove qualifiers from a name, turn into String+nameStr :: Name -> String+nameStr = TS.unpack . last . TS.splitOn "." . TS.pack . show++-- remove qualifiers from a name, turn into Exp+unqualName :: Name -> Exp+unqualName = stringE . nameStr++-- prettify a type variable as an Exp+prettyTyVar :: Name -> Exp+prettyTyVar = stringE . map Char.toUpper . TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show++-- prettify a bunch of type variables as an Exp+prettyTyVars :: [Type] -> Exp+prettyTyVars = ListE . map prettyTyVar . getTyVars++-- get the free type variables from many types+getTyVars :: [Type] -> [Name]+getTyVars = mapMaybe getFreeTyVar++-- get the free type variables in a type+getFreeTyVar :: Type -> Maybe Name+getFreeTyVar = \case+  VarT name -> Just name+  SigT (VarT name) _kind -> Just name+  _ -> Nothing++-- make a struct field pretty+prettyField :: Options -> Name -> Type -> Exp+prettyField Options{..} name ty = TupE+  [ (stringE (onHeadWith lowerFirstField (fieldLabelModifier (nameStr name))))+  , toSwiftEPoly ty+  ]++-- build the instance head for a type+buildTypeInstance :: ()+  => Name+     -- ^ name of the type+  -> ShwiftyClass+     -- ^ which class instance head we are building+  -> [Type]+     -- ^ type variables+  -> [TyVarBndr]+     -- ^ the binders for our tyvars+  -> DatatypeVariant+     -- ^ variant (datatype, newtype, data family, newtype family)+  -> ShwiftyM Type+buildTypeInstance tyConName cls varTysOrig tyVarBndrs variant = do+  -- Make sure to expand through type/kind synonyms!+  -- Otherwise, the eta-reduction check might get+  -- tripped up over type variables in a synonym+  -- that are actually dropped.+  -- (See GHC Trac #11416 for a scenario where this+  -- actually happened)+  varTysExp <- lift $ mapM resolveTypeSynonyms varTysOrig++  -- get the kind status of all of our types.+  -- we must realise them all to *.+  starKindStats :: [KindStatus] <- foldlM+    (\stats k -> case canRealiseKindStar k of+      NotKindStar -> do+        throwError $ KindVariableCannotBeRealised tyConName k+      s -> pure (stats ++ [s])+    ) [] varTysExp++  let -- get the names of our kind vars+      kindVarNames :: [Name]+      kindVarNames = flip mapMaybe starKindStats+        (\case+            IsKindVar n -> Just n+            _ -> Nothing+        )++  let+      -- instantiate polykinded things to star.+      varTysExpSubst :: [Type]+      varTysExpSubst = map (substNamesWithKindStar kindVarNames) varTysExp++      -- the constraints needed on type variables+      preds :: [Maybe Pred]+      preds = map (deriveConstraint cls) varTysExpSubst++      -- We now sub all of the specialised-to-* kind+      -- variable names with *, but in the original types,+      -- not the synonym-expanded types. The reason we+      -- do this is superficial: we want the derived+      -- instance to resemble the datatype written in+      -- source code as closely as possible. For example,+      --+      --   data family Fam a+      --   newtype instance Fam String = Fam String+      --+      -- We'd want to generate the instance:+      --+      --   instance C (Fam String)+      --+      -- Not:+      --+      --   instance C (Fam [Char])+      varTysOrigSubst :: [Type]+      varTysOrigSubst =+        map (substNamesWithKindStar kindVarNames) $ varTysOrig++      -- if we are working on a data family+      -- or newtype family, we need to peel off+      -- the kinds. See Note [Kind signatures in+      -- derived instances]+      varTysOrigSubst' :: [Type]+      varTysOrigSubst' = if isDataFamily variant+        then varTysOrigSubst+        else map unSigT varTysOrigSubst++      -- the constraints needed on type variables+      -- makes up the constraint part of the+      -- instance head.+      instanceCxt :: Cxt+      instanceCxt = catMaybes preds++      -- the class and type in the instance head.+      instanceType :: Type+      instanceType = AppT (ConT (shwiftyClassName cls))+        $ applyTyCon tyConName varTysOrigSubst'++  -- forall <tys>. ctx tys => Cls ty+  lift $ forallT+    (map tyVarBndrNoSig tyVarBndrs)+    (pure instanceCxt)+    (pure instanceType)++-- the class we're generating an instance of+data ShwiftyClass+  = ClassSwift -- ToSwift+  | ClassSwiftData -- ToSwiftData++-- turn a 'ShwiftyClass' into a 'Name'+shwiftyClassName :: ShwiftyClass -> Name+shwiftyClassName = \case+  ClassSwift -> ''ToSwift+  ClassSwiftData -> ''ToSwiftData++-- derive the constraint needed on a type variable+-- in order to build the instance head for a class.+deriveConstraint :: ()+  => ShwiftyClass+     -- ^ class name+  -> Type+     -- ^ type+  -> Maybe Pred+     -- ^ constraint on type+deriveConstraint c@ClassSwift typ+  | not (isTyVar typ) = Nothing+  | hasKindStar typ = Just (applyCon (shwiftyClassName c) tName)+  | otherwise = Nothing+  where+    tName :: Name+    tName = varTToName typ+    varTToName = \case+      VarT n -> n+      SigT t _ -> varTToName t+      _ -> error "Shwifty.varTToName: encountered non-type variable"+deriveConstraint ClassSwiftData _ = Nothing++-- apply a type constructor to a type variable.+-- this can be useful for letting the kind+-- inference engine doing work for you. see+-- 'toSwiftECxt' for an example of this.+applyCon :: Name -> Name -> Pred+applyCon con t = AppT (ConT con) (VarT t)++-- peel off a kind signature from a Type+unSigT :: Type -> Type+unSigT = \case+  SigT t _ -> t+  t -> t++-- is the type a type variable?+isTyVar :: Type -> Bool+isTyVar = \case+  VarT _ -> True+  SigT t _ -> isTyVar t+  _ -> False++-- does the type have kind *?+hasKindStar :: Type -> Bool+hasKindStar = \case+  VarT _ -> True+  SigT _ StarT -> True+  _ -> False++-- perform the substitution of type variables+-- who have kinds which can be realised to *,+-- with the same type variable where its kind+-- has been turned into *+substNamesWithKindStar :: [Name] -> Type -> Type+substNamesWithKindStar ns t = foldr' (`substNameWithKind` starK) t ns+  where+    substNameWithKind :: Name -> Kind -> Type -> Type+    substNameWithKind n k = applySubstitution (M.singleton n k)++-- | The status of a kind variable w.r.t. its+--   ability to be realised into *.+data KindStatus+  = KindStar+    -- ^ kind * (or some k which can be realised to *)+  | NotKindStar+    -- ^ any other kind+  | IsKindVar Name+    -- ^ is actually a kind variable+  | IsCon Name+    -- ^ is a constructor - this will typically+    --   happen in a data family instance, because+    --   we often have to construct a+    --   FlexibleInstance. our old check for+    --   canRealiseKindStar didn't check for+    --   `ConT` - where this would happen.+    --+    --   TODO: Now i think this might need to be+    --   removed in favour of something smarter.++-- can we realise the type's kind to *?+canRealiseKindStar :: Type -> KindStatus+canRealiseKindStar = \case+  VarT{} -> KindStar+  SigT _ StarT -> KindStar+  SigT _ (VarT n) -> IsKindVar n+  ConT n -> IsCon n+  _ -> NotKindStar++-- discard the kind signature from a TyVarBndr.+tyVarBndrNoSig :: TyVarBndr -> TyVarBndr+tyVarBndrNoSig = \case+  PlainTV n -> PlainTV n+  KindedTV n _k -> PlainTV n++-- fully applies a type constructor to its+-- type variables+applyTyCon :: Name -> [Type] -> Type+applyTyCon = foldl' AppT . ConT++-- Turn a String into an Exp string literal+stringE :: String -> Exp+stringE = LitE . StringL++-- convert a type into a 'Ty'.+-- we respect constraints here - e.g. in+-- `(Swift a, Swift b) => Swift (Foo a b)`,+-- we don't just fill in holes like in+-- `toSwiftEPoly`, we actually turn `a`+-- and `b` into `Ty`s directly. Consequently,+-- the implementation is much simpler - just+-- an application.+--+-- Note the use of unSigT - see Note+-- [Kind signatures in derived instances].+toSwiftECxt :: Type -> Exp+toSwiftECxt (unSigT -> typ) = AppE+  (VarE 'toSwift)+  (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) typ))++-- convert a type into a 'Ty'.+-- polymorphic types do not require a 'ToSwift'+-- instance, since we fill them in with 'SingSymbol'.+--+-- We do this by stretching out a type along its+-- spine, completely. we then fill in any polymorphic+-- variables with 'SingSymbol', reflecting the type+-- Name to a Symbol. then we compress the spine to+-- get the original type. the 'ToSwift' instance for+-- 'SingSymbol' gets us where we need to go.+--+-- Note that @compress . decompress@ is not+-- actually equivalent to the identity function on+-- Type because of ForallT, where we discard some+-- context. However, for any types we care about,+-- there shouldn't be a ForallT, so this *should*+-- be fine.+toSwiftEPoly :: Type -> Exp+toSwiftEPoly = \case+  -- we don't need to special case VarT and SigT+  VarT n+    -> AppE (ConE 'Poly) (prettyTyVar n)+  SigT (VarT n) _+    -> AppE (ConE 'Poly) (prettyTyVar n)+  typ ->+    let decompressed = decompress typ+        prettyName = map Char.toUpper . TS.unpack . head . TS.splitOn "_" . last . TS.splitOn "." . TS.pack . show+        filledInHoles = decompressed <&>+          (\case+            VarT name -> AppT+              (ConT ''Shwifty.SingSymbol)+              (LitT (StrTyLit (prettyName name)))+            SigT (VarT name) _ -> AppT+              (ConT ''Shwifty.SingSymbol)+              (LitT (StrTyLit (prettyName name)))+            t -> t+          )+        typ' = compress filledInHoles+     in AppE+      (VarE 'toSwift)+      (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) typ'))++decompress :: Type -> Rose Type+decompress typ = case unapplyTy typ of+  tyCon :| tyArgs -> Rose tyCon (decompress <$> tyArgs)++compress :: Rose Type -> Type+compress (Rose typ []) = typ+compress (Rose t ts) = foldl' AppT t (compress <$> ts)++unapplyTy :: Type -> NonEmpty Type+unapplyTy = NE.reverse . go+  where+    go = \case+      AppT t1 t2 -> t2 <| go t1+      SigT t _ -> go t+      ForallT _ _ t -> go t+      t -> t :| []++-- | Types can be stretched out into a Rose tree.+--   decompress will stretch a type out completely,+--   in such a way that it cannot be stretched out+--   further. compress will reconstruct a type from+--   its stretched form.+--+--   Also note that this is equivalent to+--   Cofree NonEmpty Type.+--+--   Examples:+--+--   Maybe a+--   =>+--   AppT (ConT Maybe) (VarT a)+--+--+--   Either a b+--   =>+--   AppT (AppT (ConT Either) (VarT a)) (VarT b)+--   =>+--   Rose (ConT Either)+--     [ Rose (VarT a)+--         [+--         ]+--     , Rose (VarT b)+--         [+--         ]+--     ]+--+--+--   Either (Maybe a) (Maybe b)+--   =>+--   AppT (AppT (ConT Either) (AppT (ConT Maybe) (VarT a))) (AppT (ConT Maybe) (VarT b))+--   =>+--   Rose (ConT Either)+--     [ Rose (ConT Maybe)+--         [ Rose (VarT a)+--             [+--             ]+--         ]+--     , Rose (ConT Maybe)+--         [ Rose (VarT b)+--             [+--             ]+--         ]+--     ]+data Rose a = Rose a [Rose a]+  deriving stock (Eq, Show)+  deriving stock (Functor,Foldable,Traversable)++{-+Note [Kind signatures in derived instances]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++It is possible to put explicit kind signatures into the derived instances, e.g.,++  instance C a => C (Data (f :: * -> *)) where ...++But it is preferable to avoid this if possible. If we come up with an incorrect+kind signature (which is entirely possible, since Template Haskell doesn't always+have the best track record with reifying kind signatures), then GHC will flat-out+reject the instance, which is quite unfortunate.++Plain old datatypes have the advantage that you can avoid using any kind signatures+at all in their instances. This is because a datatype declaration uses all type+variables, so the types that we use in a derived instance uniquely determine their+kinds. As long as we plug in the right types, the kind inferencer can do the rest+of the work. For this reason, we use unSigT to remove all kind signatures before+splicing in the instance context and head.++Data family instances are trickier, since a data family can have two instances that+are distinguished by kind alone, e.g.,++  data family Fam (a :: k)+  data instance Fam (a :: * -> *)+  data instance Fam (a :: *)++If we dropped the kind signatures for C (Fam a), then GHC will have no way of+knowing which instance we are talking about. To avoid this scenario, we always+include explicit kind signatures in data family instances. There is a chance that+the inferred kind signatures will be incorrect, in which case we have to write the instance manually.+-}++-- are we working on a data family+-- or newtype family?+isDataFamily :: DatatypeVariant -> Bool+isDataFamily = \case+  NewtypeInstance -> True+  DataInstance -> True+  _ -> False++stripConT :: [Type] -> [Type]+stripConT = mapMaybe noConT+  where+    noConT = \case+      ConT {} -> Nothing+      t -> Just t++-- | Like 'getShwiftyWith', but with a 'Codec'+--   instead of 'Options'.+getShwiftyCodec :: forall tag. ModifyOptions tag => Codec tag -> Name -> Q [Dec]+getShwiftyCodec c = getShwiftyCodecTags c []++-- | Like 'getShwiftyWithTags', but with a 'Codec'+--   instead of 'Options'.+getShwiftyCodecTags :: forall tag. ModifyOptions tag => Codec tag -> [Name] -> Name -> Q [Dec]+getShwiftyCodecTags _ ts n = getShwiftyWithTags (modifyOptions @tag defaultOptions) ts n++--getShwiftyModTags :: forall tag typ. (ModifyOptions tag, KnownSymbol typ) => [Name] -> Q [Dec]+--getShwiftyModTags ts = getShwiftyWithTags (modifyOptions @tag defaultOptions) ts (mkName (symbolVal (Proxy @typ)))++--combine :: Codec a -> Codec b -> Codec (a & b)+--combine _ _ = Codec++-- | Construct a Type Alias.+aliasExp :: ()+  => Name+     -- ^ alias name+  -> [Type]+     -- ^ type variables+  -> Type+     -- ^ type (RHS)+  -> Exp+aliasExp name tyVars field = RecConE 'SwiftAlias+  [ (mkName "aliasName", unqualName name)+  , (mkName "aliasTyVars", prettyTyVars tyVars)+  , (mkName "aliasTyp", toSwiftECxt field)+  ]++-- | Construct a Tag.+tagExp :: ()+  => Name+     -- ^ tycon name+  -> Name+     -- ^ parent name+  -> Type+     -- ^ type of the tag (RHS)+  -> Bool+     -- ^ Whether or not we are disambiguating.+  -> Exp+tagExp tyconName parentName typ dis = RecConE 'Tag+  [ (mkName "tagName", unqualName tyconName)+  , (mkName "tagParent", unqualName parentName)+  , (mkName "tagTyp", toSwiftECxt typ)+  , (mkName "tagDisambiguate", case dis of+      { False -> ConE 'False+      ; True  -> ConE 'True+      })+  ]++-- | Construct an Enum.+enumExp :: ()+  => Name+     -- ^ parent name+  -> [Type]+     -- ^ type variables+  -> [Protocol]+     -- ^ protocols+  -> [Exp]+     -- ^ cases+  -> Maybe Ty+     -- ^ Raw Value+  -> [Exp]+     -- ^ Tags+  -> (Bool, Maybe Ty, [Protocol])+     -- ^ Make base?+  -> Exp+enumExp parentName tyVars protos cases raw tags bs+  = applyBase bs $ RecConE 'SwiftEnum+      [ (mkName "enumName", unqualName parentName)+      , (mkName "enumTyVars", prettyTyVars tyVars)+      , (mkName "enumProtocols", protosExp protos)+      , (mkName "enumCases", ListE cases)+      , (mkName "enumRawValue", rawValueE raw)+      , (mkName "enumPrivateTypes", ListE [])+      , (mkName "enumTags", ListE tags)+      ]++-- | Construct a Struct.+structExp :: ()+  => Name+     -- ^ struct name+  -> [Type]+     -- ^ type variables+  -> [Protocol]+     -- ^ protocols+  -> [Exp]+     -- ^ fields+  -> [Exp]+     -- ^ tags+  -> (Bool, Maybe Ty, [Protocol])+     -- ^ Make base?+  -> Exp+structExp name tyVars protos fields tags bs+  = applyBase bs $ RecConE 'SwiftStruct+      [ (mkName "structName", unqualName name)+      , (mkName "structTyVars", prettyTyVars tyVars)+      , (mkName "structProtocols", protosExp protos)+      , (mkName "structFields", ListE fields)+      , (mkName "structPrivateTypes", ListE [])+      , (mkName "structTags", ListE tags)+      ]++matchProxy :: Exp -> ShwiftyM Match+matchProxy e = lift $ match+  (conP 'Proxy [])+  (normalB (pure e))+  []++stripFields :: SwiftData -> SwiftData+stripFields = \case+  s@SwiftStruct{} -> s { structFields = [] }+  s@SwiftEnum{} -> s { enumCases = go (enumCases s) }+    where+      go = map stripOne+      stripOne (x, _) = (x, [])+  s -> s++giveProtos :: [Protocol] -> SwiftData -> SwiftData+giveProtos ps = \case+  s@SwiftStruct{} -> s { structProtocols = ps }+  s@SwiftEnum{} -> s { enumProtocols = ps }+  s -> s++suffixBase :: SwiftData -> SwiftData+suffixBase = \case+  s@SwiftStruct{} -> s { structName = structName s ++ "Base" }+  s@SwiftEnum{} -> s { enumName = enumName s ++ "Base" }+  s -> s++giveBase :: Maybe Ty -> [Protocol] -> SwiftData -> SwiftData+giveBase r ps = \case+  s@SwiftStruct{} -> s { structPrivateTypes = [giveProtos ps (suffixBase (stripFields s))] }+  s@SwiftEnum{} -> s { enumPrivateTypes = [ giveProtos ps (suffixBase (stripFields s)) { enumRawValue = r }] }+  s -> s++-- | Apply 'giveBase' to a 'SwiftData'.+--+--   Ideally we would offload this into+--   the first construction of the SwiftData,+--   inside structExp/enumExp.+--+--+-- should we strip tyvars as well?+applyBase :: (Bool, Maybe Ty, [Protocol]) -> Exp -> Exp+applyBase (b, r, ps) (ParensE -> s) = if b+  then+    AppE (AppE (AppE (VarE 'giveBase) (rawValueE r)) (protosExp ps)) s+  else s++protosExp :: [Protocol] -> Exp+protosExp = ListE . map (ConE . mkName . show)+

@@ -0,0 +1,154 @@+{-# language+    CPP+  , FlexibleInstances+  , ScopedTypeVariables+  , TypeApplications+  #-}++module Shwifty.Class+  ( ToSwift(..)+  , ToSwiftData(..)+  ) where++import Data.List (intercalate)+import Data.Proxy (Proxy(..))+import Control.Monad.Except+import Data.CaseInsensitive (CI)+import Data.Foldable (foldlM,foldr',foldl')+import Data.Functor ((<&>))+import Data.Int (Int8,Int16,Int32,Int64)+import Data.Kind (Constraint)+import Data.List.NonEmpty ((<|), NonEmpty(..))+import Data.Maybe (mapMaybe, catMaybes)+import Data.Proxy (Proxy(..))+import Data.Time (UTCTime)+import Data.UUID.Types (UUID)+import Data.Vector (Vector)+import Data.Void (Void)+import Data.Word (Word8,Word16,Word32,Word64)+import GHC.TypeLits+  ( Symbol, KnownSymbol, symbolVal+  , TypeError, ErrorMessage(..)+  )+import Language.Haskell.TH hiding (stringE)+import Language.Haskell.TH.Datatype+import Prelude hiding (Enum(..))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.Char as Char+import qualified Data.HashMap.Strict as HM+import qualified Data.List as L+import qualified Data.List.NonEmpty as NE+import qualified Data.Map as M+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import qualified Data.Primitive as Prim++import Shwifty.Types++-- | The class for things which can be converted to+--   'SwiftData'.+--+--   Typically the instance will be generated by+--   'getShwifty'.+class ToSwiftData a where+  -- | Convert a type to 'SwiftData'+  toSwiftData :: Proxy a -> SwiftData++-- | The class for things which can be converted to+--   a Swift type ('Ty').+--+--   Typically the instance will be generated by+--   'getShwifty'.+class ToSwift a where+  -- | Convert a type to its Swift 'Ty'.+  toSwift :: Proxy a -> Ty++instance ToSwift () where+  toSwift = const Unit++instance ToSwift Bool where+  toSwift = const Bool++instance ToSwift UUID where+  toSwift = const (Concrete "UUID" [])++instance ToSwift UTCTime where+  toSwift = const (Concrete "Date" [])++instance forall a b. (ToSwift a, ToSwift b) => ToSwift (a -> b) where+  toSwift = const (App (toSwift (Proxy @a)) (toSwift (Proxy @b)))++instance forall a. ToSwift a => ToSwift (Maybe a) where+  toSwift = const (Optional (toSwift (Proxy @a)))++-- | /Note/: In Swift, the ordering of the type+--   variables is flipped - Shwifty has made the+--   design choice to flip them for you. If you+--   take issue with this, please open an issue+--   for discussion on GitHub.+instance forall a b. (ToSwift a, ToSwift b) => ToSwift (Either a b) where+  toSwift = const (Result (toSwift (Proxy @b)) (toSwift (Proxy @a)))++instance ToSwift Integer where+  toSwift = const+#if WORD_SIZE_IN_BITS == 32+    BigSInt32+#else+    BigSInt64+#endif++instance ToSwift Int   where toSwift = const I+instance ToSwift Int8  where toSwift = const I8+instance ToSwift Int16 where toSwift = const I16+instance ToSwift Int32 where toSwift = const I32+instance ToSwift Int64 where toSwift = const I64++instance ToSwift Word   where toSwift = const U+instance ToSwift Word8  where toSwift = const U8+instance ToSwift Word16 where toSwift = const U16+instance ToSwift Word32 where toSwift = const U32+instance ToSwift Word64 where toSwift = const U64++instance ToSwift Float  where toSwift = const F32+instance ToSwift Double where toSwift = const F64++instance ToSwift Char where toSwift = const Character++instance forall a. (ToSwift a) => ToSwift (Prim.Array a) where+  toSwift = const (Array (toSwift (Proxy @a)))++instance forall a. (ToSwift a) => ToSwift (Prim.SmallArray a) where+  toSwift = const (Array (toSwift (Proxy @a)))++instance ToSwift Prim.ByteArray where+  toSwift = const (Array U8)++instance forall a. (ToSwift a) => ToSwift (Prim.PrimArray a) where+  toSwift = const (Array (toSwift (Proxy @a)))++instance forall a. ToSwift a => ToSwift (Vector a) where+  toSwift = const (Array (toSwift (Proxy @a)))++instance {-# overlappable #-} forall a. ToSwift a => ToSwift [a] where+  toSwift = const (Array (toSwift (Proxy @a)))++instance {-# overlapping #-} ToSwift [Char] where toSwift = const Str++instance ToSwift TL.Text where toSwift = const Str+instance ToSwift TS.Text where toSwift = const Str++instance ToSwift BL.ByteString where toSwift = const (Array U8)+instance ToSwift BS.ByteString where toSwift = const (Array U8)++instance ToSwift (CI s) where toSwift = const Str++instance forall k v. (ToSwift k, ToSwift v) => ToSwift (M.Map k v) where toSwift = const (Dictionary (toSwift (Proxy @k)) (toSwift (Proxy @v)))++instance forall k v. (ToSwift k, ToSwift v) => ToSwift (HM.HashMap k v) where toSwift = const (Dictionary (toSwift (Proxy @k)) (toSwift (Proxy @v)))++instance forall a b. (ToSwift a, ToSwift b) => ToSwift ((,) a b) where+  toSwift = const (Tuple2 (toSwift (Proxy @a)) (toSwift (Proxy @b)))++instance forall a b c. (ToSwift a, ToSwift b, ToSwift c) => ToSwift ((,,) a b c) where+  toSwift = const (Tuple3 (toSwift (Proxy @a)) (toSwift (Proxy @b)) (toSwift (Proxy @c)))

@@ -0,0 +1,210 @@+{-# language+    AllowAmbiguousTypes+  , DataKinds+  , ExplicitNamespaces+  , FlexibleInstances+  , GADTs+  , KindSignatures+  , PolyKinds+  , ScopedTypeVariables+  , TypeApplications+  , TypeFamilies+  , TypeOperators+  , TypeSynonymInstances+  , UndecidableInstances+  #-}++module Shwifty.Codec+  ( Codec(..)+  , ModifyOptions(..)+  , AsIs+  , type (&)+  , Label(..)+  , Drop+  , DontGenerate+  , Implement+  , RawValue+  , CanBeRawValue+  , TypeAlias+  , NewtypeTag+  , DontLowercase+  , OmitField+  , OmitCase+  , MakeBase+  ) where++import Data.Kind (Constraint)+import Data.Proxy (Proxy(..))+import GHC.TypeLits+  ( KnownSymbol, Symbol, symbolVal+  , TypeError, ErrorMessage(..)+  )+import Shwifty.Class+import Shwifty.Types++-- | Modify options.+class ModifyOptions tag where+  modifyOptions :: Options -> Options++-- | No modifications+type AsIs = ()++instance ModifyOptions AsIs where+  modifyOptions = id++-- | A carrier for modifiers.+data Codec tag = Codec++instance ModifyOptions tag => ModifyOptions (Codec tag) where+  modifyOptions = modifyOptions @tag++infixr 6 &+-- | Combine modifications.+data a & b++instance forall a b. (ModifyOptions a, ModifyOptions b) => ModifyOptions (a & b) where+  modifyOptions = modifyOptions @a . modifyOptions @b++-- | Label modifiers.+data Label+  = TyCon+    -- ^ Type constructor modifier+  | DataCon+    -- ^ Data constructor modifiers+  | Field+    -- ^ Field label modifiers++-- | Modify a label by dropping a string+data Drop (label :: Label) (string :: Symbol)++instance KnownSymbol string => ModifyOptions (Drop 'TyCon string) where+  modifyOptions options = options+    { typeConstructorModifier = drop (length (symbolVal (Proxy @string)))+    }++instance KnownSymbol string => ModifyOptions (Drop 'DataCon string) where+  modifyOptions options = options+    { constructorModifier = drop (length (symbolVal (Proxy @string)))+    }++instance KnownSymbol string => ModifyOptions (Drop 'Field string) where+  modifyOptions options = options+    { fieldLabelModifier = drop (length (symbolVal (Proxy @string)))+    }++-- | Don't generate a specific class.+data DontGenerate (cls :: * -> Constraint)++class GenerateClass (c :: * -> Constraint) where+  classModifier :: Options -> Options++instance GenerateClass ToSwiftData where+  classModifier options = options { generateToSwiftData = False }++instance GenerateClass ToSwift where+  classModifier options = options { generateToSwift = False }++instance GenerateClass c => ModifyOptions (DontGenerate c) where+  modifyOptions = classModifier @c++-- | Add protocols+data Implement (protocol :: Protocol)++class KnownProtocol (p :: Protocol) where protocolVal :: Protocol+instance KnownProtocol 'Equatable where protocolVal = Equatable+instance KnownProtocol 'Hashable where protocolVal = Hashable+instance KnownProtocol 'Codable where protocolVal = Codable++instance ModifyOptions (Implement 'Equatable) where+  modifyOptions options = options { dataProtocols = Equatable : dataProtocols options }++instance ModifyOptions (Implement 'Hashable) where+  modifyOptions options = options { dataProtocols = Hashable : dataProtocols options }++instance ModifyOptions (Implement 'Codable) where+  modifyOptions options = options { dataProtocols = Codable : dataProtocols options }++-- | Add a rawValue+data RawValue (ty :: Ty)++-- | A Class that indicates that this swift type+--   can be a rawValue. The value of 'getRawValue'+--   will be its actual rawValue.+class CanBeRawValue (ty :: Ty) where+  getRawValue :: Ty++instance CanBeRawValue 'Str where getRawValue = Str+instance CanBeRawValue 'I where getRawValue = I+instance CanBeRawValue 'I8 where getRawValue = I8+instance CanBeRawValue 'I16 where getRawValue = I16+instance CanBeRawValue 'I32 where getRawValue = I32+instance CanBeRawValue 'I64 where getRawValue = I64+instance CanBeRawValue 'U where getRawValue = U+instance CanBeRawValue 'U8 where getRawValue = U8+instance CanBeRawValue 'U16 where getRawValue = U16+instance CanBeRawValue 'U32 where getRawValue = U32+instance CanBeRawValue 'U64 where getRawValue = U64++instance CanBeRawValue ty => ModifyOptions (RawValue ty) where+  modifyOptions options = options { dataRawValue = Just (getRawValue @ty) }++-- | Make it a type alias (only applies to newtypes)+data TypeAlias++instance ModifyOptions TypeAlias where+  modifyOptions options = options { typeAlias = True }++-- | Make it a newtype tag (only applies to newtype tags)+data NewtypeTag++instance ModifyOptions NewtypeTag where+  modifyOptions options = options { newtypeTag = True }++-- | Dont lower-case fields/cases+data DontLowercase (someKind :: Label)++instance TypeError ('Text "Cannot apply DontLowercase to TyCon") => ModifyOptions (DontLowercase 'TyCon) where+  modifyOptions _ = error "UNREACHABLE"++instance ModifyOptions (DontLowercase 'DataCon) where+  modifyOptions options = options { lowerFirstCase = False }++instance ModifyOptions (DontLowercase 'Field) where+  modifyOptions options = options { lowerFirstField = False }++-- | Omit a field+data OmitField (field :: Symbol)++instance KnownSymbol field => ModifyOptions (OmitField field) where+  modifyOptions options = options { omitFields = symbolVal (Proxy @field) : omitFields options }++-- | Omit a case+data OmitCase (cas :: Symbol)++instance KnownSymbol cas => ModifyOptions (OmitCase cas) where+  modifyOptions options = options { omitCases = symbolVal (Proxy @cas) : omitCases options }++-- | Make a base type+data MakeBase (rawValue :: Maybe Ty) (protocols :: [Protocol])++instance forall ty protocols. (CanBeRawValue ty, ProtocolList protocols) => ModifyOptions (MakeBase ('Just ty) protocols) where+  modifyOptions options = options+    { makeBase = (,,) True (Just (getRawValue @ty)) (protocolList @protocols)+    }++instance forall protocols. (ProtocolList protocols) => ModifyOptions (MakeBase 'Nothing protocols) where+  modifyOptions options = options+    { makeBase = (,,) True Nothing (protocolList @protocols)+    }++data SomeProtocol where+  SomeProtocol :: KnownProtocol p => SomeProtocol++class ProtocolList (x :: [Protocol]) where+  protocolList :: [Protocol]++instance ProtocolList '[] where+  protocolList = []++instance forall p ps. (KnownProtocol p, ProtocolList ps) => ProtocolList (p ': ps) where+  protocolList = protocolVal @p : protocolList @ps

@@ -0,0 +1,204 @@+{-# language+    LambdaCase+  , RecordWildCards+  #-}++module Shwifty.Pretty+  ( prettySwiftData+  , prettyTy+  ) where++import Data.List (intercalate)++import Shwifty.Types++-- | Pretty-print a 'SwiftData'.+prettySwiftData :: SwiftData -> String+prettySwiftData = prettySwiftDataWith 4++-- | Pretty-print a 'SwiftData'.+--   This function cares about indent.+prettySwiftDataWith :: ()+  => Int -- ^ indent+  -> SwiftData+  -> String+prettySwiftDataWith indent = \case++  SwiftEnum {..} -> []+    ++ "enum "+    ++ prettyTypeHeader enumName enumTyVars+    ++ prettyRawValueAndProtocols enumRawValue enumProtocols+    ++ " {"+    ++ newlineNonEmpty enumCases+    ++ prettyEnumCases indents enumCases+    ++ newlineNonEmpty enumPrivateTypes+    ++ prettyPrivateTypes indents enumPrivateTypes+    ++ prettyTags indents enumTags+    ++ newlineNonEmpty enumTags+    ++ "}"++  SwiftStruct {..} -> []+    ++ "struct "+    ++ prettyTypeHeader structName structTyVars+    ++ prettyProtocols structProtocols+    ++ " {"+    ++ newlineNonEmpty structFields+    ++ prettyStructFields indents structFields+    ++ newlineNonEmpty structPrivateTypes+    ++ prettyPrivateTypes indents structPrivateTypes+    ++ prettyTags indents structTags+    ++ newlineNonEmpty structTags+    ++ "}"++  SwiftAlias{..} -> []+    ++ "typealias "+    ++ prettyTypeHeader aliasName aliasTyVars+    ++ " = "+    ++ prettyTy aliasTyp+  where+    indents = replicate indent ' '++    newlineNonEmpty [] = ""+    newlineNonEmpty _ = "\n"++prettyTypeHeader :: String -> [String] -> String+prettyTypeHeader name [] = name+prettyTypeHeader name tyVars = name ++ "<" ++ intercalate ", " tyVars ++ ">"++prettyRawValueAndProtocols :: Maybe Ty -> [Protocol] -> String+prettyRawValueAndProtocols Nothing ps = prettyProtocols ps+prettyRawValueAndProtocols (Just ty) [] = ": " ++ prettyTy ty+prettyRawValueAndProtocols (Just ty) ps = ": " ++ prettyTy ty ++ ", " ++ intercalate ", " (map show ps)++prettyProtocols :: [Protocol] -> String+prettyProtocols = \case+  [] -> ""+  ps -> ": " ++ intercalate ", " (map show ps)++prettyTags :: String -> [Ty] -> String+prettyTags indents = go where+  go [] = ""+  go (Tag{..}:ts) = []+    ++ "\n"+    ++ prettyTagDisambiguator tagDisambiguate indents tagName+    ++ indents+    ++ "typealias "+    ++ tagName+    ++ " = Tagged<"+    ++ (if tagDisambiguate then tagName ++ "Tag" else tagParent)+    ++ ", "+    ++ prettyTy tagTyp+    ++ ">"+    ++ go ts+  go _ = error "non-tag supplied to prettyTags"++prettyTagDisambiguator :: ()+  => Bool+     -- ^ disambiguate?+  -> String+     -- ^ indents+  -> String+     -- ^ parent type name+  -> String+prettyTagDisambiguator disambiguate indents parent+  = if disambiguate+      then []+        ++ indents+        ++ "enum "+        ++ parent+        ++ "Tag { }\n"+      else ""++labelCase :: Maybe String -> Ty -> String+labelCase Nothing ty = prettyTy ty+labelCase (Just label) ty = "_ " ++ label ++ ": " ++ prettyTy ty++-- | Pretty-print a 'Ty'.+prettyTy :: Ty -> String+prettyTy = \case+  Str -> "String"+  Unit -> "()"+  Bool -> "Bool"+  Character -> "Character"+  Tuple2 e1 e2 -> "(" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ")"+  Tuple3 e1 e2 e3 -> "(" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ", " ++ prettyTy e3 ++ ")"+  Optional e -> prettyTy e ++ "?"+  Result e1 e2 -> "Result<" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ">"+  Set e -> "Set<" ++ prettyTy e ++ ">"+  Dictionary e1 e2 -> "Dictionary<" ++ prettyTy e1 ++ ", " ++ prettyTy e2 ++ ">"+  Array e -> "[" ++ prettyTy e ++ "]"+  -- App is special, we recurse until we no longer+  -- any applications.+  App e1 e2 -> prettyApp e1 e2+  I -> "Int"+  I8 -> "Int8"+  I16 -> "Int16"+  I32 -> "Int32"+  I64 -> "Int64"+  U -> "UInt"+  U8 -> "UInt8"+  U16 -> "UInt16"+  U32 -> "UInt32"+  U64 -> "UInt64"+  F32 -> "Float"+  F64 -> "Double"+  Decimal -> "Decimal"+  BigSInt32 -> "BigSInt32"+  BigSInt64 -> "BigSInt64"+  Poly ty -> ty+  Concrete ty [] -> ty+  Concrete ty tys -> ty+    ++ "<"+    ++ intercalate ", " (map prettyTy tys)+    ++ ">"+  Tag {..} -> tagParent ++ "." ++ tagName++prettyApp :: Ty -> Ty -> String+prettyApp t1 t2 = "(("+  ++ intercalate ", " (map prettyTy as)+  ++ ") -> "+  ++ prettyTy r+  ++ ")"+  where+    (as, r) = go t1 t2+    go e1 (App e2 e3) = case go e2 e3 of+      (args, ret) -> (e1 : args, ret)+    go e1 e2 = ([e1], e2)++prettyEnumCases :: String -> [(String, [(Maybe String, Ty)])] -> String+prettyEnumCases indents = go+  where+    go = \case+      [] -> ""+      ((caseNm, []):xs) -> []+        ++ indents+        ++ "case "+        ++ caseNm+        ++ "\n"+        ++ go xs+      ((caseNm, cs):xs) -> []+        ++ indents+        ++ "case "+        ++ caseNm+        ++ "("+        ++ (intercalate ", " (map (uncurry labelCase) cs))+        ++ ")\n"+        ++ go xs++prettyStructFields :: String -> [(String, Ty)] -> String+prettyStructFields indents = go+  where+    go [] = ""+    go ((fieldName,ty):fs) = indents ++ "let " ++ fieldName ++ ": " ++ prettyTy ty ++ "\n" ++ go fs++prettyPrivateTypes :: String -> [SwiftData] -> String+prettyPrivateTypes indents = go+  where+    go [] = ""+    go (s:ss) = indents ++ "private " ++ unlines (onLast (indents ++) (lines (prettySwiftData s))) ++ go ss++-- map a function over everything but the+-- first element.+onLast :: (a -> a) -> [a] -> [a]+onLast f [] = []+onLast f (x:xs) = x : map f xs

@@ -0,0 +1,314 @@+{-# language+    AllowAmbiguousTypes+  , DeriveGeneric+  , DeriveLift+  , DerivingStrategies+#-}++module Shwifty.Types+  ( Ty(..)+  , SwiftData(..)+  , Protocol(..)+  , Options(..)+  ) where++import GHC.Generics (Generic)+import Language.Haskell.TH.Syntax (Lift)++-- | An AST representing a Swift type.+data Ty+  = Unit+    -- ^ Unit (called "Unit/Void" in swift). Empty struct type.+  | Bool+    -- ^ Bool+  | Character+    -- ^ Character+  | Str+    -- ^ String. Named 'Str' to avoid conflicts with+    --   'Data.Aeson.String'.+  | I+    -- ^ signed machine integer+  | I8+    -- ^ signed 8-bit integer+  | I16+    -- ^ signed 16-bit integer+  | I32+    -- ^ signed 32-bit integer+  | I64+    -- ^ signed 64-bit integer+  | U+    -- ^ unsigned machine integer+  | U8+    -- ^ unsigned 8-bit integer+  | U16+    -- ^ unsigned 16-bit integer+  | U32+    -- ^ unsigned 32-bit integer+  | U64+    -- ^ unsigned 64-bit integer+  | F32+    -- ^ 32-bit floating point+  | F64+    -- ^ 64-bit floating point+  | Decimal+    -- ^ Increased-precision floating point+  | BigSInt32+    -- ^ 32-bit big integer+  | BigSInt64+    -- ^ 64-bit big integer+  | Tuple2 Ty Ty+    -- ^ 2-tuple+  | Tuple3 Ty Ty Ty+    -- ^ 3-tuple+  | Optional Ty+    -- ^ Maybe type+  | Result Ty Ty+    -- ^ Either type+    --+    --   /Note/: The error type in Swift must+    --   implement the @Error@ protocol. This library+    --   currently does not enforce this.+  | Set Ty+    -- ^ Set type+  | Dictionary Ty Ty+    -- ^ Dictionary type+  | Array Ty+    -- ^ array type+  | App Ty Ty+    -- ^ function type+  | Poly String+    -- ^ polymorphic type variable+  | Concrete+      { concreteName :: String+        -- ^ the name of the type+      , concreteTyVars :: [Ty]+        -- ^ the type's type variables+      }+    -- ^ a concrete type variable, and its+    --   type variables. Will typically be generated+    --   by 'getShwifty'.+  | Tag+      { tagName :: String+        -- ^ the name of the type+      , tagParent :: String+        -- ^ the type constructor of the type+        --   to which this alias belongs+      , tagTyp :: Ty+        -- ^ the type that this represents+      , tagDisambiguate :: Bool+        -- ^ does the type need disambiguation?+        --+        --   This will happen if there are multiple+        --   tags with the same type. This is needed+        --   to maintain safety.+      }+    -- ^ A @Tagged@ typealias, for newtyping+    --   in a way that doesn't break Codable.+    --+    --   See 'getShwiftyWithTags' for examples.+  deriving stock (Eq, Show, Read)+  deriving stock (Generic)+  deriving stock (Lift)++-- | A Swift datatype, either a struct (product type)+--   or enum (sum type). Haskll types are+--   sums-of-products, so the way we differentiate+--   when doing codegen,+--   is that types with a single constructor+--   will be converted to a struct, and those with+--   two or more constructors will be converted to an+--   enum. Types with 0 constructors will be converted+--   to an empty enum.+data SwiftData+  = SwiftStruct+      { structName :: String+        -- ^ The name of the struct+      , structTyVars :: [String]+        -- ^ The struct's type variables+      , structProtocols :: [Protocol]+        -- ^ The protocols which the struct+        --   implements+      , structFields :: [(String, Ty)]+        -- ^ The fields of the struct. the pair+        --   is interpreted as (name, type).+      , structPrivateTypes :: [SwiftData]+        -- ^ Private types of the struct. Typically+        --   populated by setting 'makeBase'.+      , structTags :: [Ty]+        -- ^ The tags of the struct. See 'Tag'.+      }+    -- ^ A struct (product type)+  | SwiftEnum+      { enumName :: String+        -- ^ The name of the enum+      , enumTyVars :: [String]+        -- ^ The enum's type variables+      , enumProtocols :: [Protocol]+        -- ^ The protocols which the enum+        --   implements+      , enumCases :: [(String, [(Maybe String, Ty)])]+        -- ^ The cases of the enum. the type+        --   can be interpreted as+        --   (name, [(label, type)]).+      , enumRawValue :: Maybe Ty+        -- ^ The rawValue of an enum. See+        --   https://developer.apple.com/documentation/swift/rawrepresentable/1540698-rawvalue+        --+        --   Typically the 'Ty' will be+        --   'I' or 'String'.+        --+        --   /Note/: Currently, nothing will prevent+        --   you from putting something+        --   nonsensical here.+      , enumPrivateTypes :: [SwiftData]+        -- ^ Private types of the enum. Typically+        --   populated by setting 'makeBase'.+      , enumTags :: [Ty]+        -- ^ The tags of the struct. See 'Tag'.+      }+    -- ^ An enum (sum type)+  | SwiftAlias+      { aliasName :: String+        -- ^ the name of the type alias+      , aliasTyVars :: [String]+        -- ^ the type variables of the type alias+      , aliasTyp :: Ty+        -- ^ the type this represents (RHS)+      }+    -- ^ A /top-level/ type alias+  deriving stock (Eq, Read, Show, Generic)++-- | Swift protocols.+--   Only a few are supported right now.+data Protocol+  = Hashable+    -- ^ The 'Hashable' protocol.+    --   See https://developer.apple.com/documentation/swift/hashable+  | Codable+    -- ^ The 'Codable' protocol.+    --   See https://developer.apple.com/documentation/swift/hashable+  | Equatable+    -- ^ The 'Equatable' protocol.+    --   See https://developer.apple.com/documentation/swift/hashable+  deriving stock (Eq, Read, Show, Generic)+  deriving stock (Lift)++-- | Options that specify how to+--   encode your 'SwiftData' to a swift type.+--+--   Options can be set using record syntax on+--   'defaultOptions' with the fields below.+data Options = Options+  { typeConstructorModifier :: String -> String+    -- ^ Function applied to type constructor names.+    --   The default ('id') makes no changes.+  , fieldLabelModifier :: String -> String+    -- ^ Function applied to field labels.+    --   Handy for removing common record prefixes,+    --   for example. The default ('id') makes no+    --   changes.+  , constructorModifier :: String -> String+    -- ^ Function applied to value constructor names.+    --   The default ('id') makes no changes.+  , optionalExpand :: Bool+    -- ^ Whether or not to truncate Optional types.+    --   Normally, an Optional ('Maybe') is encoded+    --   as "A?", which is syntactic sugar for+    --   "Optional\<A\>". The default value ('False')+    --   will keep it as sugar. A value of 'True'+    --   will expand it to be desugared.+  , generateToSwift :: Bool+    -- ^ Whether or not to generate a 'ToSwift'+    --   instance. Sometime this can be desirable+    --   if you want to define the instance by hand,+    --   or the instance exists elsewhere.+    --   The default is 'True', i.e., to generate+    --   the instance.+  , generateToSwiftData :: Bool+    -- ^ Whether or not to generate a 'ToSwiftData'+    --   instance. Sometime this can be desirable+    --   if you want to define the instance by hand,+    --   or the instance exists elsewhere.+    --   The default is 'True', i.e., to generate+    --   the instance.+  , dataProtocols :: [Protocol]+    -- ^ Protocols to add to a type.+    --   The default (@[]@) will add none.+  , dataRawValue :: Maybe Ty+    -- ^ The rawValue of an enum. See+    --   https://developer.apple.com/documentation/swift/rawrepresentable/1540698-rawvalue+    --+    --   The default ('Nothing') will not+    --   include any rawValue.+    --+    --   Typically, if the type does have+    --   a 'rawValue', the 'Ty' will be+    --   'I' or 'Str'.+    --+    --   /Note/: Currently, nothing will prevent+    --   you from putting something+    --   nonsensical here.+  , typeAlias :: Bool+    -- ^ Whether or not to generate a newtype as+    --   a type alias. Consider if you want this+    --   or to use 'getShwiftyWithTags' instead.+    --+    --   The default ('False') will generate newtypes+    --   as their own structs.+  , newtypeTag :: Bool+    -- ^ Whether or not to generate a newtype as an+    --   empty enum with a tag. This is for type+    --   safety reasons, but with retaining the+    --   ability to have Codable conformance.+    --+    --   The default ('False') will not do this.+    --+    --   /Note/: This takes priority over 'typeAlias'.+    --+    --   /Note/: This option is not currently+    --   supported for newtype instances.+    --+    -- === __Examples__+    --+    -- > newtype NonEmptyText = MkNonEmptyText String+    -- > $(getShwiftyWith (defaultOptions { newtypeTag = True }) ''NonEmpyText)+    --+    -- @+    -- enum NonEmptyTextTag {+    --     typealias NonEmptyText = Tagged\<NonEmptyTextTag, String\>+    -- }+    -- @+  , lowerFirstField :: Bool+    -- ^ Whether or not to lower-case the first+    --   character of a field after applying all+    --   modifiers to it.+    --+    --   The default ('True') will do so.+  , lowerFirstCase :: Bool+    -- ^ Whether or not to lower-case the first+    --   character of a case after applying all+    --   modifiers to it.+    --+    --   The default ('True') will do so.+  , omitFields :: [String]+    -- ^ Fields to omit from a struct when+    --   generating types.+    --+    --   The default (@[]@) will omit nothing.+  , omitCases :: [String]+    -- ^ Cases to omit from an enum when+    --   generating types.+    --+    --   The default (@[]@) will omit nothing.+  , makeBase :: (Bool, Maybe Ty, [Protocol])+    -- ^ Whether or not to make a base type,+    --   its raw value, and its protocols.+    --+    --   Here, "base type" refers to a+    --   version of the type without any fields.+    --   This can be useful for doing Codable+    --   conversions.+    --+    --   The default ('False', 'Nothing', @[]@)+    --   will not create the base type.+  }