diff --git a/aeson-flowtyped.cabal b/aeson-flowtyped.cabal --- a/aeson-flowtyped.cabal +++ b/aeson-flowtyped.cabal @@ -1,11 +1,7 @@ --- This file has been generated from package.yaml by hpack version 0.17.0. --- --- see: https://github.com/sol/hpack - name: aeson-flowtyped -version: 0.9.1 -synopsis: Create Flow type definitions from Haskell data types. -description: Create Flow type definitions from Haskell data types. +version: 0.12.0 +synopsis: Create Flow or TypeScript type definitions from Haskell data types. +description: Create Flow or TypeScript type definitions from Haskell data types. category: Web homepage: https://github.com/mikeplus64/aeson-flowtyped#readme bug-reports: https://github.com/mikeplus64/aeson-flowtyped/issues @@ -24,19 +20,21 @@ hs-source-dirs: src build-depends: - base >= 4.9 && <4.11 - , aeson >= 0.8 - , vector - , text - , recursion-schemes + aeson >=0.8 + , base >= 4.11 && < 4.16 , containers + , data-fix + , deriving-compat + , free + , recursion-schemes + , reflection + , scientific + , text , time + , mtl , unordered-containers - , reflection + , vector , wl-pprint - , free - , scientific - , transformers exposed-modules: Data.Aeson.Flow other-modules: @@ -46,17 +44,20 @@ test-suite aeson-flowtyped type: exitcode-stdio-1.0 main-is: Spec.hs + other-modules: + Paths_aeson_flowtyped hs-source-dirs: test build-depends: - base >= 4.9 && <4.11 - , aeson >= 0.8 - , vector - , text - , recursion-schemes - , containers + aeson >=0.8 , aeson-flowtyped + , base + , containers + , data-fix + , recursion-schemes , tasty , tasty-hunit + , text , unordered-containers + , vector default-language: Haskell2010 diff --git a/src/Data/Aeson/Flow.hs b/src/Data/Aeson/Flow.hs --- a/src/Data/Aeson/Flow.hs +++ b/src/Data/Aeson/Flow.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -15,50 +17,86 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} -- | Derive using aeson 'Options'. +-- +-- Does not currently support the 'unwrapUnaryRecords' option. module Data.Aeson.Flow ( -- * AST types FlowTyped (..) + , callType + , FlowTypeF , FlowType - , Fix (..) - , FlowTypeF (..) + -- , Fix (..) + , pattern FObject + , pattern FExactObject + , pattern FObjectMap + , pattern FArray + , pattern FTuple + , pattern FLabelledTuple + , pattern FFun + , pattern FAlt + , pattern FPrim + , pattern FPrimBoolean + , pattern FPrimNumber + , pattern FPrimString + , pattern FPrimBottom + , pattern FPrimMixed + , pattern FPrimUnknown + , pattern FPrimNull + , pattern FPrimNever + , pattern FPrimUndefined + , pattern FPrimAny + , pattern FNullable + , pattern FOmitable + , pattern FLiteral + , pattern FTag + , pattern FName + , pattern FGenericParam + , pattern FCallType -- * Code generation -- ** Wholesale ES6/flow modules - , FlowModuleOptions (..) - , defaultFlowModuleOptions - , Export (..) - , generateFlowModule - , writeFlowModule - , exportFlowTypeAs - , flowTypeAs - -- * Utility functions + , Export + , export + , RenderMode (..) + , RenderOptions (..) + , ModuleOptions (..) + , typeScriptModuleOptions + , flowModuleOptions + , generateModule + , writeModule + , showTypeAs + , exportTypeAs + -- ** TS specific + , showTypeScriptType + -- ** Flow specific , showFlowType - , dependencies + -- * Dependencies , exportsDependencies - -- * Internals - , defaultFlowType - , defaultFlowTypeName + , dependencies + -- * Utility + , FlowCallable , FlowName (..) - , PrimType (..) - , GFlowTyped - , FlowTypeI - , Info (..) - , Var (..) + , Flowable (..) + , FlowTyFields (..) + , FlowDeconstructField , Typeable , typeRep ) where import Control.Monad -import Control.Monad.Trans.State.Strict +import Control.Monad.State.Strict +import Control.Monad.Reader import qualified Data.Aeson as A import Data.Aeson.Types (Options (..), SumEncoding (..)) +import Data.Eq.Deriving (deriveEq1) +import Data.Fix (Fix (..)) import Data.Fixed (Fixed) -import Data.Foldable import Data.Functor.Classes import Data.Functor.Compose import Data.Functor.Foldable hiding (fold) @@ -69,8 +107,11 @@ import qualified Data.IntMap.Strict as I import qualified Data.IntSet as IntSet import Data.Kind (Type) +import Data.List (foldl') import Data.Map.Strict (Map) import qualified Data.Map.Strict as M +import Data.Maybe +import Data.Semigroup hiding (Any) import Data.Proxy import Data.Reflection import Data.Scientific (Scientific) @@ -88,12 +129,57 @@ import qualified Data.Vector.Unboxed as VU import qualified Data.Void as Void import Data.Word -import Data.Maybe -import Debug.Trace import GHC.Generics import GHC.TypeLits import qualified Text.PrettyPrint.Leijen as PP +import qualified Type.Reflection as TR +import Debug.Trace + +-- | The main AST for flowtypes. +data FlowTypeF a + = Object !(HashMap Text a) + | ExactObject !(HashMap Text a) + | ObjectMap !Text a a + | Array a + | Tuple !(Vector a) + | LabelledTuple !(Vector (Maybe Text, a)) + | Fun !(Vector (Text, a)) a + | Alt a a + | Prim !PrimType + | Nullable a + | Omitable a -- ^ omitable when null or undefined + | Literal !A.Value + | Tag !Text + | GenericParam !Int + | CallType !FlowName [a] + | SomeFlowType !Flowable + deriving (Show, Eq, Functor, Traversable, Foldable) + +-- | A primitive flow/javascript type +data PrimType + = Boolean + | Number + | String + | Null + | Undefined + | Bottom -- ^ uninhabited type; @never@ in typescript, and @empty@ in flow + | Mixed -- ^ @unknown@ in typescript, @mixed@ in flow + | Any + deriving (Show, Read, Eq, Ord) + +-- | A name for a flowtyped data-type. These are returned by 'dependencies'. +data FlowName where + FlowName :: (FlowCallable a) => Proxy a -> Text -> FlowName + +data Flowable where + Flowable :: (FlowCallable a) => Proxy a -> Flowable + +data Showy f a = forall s. Reifies s (Int -> a -> ShowS) => Showy (f (Inj s a)) +instance Show1 (Showy FlowTypeF) where + liftShowsPrec _ _ i (Showy a) = showsPrec i a + + -------------------------------------------------------------------------------- -- Magical newtype for injecting showsPrec into any arbitrary Show @@ -102,40 +188,32 @@ newtype Inj s a = Inj a -- needs UndecidableInstances + instance Reifies s (Int -> a -> ShowS) => Show (Inj s a) where showsPrec i (Inj a) = reflect (Proxy :: Proxy s) i a -data Showy f a = forall s. Reifies s (Int -> a -> ShowS) => Showy (f (Inj s a)) -instance Show1 (Showy FlowTypeF) where - liftShowsPrec _ _ i (Showy a) = showsPrec i a - -------------------------------------------------------------------------------- --- | A primitive flow/javascript type -data PrimType - = Boolean - | Number - | String - | Void - | Mixed - | Any - deriving (Show, Read, Eq, Ord) +data RenderMode = RenderTypeScript | RenderFlow + deriving (Eq, Show) --- | A name for a flowtyped data-type. These are returned by 'dependencies'. -data FlowName where - FlowName :: (Typeable a, FlowTyped a) => Proxy a -> Text -> FlowName +data RenderOptions = RenderOptions + { renderMode :: !RenderMode + } deriving (Eq, Show) instance Show FlowName where show (FlowName _ t) = show t instance Eq FlowName where - FlowName _ n0 == FlowName _ n1 = n0 == n1 + FlowName (t0 :: Proxy t0) n0 == FlowName (t1 :: Proxy t1) n1 = + case eqT :: Maybe (t0 :~: t1) of + Just Refl -> (t0, n0) == (t1, n1) + Nothing -> False instance Ord FlowName where - FlowName _ n0 `compare` FlowName _ n1 = compare n0 n1 - -data Flowable where - Flowable :: (Typeable a, FlowTyped a) => Proxy a -> Flowable + FlowName t0 n0 `compare` FlowName t1 n1 = n0 `compare` n1 + -- XXX this breaks using (typeRep t0, n0) `compare` (typeRep t1, n1) for some + -- reason... dunno why instance Show Flowable where show (Flowable t) = show (typeRep t) @@ -143,53 +221,120 @@ instance Eq Flowable where Flowable a == Flowable b = typeRep a == typeRep b --- | The main AST for flowtypes. +instance Ord Flowable where + Flowable a `compare` Flowable b = typeRep a `compare` typeRep b -data FlowTypeF a - = Object !(HashMap Text a) - | ExactObject !(HashMap Text a) - | ObjectMap !Text a - | Array a - | Tuple !(Vector a) - | Fun !(Vector (Text, a)) a - | Alt a a - | Prim !PrimType - | Nullable a - | Omitable a - | Literal !A.Value - | Tag !Text - | Name !FlowName - | Instantiate !TypeRep a - | PolyVar !TypeRep - | PolyUse !Flowable - | PolyApply a [a] - deriving (Show, Eq, Functor, Traversable, Foldable) --- XXX: vector >= 0.12 has Eq1 vector which allows us to use eq for Fix FlowTypeF --- and related types +-- XXX: vector >= 0.12 has Eq1 vector which allows us to use eq for Fix +-- FlowTypeF and related types +-------------------------------------------------------------------------------- + +pattern FObject :: HashMap Text FlowType -> FlowType +pattern FObject x = Fix (Object x) + +pattern FExactObject :: HashMap Text FlowType -> FlowType +pattern FExactObject x = Fix (ExactObject x) + +pattern FObjectMap :: Text -> FlowType -> FlowType -> FlowType +pattern FObjectMap keyName keyType vals = Fix (ObjectMap keyName keyType vals) + +pattern FArray :: FlowType -> FlowType +pattern FArray a = Fix (Array a) + +pattern FTuple :: Vector FlowType -> FlowType +pattern FTuple a = Fix (Tuple a) + +pattern FLabelledTuple :: Vector (Maybe Text, FlowType) -> FlowType +pattern FLabelledTuple a = Fix (LabelledTuple a) + +pattern FFun :: Vector (Text, FlowType) -> FlowType -> FlowType +pattern FFun v t = Fix (Fun v t) + +pattern FAlt :: FlowType -> FlowType -> FlowType +pattern FAlt a b = Fix (Alt a b) + +pattern FPrim :: PrimType -> FlowType +pattern FPrim a = Fix (Prim a) + +pattern FPrimBoolean :: FlowType +pattern FPrimBoolean = FPrim Boolean + +pattern FPrimNumber :: FlowType +pattern FPrimNumber = FPrim Number + +pattern FPrimString :: FlowType +pattern FPrimString = FPrim String + +pattern FPrimBottom :: FlowType +pattern FPrimBottom = FPrim Bottom + +pattern FPrimMixed :: FlowType +pattern FPrimMixed = FPrim Mixed + +pattern FPrimUnknown :: FlowType +pattern FPrimUnknown = FPrim Mixed + +pattern FPrimAny :: FlowType +pattern FPrimAny = FPrim Any + +pattern FPrimNever :: FlowType +pattern FPrimNever = FPrim Bottom + +pattern FPrimNull :: FlowType +pattern FPrimNull = FPrim Null + +pattern FPrimUndefined :: FlowType +pattern FPrimUndefined = FPrim Undefined + +pattern FNullable :: FlowType -> FlowType +pattern FNullable a = Fix (Nullable a) + +pattern FOmitable :: FlowType -> FlowType +pattern FOmitable a = Fix (Omitable a) + +pattern FLiteral :: A.Value -> FlowType +pattern FLiteral a = Fix (Literal a) + +pattern FTag :: Text -> FlowType +pattern FTag a = Fix (Tag a) + +pattern FName :: FlowName -> FlowType +pattern FName a = Fix (CallType a []) + +pattern FGenericParam :: Int -> FlowType +pattern FGenericParam a = Fix (GenericParam a) + +pattern FCallType :: FlowName -> [FlowType] -> FlowType +pattern FCallType f xs = Fix (CallType f xs) + +-------------------------------------------------------------------------------- + instance Show1 FlowTypeF where liftShowsPrec sp sl i a = liftShowsPrec sp sl i (reify sp (\p -> Showy (fmap (inj p) a))) -data Info a = Constr !Text FlowTypeI a | NoInfo a +data GFlowInfo a = Constr !Text GFlowTypeI a | NoInfo a deriving (Show, Functor, Traversable, Foldable) -instance Show1 (Showy Info) where +instance Show1 (Showy GFlowInfo) where liftShowsPrec _ _ i (Showy a) = showsPrec i a -instance Show1 Info where +instance Show1 GFlowInfo where liftShowsPrec sp sl i a = liftShowsPrec sp sl i (reify sp (\p -> Showy (fmap (inj p) a))) -type FlowTypeI = Fix (Info `Compose` FlowTypeF) +type GFlowTypeI = Fix (GFlowInfo `Compose` FlowTypeF) type FlowType = Fix FlowTypeF text :: Text -> PP.Doc text = PP.text . T.unpack -type Poly = State (Map TypeRep Text) +squotes :: Text -> PP.Doc +squotes = PP.squotes . text . T.replace "'" "\\'" +type Poly = ReaderT RenderOptions (Reader [Flowable]) + ppAlts :: [FlowType] -> FlowType -> Poly PP.Doc ppAlts alts (Fix f) = case f of Alt a b -> ppAlts (a:alts) b @@ -216,7 +361,7 @@ ppJson :: A.Value -> PP.Doc ppJson v = case v of A.Array a -> PP.list (map ppJson (V.toList a)) - A.String t -> PP.squotes (text t) + A.String t -> squotes t A.Number n -> PP.string (show n) A.Bool t -> if t then PP.string "true" else PP.string "false" A.Null -> PP.string "null" @@ -241,205 +386,289 @@ ppField (name, fty) = do case fty of Fix (Omitable fty') -> + -- key?: type (\fty'' -> text name PP.<> PP.text "?" PP.<> PP.colon PP.<+> fty'') <$> pp fty' + fty' -> + -- key: type (\fty'' -> text name PP.<> PP.colon PP.<+> fty'') <$> pp fty' -getVar :: TypeRep -> Poly Text -getVar rep = do - s <- get - case M.lookup rep s of - Just i -> return i - Nothing -> do - let r = polyVarNames !! M.size s - r <$ modify' (M.insert rep r) - polyVarNames :: [Text] polyVarNames = map T.singleton ['A'..'Z'] ++ zipWith (\i t -> t `T.append` T.pack (show i)) [0 :: Int ..] polyVarNames -pp :: FlowType -> Poly PP.Doc +pp :: FlowType -> Poly PP.Doc pp (Fix ft) = case ft of - ObjectMap keyName a -> + ObjectMap keyName keyType a -> (\r -> braceList [ PP.brackets (text keyName PP.<> PP.text ": string") PP.<> PP.colon PP.<+> r ]) <$> pp a - Object hm -> braceList <$> ppObject hm - ExactObject hm -> braceBarList <$> ppObject hm - Array a -> (\r -> mayWrap a r PP.<> PP.string "[]") <$> pp a - Tuple t -> PP.list <$> mapM pp (V.toList t) - Alt a b -> ppAlts [a] b - Prim pt -> return $ case pt of - Boolean -> PP.text "boolean" - Number -> PP.text "number" - String -> PP.text "string" - Void -> PP.text "void" - Any -> PP.text "any" - Mixed -> PP.text "mixed" - Nullable a -> (\r -> PP.char '?' PP.<> mayWrap a r) <$> pp a - Omitable a -> (\r -> PP.char '?' PP.<> mayWrap a r) <$> pp a -- hopefully these are caught - Literal a -> return (ppJson a) - Tag t -> return (PP.squotes (text t)) - Name (FlowName _ t) -> return (text t) - PolyVar rep -> text <$> getVar rep - PolyUse (Flowable fp) -> pp (flowType fp) - PolyApply a vars -> do - n <- pp a - vs <- mapM pp vars - return (n PP.<> PP.angles (PP.hsep (PP.punctuate PP.comma vs))) - _ -> return (PP.string (show ft)) + Object hm -> + braceList <$> ppObject hm + + ExactObject hm -> do + mode <- asks renderMode + case mode of + RenderFlow -> braceBarList <$> ppObject hm + RenderTypeScript -> braceList <$> ppObject hm + + -- x[] + Array a -> + (\r -> mayWrap a r PP.<> PP.string "[]") <$> pp a + + -- [x, y, z] + Tuple t -> + PP.list <$> mapM pp (V.toList t) + + -- [l1: x, y, l2: z] + LabelledTuple t -> PP.list <$> mapM + (\(mlbl, ty) -> case mlbl of + Just lbl -> ((text lbl PP.<> PP.string ":") PP.<+>) <$> pp ty + Nothing -> pp ty) + (V.toList t) + + Alt a b -> + ppAlts [a] b + + Prim pt -> do + mode <- asks renderMode + return $ case pt of + Boolean -> PP.text "boolean" + Number -> PP.text "number" + String -> PP.text "string" + Null -> PP.text "null" + Undefined -> PP.text "undefined" + Any -> PP.text "any" + Mixed -> case mode of + RenderFlow -> PP.text "mixed" + RenderTypeScript -> PP.text "unknown" + Bottom -> case mode of + RenderFlow -> PP.text "empty" + RenderTypeScript -> PP.text "never" + + Nullable a -> + -- n.b. there is no 'undefined' in json. void is undefined | null in both ts + -- and flow (and ?x syntax for void|x) + (\a' -> PP.text "null" PP.<+> PP.string "|" PP.<+> a') <$> pp a + + Omitable a -> + pp (FNullable a) + + Literal a -> + return (ppJson a) + + Tag t -> + return (squotes t) + + GenericParam ix -> + return (text (polyVarNames !! ix)) + {- + opts <- ask + params <- lift ask + let ft | ix < length params = case params !! ix of + Flowable p -> callType p + | otherwise = FPrimNever + let r = runReaderT (pp ft) opts `runReader` [] + return r + -} + + CallType (FlowName _ t) [] -> + return (text t) + + CallType (FlowName _ t) args -> do + vs <- mapM pp args + return (text t PP.<> PP.angles (PP.hsep (PP.punctuate PP.comma vs))) + + _ -> + return (PP.string (show ft)) + -- | Pretty-print a flowtype in flowtype syntax -showFlowType :: FlowType -> Text -showFlowType ft = T.pack (show (evalState (pp ft) M.empty)) +renderTypeWithOptions :: RenderOptions -> FlowType -> [Flowable] -> PP.Doc +renderTypeWithOptions opts ft params = + (pp ft `runReaderT` opts) `runReader` params +-- | Pretty-print a flowtype in flowtype syntax +showFlowType :: FlowType -> [Flowable] -> Text +showFlowType ft params = + T.pack . show $ renderTypeWithOptions RenderOptions{renderMode=RenderFlow} ft params + +-- | Pretty-print a flowtype in flowtype syntax +showTypeScriptType :: FlowType -> [Flowable] -> Text +showTypeScriptType ft params = + T.pack . show $ renderTypeWithOptions RenderOptions{renderMode=RenderTypeScript} ft params + -------------------------------------------------------------------------------- -- Module exporting -- | Generate a @ export type @ declaration. -exportFlowTypeAs :: Text -> FlowType -> Text -exportFlowTypeAs = flowTypeAs True +exportTypeAs :: RenderOptions -> Text -> FlowType -> [Flowable] -> Text +exportTypeAs opts = showTypeAs opts True --- | Generate a @ export type @ declaration. -flowTypeAs :: Bool -> Text -> FlowType -> Text -flowTypeAs isExport name ft = +-- | Generate a @ type @ declaration, possibly an export. +showTypeAs :: RenderOptions -> Bool -> Text -> FlowType -> [Flowable] -> Text +showTypeAs opts isExport name ft params = T.pack . render $ - PP.string (if isExport then "export type " else "type ") PP.<> - PP.string (T.unpack name) PP.<> withVars (runState (pp ft) M.empty) + PP.string (if isExport then "export type " else "type ") + PP.<> text name + PP.<> renderedParams + PP.<+> text "=" + PP.<+> PP.indent 2 renderedTypeDecl + PP.<> text ";" + PP.<> PP.linebreak where - main r = PP.string "=" PP.<$> PP.indent 2 r PP.<> PP.string ";" - withVars (r, vars) - | M.null vars = PP.space PP.<> main r - | otherwise = PP.angles (PP.hsep - (PP.punctuate PP.comma (map text (M.elems vars)))) - PP.<+> - main r + renderedTypeDecl = renderTypeWithOptions opts ft params + renderedParams + | null params = mempty + | otherwise = + PP.angles (PP.hsep + (PP.punctuate PP.comma + (map text (take (length params) polyVarNames)))) + render = ($[]) . PP.displayS . PP.renderPretty 1.0 80 -- | Compute all the dependencies of a 'FlowTyped' thing, including itself. -dependencies :: (Typeable a, FlowTyped a) => Proxy a -> Set.Set FlowName -dependencies p0 = M.foldlWithKey' - (\acc k a -> Set.insert k (Set.union a acc)) - Set.empty - (go p0 M.empty) +dependencies :: (FlowCallable a) => Proxy a -> Set.Set FlowName +dependencies p0 = + (case flowTypeName p0 of + Just t -> Set.insert (FlowName p0 t) + Nothing -> id) + (M.foldl' Set.union Set.empty (transitiveDeps (Flowable p0) M.empty)) where - -- XXX: catch mutual recursion - addImmediateDeps :: FlowName - -> Map FlowName (Set.Set FlowName) - -> Map FlowName (Set.Set FlowName) - addImmediateDeps fn@(FlowName p _) acc0 = - foldr - (\(FlowName p _) -> go p) - (M.insert fn sub acc0) - sub - where sub = immediateDeps (flowType p) + flowNameToFlowable (FlowName fn _) = Flowable fn - go :: (FlowTyped a, Typeable a) - => Proxy a - -> Map FlowName (Set.Set FlowName) - -> Map FlowName (Set.Set FlowName) - go p acc = - case FlowName p <$> flowTypeName p of - Just fn | fn `M.notMember` acc -> addImmediateDeps fn acc - _ -> acc + immediateDeps :: FlowType -> Set.Set FlowName + immediateDeps (FCallType n tys) = Set.insert n (Set.unions (map immediateDeps tys)) + immediateDeps (Fix p) = foldMap immediateDeps p -immediateDeps :: FlowType -> Set.Set FlowName -immediateDeps (Fix (Name n)) = Set.singleton n -immediateDeps (Fix p) = foldMap immediateDeps p + transitiveDeps + :: Flowable + -> M.Map Flowable (Set.Set FlowName) + -> M.Map Flowable (Set.Set FlowName) + transitiveDeps fpf@(Flowable p) acc + | fpf `M.notMember` acc = + let + imms = immediateDeps (flowType p) + withThis = M.insert fpf imms acc + in + Set.foldr' (\x xs -> transitiveDeps (flowNameToFlowable x) xs) withThis imms + | otherwise = acc -data FlowModuleOptions = FlowModuleOptions +data ModuleOptions = ModuleOptions { -- | You might want to change this to include e.g. flow-runtime - flowPragmas :: [Text] - , flowHeader :: [Text] - , flowExportDeps :: Bool - , flowComputeDeps :: Bool + pragmas :: [Text] + , header :: [Text] + , exportDeps :: Bool + , computeDeps :: Bool + , renderOptions :: RenderOptions } deriving (Eq, Show) -defaultFlowModuleOptions :: FlowModuleOptions -defaultFlowModuleOptions = FlowModuleOptions - { flowPragmas = ["// @flow"] - , flowHeader = ["This module has been generated by aeson-flowtyped."] - , flowExportDeps = True - , flowComputeDeps = True +flowModuleOptions :: ModuleOptions +flowModuleOptions = ModuleOptions + { pragmas = ["// @flow"] + , header = ["This module has been generated by aeson-flowtyped."] + , exportDeps = True + , computeDeps = True + , renderOptions = RenderOptions{renderMode = RenderFlow} } +typeScriptModuleOptions :: ModuleOptions +typeScriptModuleOptions = ModuleOptions + { pragmas = [] + , header = ["This module has been generated by aeson-flowtyped."] + , exportDeps = True + , computeDeps = True + , renderOptions = RenderOptions{renderMode = RenderTypeScript} + } + data Export where - Export :: (Typeable a, FlowTyped a) - => Proxy a - -> Export + Export :: (FlowCallable a) => Proxy a -> Export +export :: forall a. (FlowCallable a) => Export +export = Export (Proxy :: Proxy a) + instance Eq Export where Export p0 == Export p1 = flowTypeName p0 == flowTypeName p1 || typeRep p0 == typeRep p1 exportsDependencies :: [Export] -> Set.Set FlowName -exportsDependencies = foldMap (\(Export a) -> dependencies a) +exportsDependencies = foldMap $ \e -> case e of + Export a -> dependencies a -generateFlowModule :: FlowModuleOptions -> [Export] -> Text -generateFlowModule opts exports = - T.unlines - . (\m -> - (flowPragmas opts ++ map ("// " `T.append`) (flowHeader opts)) ++ - (T.empty : m)) +generateModule :: ModuleOptions -> [Export] -> Text +generateModule opts exports = T.unlines $ + (\m -> (pragmas opts ++ map ("// " `T.append`) (header opts)) ++ + (T.empty : m)) . map flowDecl . flowNames $ exports where flowNames = - if flowComputeDeps opts + if computeDeps opts then Set.toList . exportsDependencies - else catMaybes . map (\(Export p) -> FlowName p <$> flowTypeName p) + else catMaybes . map (\ex -> case ex of + Export p -> FlowName p <$> flowTypeName p) flowDecl (FlowName p name) = - if Export p `elem` exports || flowExportDeps opts - then flowTypeAs True name (flowType p) - else flowTypeAs False name (flowType p) + if Export p `elem` exports || exportDeps opts + then showTypeAs (renderOptions opts) True name (flowType p) (flowTypeVars p) + else showTypeAs (renderOptions opts) False name (flowType p) (flowTypeVars p) -writeFlowModule :: FlowModuleOptions -> FilePath -> [Export] -> IO () -writeFlowModule opts path = - TIO.writeFile path . generateFlowModule opts +writeModule :: ModuleOptions -> FilePath -> [Export] -> IO () +writeModule opts path = + TIO.writeFile path . generateModule opts -------------------------------------------------------------------------------- -- | 'flowType' using 'Generic' defaultFlowType :: (Generic a, GFlowTyped (Rep a)) => Options -> Proxy a -> FlowType -defaultFlowType opt p = gflowType opt (fmap from p) +defaultFlowType opt p + | unwrapUnaryRecords opt = error "aeson-flowtype does not yet support the unwrapUnaryRecords option." + | otherwise = gflowType opt (fmap from p) -- | 'flowTypeName' using 'Generic' defaultFlowTypeName :: (Generic a, Rep a ~ D1 ('MetaData name mod pkg t) c, KnownSymbol name) => Proxy a -> Maybe Text -defaultFlowTypeName p = Just (T.pack (symbolVal (pGetName (fmap from p)))) +defaultFlowTypeName p + = Just + . cleanup + . T.pack + . symbolVal + . pGetName + . fmap from + $ p where pGetName :: Proxy (D1 ('MetaData name mod pkg t) c x) -> Proxy name pGetName _ = Proxy -flowTypePreferName :: (Typeable a, FlowTyped a) => Proxy a -> FlowType -flowTypePreferName p = fromMaybe (flowType p) (flowTypeRecur p) + cleanup = T.replace "'" "_" -- I think this is the only illegal token in JS + -- that's allowed in Haskell, other than type + -- operators... TODO, rename type operators -flowTypeRecur :: (Typeable a, FlowTyped a) => Proxy a -> Maybe FlowType -flowTypeRecur p = case flowTypeName p of - Just n - | null vars -> Just name - | otherwise -> Just (Fix (PolyApply name (map doPoly vars))) - where - doPoly :: TypeRep -> FlowType - doPoly = Fix . PolyVar - vars = flowTypeVars p - name = Fix (Name (FlowName p n)) - Nothing -> Nothing +callType' :: (FlowCallable a) => Proxy a -> [FlowType] -> FlowType +callType' p args = case flowTypeName p of + Just n -> FCallType (FlowName p n) args + Nothing -> flowType p + where + vars = flowTypeVars p +callType :: forall a. FlowCallable a => Proxy a -> FlowType +callType p = callType' p (map (\(Flowable t) -> callType t) (flowTypeVars p)) + +type FlowCallable a = (Typeable a, FlowTyped a) + class FlowTyped a where flowType :: Proxy a -> FlowType flowTypeName :: Proxy a -> Maybe Text - flowTypeVars :: Proxy a -> [TypeRep] + flowTypeVars :: Proxy a -> [Flowable] flowTypeVars _ = [] flowOptions :: Proxy a -> Options @@ -457,35 +686,95 @@ -> Maybe Text flowTypeName = defaultFlowTypeName +data Param (p :: Nat) = Param + +-------------------------------------------------------------------------------- + +type family FlowDeconstructField (k :: t) :: (Symbol, Type) +type instance FlowDeconstructField '(a, b) = '(a, b) + +-- | Useful for declaring flowtypes from type-level key/value sets, like +-- +-- @ +-- FlowTyFields :: FlowTyFields Person '['("name", String), '("email", String)] +-- @ +data FlowTyFields :: Type -> [k] -> Type where + FlowTyFields :: FlowTyFields k fs + +class ReifyFlowTyFields a where + reifyFlowTyFields :: Proxy a -> HashMap Text FlowType -> HashMap Text FlowType + +instance ReifyFlowTyFields '[] where + reifyFlowTyFields _ = id + +instance ( FlowDeconstructField x ~ '(k, v) + , KnownSymbol k + , FlowTyped v + , ReifyFlowTyFields xs + ) => + ReifyFlowTyFields (x:xs) where + reifyFlowTyFields _ acc = + reifyFlowTyFields (Proxy :: Proxy xs) $! + H.insert + (T.pack (symbolVal (Proxy :: Proxy k))) + (flowType (Proxy :: Proxy v)) + acc + +instance (FlowTyped a, ReifyFlowTyFields fs) => FlowTyped (FlowTyFields a fs) where + flowType _ = FExactObject (reifyFlowTyFields (Proxy :: Proxy fs) H.empty) + flowTypeName _ = flowTypeName (Proxy :: Proxy a) + +-------------------------------------------------------------------------------- + class GFlowTyped g where gflowType :: Options -> Proxy (g x) -> FlowType class GFlowVal g where - gflowVal :: Options -> Proxy (g x) -> FlowTypeI + gflowVal :: Options -> Proxy (g x) -> GFlowTypeI instance (KnownSymbol name, GFlowVal c) => GFlowTyped (D1 ('MetaData name mod pkg t) c) where - gflowType opt _ = runFlowI (checkNullary (gflowVal opt (Proxy :: Proxy (c x)))) + gflowType opt _ = runFlowI (postprocess (gflowVal opt (Proxy :: Proxy (c x)))) where - checkNullary :: FlowTypeI -> FlowTypeI - checkNullary i + postprocess :: GFlowTypeI -> GFlowTypeI + postprocess i +#if MIN_VERSION_aeson(1,2,0) + | not (tagSingleConstructors opt), Just o <- removeSingleConstructorTag i = + o +#endif | allNullaryToStringTag opt, Just r <- go [] i, not (null r) = foldr1 (\a b -> FC (NoInfo (Alt a b))) (map (FC . NoInfo . Tag) r) | otherwise = i where - -- single-constructor data types have a "contents" field of Prim Void - isNullary :: FlowTypeI -> Bool - isNullary (FC (Info (Prim Void))) = True - isNullary _ = False +#if MIN_VERSION_aeson(1,2,0) + removeSingleConstructorTag :: GFlowTypeI -> Maybe GFlowTypeI + removeSingleConstructorTag (FC (Info (ExactObject hm))) = + case sumEncoding opt of + TaggedObject tfn _ -> + Just (FC (Info (ExactObject (H.delete (T.pack tfn) hm)))) + _ -> + Nothing + removeSingleConstructorTag _ = + Nothing +#endif + -- no-field constructors have a "contents" field of Prim Void + isNullary :: GFlowTypeI -> Bool + isNullary (FC (Info (Prim a))) = case a of + Bottom -> True + Null -> True + Undefined -> True + _ -> False + isNullary _ = False + -- try to detect if the type is a bunch of single-constructor -- alternatives -- -- XXX: this should preserve the order in which they are declared -- ... but does it? - go :: [Text] -> FlowTypeI -> Maybe [Text] + go :: [Text] -> GFlowTypeI -> Maybe [Text] go alts (FC (Constr name h _)) = (name:alts) <$ guard (isNullary h) go alts (FC (NoInfo (Alt a b))) = case (a, b) of @@ -505,7 +794,7 @@ go _ _ = Nothing - runFlowI :: FlowTypeI -> FlowType + runFlowI :: GFlowTypeI -> FlowType runFlowI = cata $ \(Compose i) -> case i of Constr _name _t a -> Fix a NoInfo a -> Fix a @@ -526,17 +815,17 @@ gfieldName opt _ = T.pack (fieldLabelModifier opt (symbolVal (Proxy :: Proxy name))) -noInfo :: f (Fix (Compose Info f)) -> Fix (Compose Info f) +noInfo :: f (Fix (Compose GFlowInfo f)) -> Fix (Compose GFlowInfo f) noInfo = Fix . Compose . NoInfo -infoConstr :: Text -> FlowTypeI -> f (Fix (Compose Info f)) -> Fix (Compose Info f) +infoConstr :: Text -> GFlowTypeI -> f (Fix (Compose GFlowInfo f)) -> Fix (Compose GFlowInfo f) infoConstr tag nxt = Fix . Compose . Constr tag nxt -discardInfo :: Info a -> a +discardInfo :: GFlowInfo a -> a discardInfo (NoInfo a) = a discardInfo (Constr _ _ a) = a -pattern Info :: a -> Info a +pattern Info :: a -> GFlowInfo a pattern Info a <- (discardInfo -> a) where Info = NoInfo @@ -545,20 +834,22 @@ instance (KnownSymbol conName, GFlowRecord r) => GFlowVal (C1 ('MetaCons conName fx 'True) r) where - gflowVal opt p = noInfo $ case sumEncoding opt of - TaggedObject tfn _ -> ExactObject $! - H.insert (T.pack tfn) (noInfo (Tag tagName)) - next - UntaggedValue -> Object next - ObjectWithSingleField -> ExactObject (H.fromList [(tagName, noInfo (Object next))]) - TwoElemArray -> Tuple (V.fromList [noInfo (Tag tagName), noInfo (Object next)]) + gflowVal opt p + | H.size next == 1 = head (H.elems next) + | otherwise = noInfo $ case sumEncoding opt of + TaggedObject tfn _ -> ExactObject $! + H.insert (T.pack tfn) (noInfo (Tag tagName)) + next + UntaggedValue -> Object next + ObjectWithSingleField -> ExactObject (H.fromList [(tagName, noInfo (Object next))]) + TwoElemArray -> Tuple (V.fromList [noInfo (Tag tagName), noInfo (Object next)]) where omitNothings = if omitNothingFields opt - then H.map $ \(Fix t) -> Fix $ case t of - Nullable a -> Omitable a + then H.map $ \t -> case t of + FNullable a -> FOmitable a _ -> t - else id + else traceShow opt id next = H.map @@ -584,8 +875,9 @@ instance GFlowVal f => GFlowVal (M1 i ('MetaSel mj du ds dl) f) where gflowVal opt p = gflowVal opt (fmap unM1 p) -instance (Typeable r, FlowTyped r) => GFlowVal (Rec0 r) where - gflowVal _opt p = cata noInfo (flowTypePreferName (fmap unK1 p)) +instance FlowCallable r => GFlowVal (Rec0 r) where + gflowVal _opt (p :: r' x) = + cata noInfo (callType (fmap unK1 p)) instance (GFlowVal a, GFlowVal b) => GFlowVal (a :+: b) where gflowVal opt _ = noInfo @@ -605,7 +897,7 @@ b@(Fix (Compose (Info fB))) = gflowVal opt (Proxy :: Proxy (b x)) instance GFlowVal U1 where - gflowVal _ _ = noInfo (Prim Void) + gflowVal _ _ = noInfo (Prim Undefined) class GFlowRecord a where gflowRecordFields :: Options -> Proxy (a x) -> HashMap Text FlowType @@ -631,161 +923,197 @@ -------------------------------------------------------------------------------- -- Instances -instance (Typeable a, FlowTyped a) => FlowTyped [a] where - flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) +instance (FlowCallable a) => FlowTyped [a] where + flowType _ = FArray (callType (Proxy :: Proxy a)) isPrim _ = True flowTypeName _ = Nothing -instance (FlowTyped a, Typeable a) => FlowTyped (Vector a) where - flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) +instance (FlowCallable a) => FlowTyped (Vector a) where + flowType _ = FArray (callType (Proxy :: Proxy a)) isPrim _ = True flowTypeName _ = Nothing -instance (FlowTyped a, Typeable a) => FlowTyped (VU.Vector a) where - flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) +instance (FlowCallable a) => FlowTyped (VU.Vector a) where + flowType _ = FArray (callType (Proxy :: Proxy a)) isPrim _ = True flowTypeName _ = Nothing -instance (FlowTyped a, Typeable a) => FlowTyped (VS.Vector a) where - flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) +instance (FlowCallable a) => FlowTyped (VS.Vector a) where + flowType _ = FArray (callType (Proxy :: Proxy a)) isPrim _ = True flowTypeName _ = Nothing -instance ( FlowTyped a, Typeable a - , FlowTyped b, Typeable b) => FlowTyped (a, b) where +instance ( FlowCallable a + , FlowCallable b + ) => FlowTyped (a, b) where flowTypeName _ = Nothing flowType _ = - Fix (Tuple (V.fromList [aFt, bFt])) + FTuple (V.fromList [aFt, bFt]) where - aFt = flowTypePreferName (Proxy :: Proxy a) - bFt = flowTypePreferName (Proxy :: Proxy b) + aFt = callType (Proxy :: Proxy a) + bFt = callType (Proxy :: Proxy b) -instance (FlowTyped a, Typeable a) => FlowTyped (Maybe a) where - flowType _ = Fix (Nullable (flowTypePreferName (Proxy :: Proxy a))) +instance (FlowCallable a) => FlowTyped (Maybe a) where + flowType _ = FNullable (callType (Proxy :: Proxy a)) isPrim _ = True flowTypeName _ = Nothing -instance ( FlowTyped a, Typeable a - , FlowTyped b, Typeable b) => +instance ( FlowCallable a + , FlowCallable b) => FlowTyped (Either a b) where flowTypeName _ = Nothing - flowType _ = Fix - (Alt - (Fix (ExactObject (H.fromList [("Left", aFt)]))) - (Fix (ExactObject (H.fromList [("Right", bFt)])))) + flowType _ = FAlt + (FExactObject (H.fromList [("Left", aFt)])) + (FExactObject (H.fromList [("Right", bFt)])) where - aFt = flowTypePreferName (Proxy :: Proxy a) - bFt = flowTypePreferName (Proxy :: Proxy b) + aFt = callType (Proxy :: Proxy a) + bFt = callType (Proxy :: Proxy b) -instance ( FlowTyped a, Typeable a - , FlowTyped b, Typeable b - , FlowTyped c, Typeable c) => +instance ( FlowCallable a + , FlowCallable b + , FlowCallable c) => FlowTyped (a, b, c) where flowTypeName _ = Nothing - flowType _ = Fix (Tuple (V.fromList [aFt, bFt, cFt])) + flowType _ = FTuple (V.fromList [aFt, bFt, cFt]) where - aFt = flowTypePreferName (Proxy :: Proxy a) - bFt = flowTypePreferName (Proxy :: Proxy b) - cFt = flowTypePreferName (Proxy :: Proxy c) + aFt = callType (Proxy :: Proxy a) + bFt = callType (Proxy :: Proxy b) + cFt = callType (Proxy :: Proxy c) +instance ( FlowCallable a + , FlowCallable b + , FlowCallable c + , FlowCallable d + ) => + FlowTyped (a, b, c, d) where + flowTypeName _ = Nothing + flowType _ = FTuple (V.fromList [aFt, bFt, cFt, dFt]) + where + aFt = callType (Proxy :: Proxy a) + bFt = callType (Proxy :: Proxy b) + cFt = callType (Proxy :: Proxy c) + dFt = callType (Proxy :: Proxy d) + +instance ( FlowCallable a + , FlowCallable b + , FlowCallable c + , FlowCallable d + , FlowCallable e + ) => + FlowTyped (a, b, c, d, e) where + flowTypeName _ = Nothing + flowType _ = FTuple (V.fromList [aFt, bFt, cFt, dFt, eFt]) + where + aFt = callType (Proxy :: Proxy a) + bFt = callType (Proxy :: Proxy b) + cFt = callType (Proxy :: Proxy c) + dFt = callType (Proxy :: Proxy d) + eFt = callType (Proxy :: Proxy e) + instance FlowTyped Text where isPrim _ = True - flowType _ = Fix (Prim String) + flowType _ = FPrimString flowTypeName _ = Nothing instance FlowTyped TL.Text where isPrim _ = True - flowType _ = Fix (Prim String) + flowType _ = FPrimString flowTypeName _ = Nothing instance {-# OVERLAPS #-} FlowTyped String where isPrim _ = True - flowType _ = Fix (Prim String) + flowType _ = FPrimString flowTypeName _ = Nothing instance FlowTyped Void.Void where isPrim _ = True - flowType _ = Fix (Prim Void) + flowType _ = FPrimBottom flowTypeName _ = Nothing instance FlowTyped Char where isPrim _ = True - flowType _ = Fix (Prim String) + flowType _ = FPrimString flowTypeName _ = Nothing instance FlowTyped Bool where isPrim _ = True - flowType _ = Fix (Prim Boolean) + flowType _ = FPrimBoolean flowTypeName _ = Nothing instance FlowTyped A.Value where isPrim _ = True - flowType _ = Fix (Prim Mixed) + flowType _ = FPrimMixed flowTypeName _ = Nothing instance FlowTyped UTCTime where isPrim _ = False - flowType _ = Fix (Prim String) + flowType _ = FPrimString flowTypeName _ = Nothing instance Typeable a => FlowTyped (Fixed a) where isPrim _ = False - flowType _ = Fix (Prim Number) + flowType _ = FPrimNumber flowTypeName _ = Nothing --- | This is at odds with "aeson" which defines 'A.ToJSONKey' -instance (Typeable a, FlowTyped a) => FlowTyped (HashMap Text a) where +instance ( FlowCallable k + , FlowCallable a + , A.ToJSONKey k + ) => FlowTyped (HashMap k a) where -- XXX this is getting quite incoherent, what makes something "Prim" or not... isPrim _ = True - flowType _ = Fix (ObjectMap "key" (flowTypePreferName (Proxy :: Proxy a))) - flowTypeName _ = Nothing -instance (Typeable a, FlowTyped a) => FlowTyped (Set.Set a) where + flowType _ = + case A.toJSONKey :: A.ToJSONKeyFunction k of + A.ToJSONKeyText{} -> + FObjectMap "key" FPrimString (callType (Proxy :: Proxy a)) + + A.ToJSONKeyValue{} -> + FArray (FTuple (V.fromListN 2 + [ callType (Proxy :: Proxy k) + , callType (Proxy :: Proxy a) + ])) + + flowTypeName _ = + Nothing + +instance (FlowCallable a) => FlowTyped (Set.Set a) where isPrim _ = False - flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) + flowType _ = FArray (callType (Proxy :: Proxy a)) flowTypeName _ = Nothing instance FlowTyped IntSet.IntSet where isPrim _ = False - flowType _ = Fix (Array (Fix (Prim Number))) + flowType _ = FArray FPrimNumber -- (Fix (Prim Number)) flowTypeName _ = Nothing -instance (Typeable a, FlowTyped a) => FlowTyped (I.IntMap a) where +instance (FlowCallable a) => FlowTyped (I.IntMap a) where isPrim _ = False flowType _ = Fix . Array . Fix . Tuple . V.fromListN 2 $ - [ flowType (Proxy :: Proxy Int) - , flowType (Proxy :: Proxy a) + [ FPrimNumber + , callType (Proxy :: Proxy a) ] flowTypeName _ = Nothing -instance (Typeable a, FlowTyped a) => FlowTyped (HashSet.HashSet a) where - isPrim _ = False - flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) - flowTypeName _ = Nothing - -data Var :: k -> Type where Var :: Var a - -instance (Typeable a, Typeable k) => FlowTyped (Var (a :: k)) where +instance (FlowCallable a) => FlowTyped (HashSet.HashSet a) where isPrim _ = False - flowType _ = Fix (PolyVar (typeOf (Var :: Var a))) + flowType _ = FArray (callType (Proxy :: Proxy a)) flowTypeName _ = Nothing -- | This instance is defined recursively. You'll probably need to use -- 'dependencies' to extract a usable definition -instance (FlowTyped a, Typeable a) => FlowTyped (Tree.Tree a) where +instance (FlowCallable a) => FlowTyped (Tree.Tree a) where isPrim _ = False - flowType _ = Fix (Tuple - (V.fromList - [ Fix (PolyUse (Flowable (Proxy :: Proxy a))) - , Fix (Array - (fromJust (flowTypeRecur (Proxy :: Proxy (Tree.Tree a))))) - ])) + flowType _ = FTuple + (V.fromList + [ FGenericParam 0 + , FArray (callType' (Proxy :: Proxy (Tree.Tree a)) [FGenericParam 0]) + ]) flowTypeName _ = Just "Tree" - flowTypeVars _ = [typeRep (Var :: Var a)] + flowTypeVars _ = [Flowable (Proxy :: Proxy a)] instance FlowTyped () where isPrim _ = False - flowType _ = Fix (Tuple V.empty) + flowType _ = FTuple V.empty flowTypeName _ = Nothing -- monomorphic numeric instances @@ -794,10 +1122,11 @@ [d| instance FlowTyped $ty where isPrim _ = False - flowType _ = Fix (Prim Number) + flowType _ = FPrimNumber flowTypeName _ = Nothing |]) [ [t|Int|], [t|Int8|], [t|Int16|], [t|Int32|], [t|Int64|] , [t|Word|], [t|Word8|], [t|Word16|], [t|Word32|], [t|Word64|] , [t|Float|], [t|Double|], [t|Scientific|] ]) +deriveEq1 ''FlowTypeF diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,8 +5,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} import Data.Aeson (Value) -import Data.Aeson.Flow -import Data.Functor.Foldable (Fix (..)) +import Data.Aeson.Flow as Flow +import Data.Fix (Fix (..)) +import Data.Functor.Foldable import Data.HashMap.Strict (HashMap) import Data.Proxy (Proxy (..)) import Data.Text (Text) @@ -16,6 +17,10 @@ import Test.Tasty import Test.Tasty.HUnit +-- | Pretty-print a flowtype in flowtype syntax +exportFlowTypeAs :: Text -> FlowType -> Text +exportFlowTypeAs = exportTypeAs RenderOptions{renderMode=RenderFlow} + data User = User { username :: Text , realname :: Maybe Text @@ -77,29 +82,28 @@ main = defaultMain $ testGroup "aeson-flowtyped" [ testCase "nullable" $ showFlowType (flowType (Proxy :: Proxy (Maybe Int))) @=? - showFlowType (Fix (Nullable (Fix (Prim Number)))) + showFlowType (FNullable FPrimNumber) , testCase "array" $ do showFlowType (flowType (Proxy :: Proxy [Int])) @=? - showFlowType (Fix (Array (Fix (Prim Number)))) + showFlowType (FArray FPrimNumber) showFlowType (flowType (Proxy :: Proxy (Vector Int))) @=? - showFlowType (Fix (Array (Fix (Prim Number)))) + showFlowType (FArray FPrimNumber) -- (Fix (Array (Fix (Prim Number)))) -- XXX: actually use Eq , testCase "User export" $ "export type User =\n\ \ {| extraInfo: mixed,\n\ - \ tag: 'User',\n\ - \ realname: ?string,\n\ + \ dob: null | [number,number,number],\n\ \ username: string,\n\ - \ dob: ?[number,number,number] |};" @=? + \ realname: null | string |};" @=? exportFlowTypeAs "User" (flowType (Proxy :: Proxy User)) , testCase "Recursive type export" $ "export type Recur =\n\ - \ {| tag: 'Recur', stuff: User[], recurs: Recur[], asdf: number |};" @=? + \ {| stuff: User[], recurs: Recur[], asdf: number |};" @=? exportFlowTypeAs "Recur" (flowType (Proxy :: Proxy Recur)) , testCase "Nullary string tags (2 tags)" $ @@ -130,12 +134,12 @@ , testCase "parens around nullable array" $ "export type T =\n\ - \ ?(string[]);" @=? + \ null | string[];" @=? exportFlowTypeAs "T" (flowType (Proxy :: Proxy (Maybe [Text]))) , testCase "parens around nullable array of nullable elements" $ "export type T =\n\ - \ ?((?string)[]);" @=? + \ null | (null | string)[];" @=? exportFlowTypeAs "T" (flowType (Proxy :: Proxy (Maybe [Maybe Text]))) , testCase "export dependencies" $ @@ -154,19 +158,21 @@ \// This module has been generated by aeson-flowtyped.\n\n\ \export type Tree =\n\ \ [A,Tree[]];\n" @=? - generateFlowModule defaultFlowModuleOptions + generateModule flowModuleOptions [ Export (Proxy :: Proxy (Tree (Var 0))) ] + {- , testCase "polymorphism (arity 2)" $ "// @flow\n\ \// This module has been generated by aeson-flowtyped.\n\n\ \export type Poly2 =\n\ \ {| tag: 'Poly2', contents: [A,B] |} |\n\ \ {| tag: 'Poly2Go', contents: Poly2 |};\n" @=? - generateFlowModule defaultFlowModuleOptions + generateModule flowModuleOptions [ Export (Proxy :: Proxy (Poly2 (Var 0) (Var 1))) ] + -} , testCase "monomorphic use of polymorphic type (dependencies)" $ [ FlowName (Proxy :: Proxy Mono) "Mono" @@ -174,12 +180,15 @@ ] @=? exportsDependencies [Export (Proxy :: Proxy Mono)] + {- , testCase "monomorphic use of polymorphic type" $ "// @flow\n\ \// This module has been generated by aeson-flowtyped.\n\n\ \export type Poly2 =\n\ \ {| tag: 'Poly2', contents: [A,B] |} |\n\ \ {| tag: 'Poly2Go', contents: Poly2 |};\n" @=? - generateFlowModule defaultFlowModuleOptions [Export (Proxy :: Proxy Mono)] + generateModule flowModuleOptions + [Export (Proxy :: Proxy Mono)] + -} ]