diff --git a/aeson-flowtyped.cabal b/aeson-flowtyped.cabal --- a/aeson-flowtyped.cabal +++ b/aeson-flowtyped.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: aeson-flowtyped -version: 0.9.0 +version: 0.9.1 synopsis: Create Flow type definitions from Haskell data types. description: Create Flow type definitions from Haskell data types. category: Web 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 @@ -66,6 +66,7 @@ import qualified Data.HashMap.Strict as H import qualified Data.HashSet as HashSet import Data.Int +import qualified Data.IntMap.Strict as I import qualified Data.IntSet as IntSet import Data.Kind (Type) import Data.Map.Strict (Map) @@ -128,12 +129,22 @@ show (FlowName _ t) = show t instance Eq FlowName where - FlowName pa _ == FlowName pb _ = typeOf pa == typeOf pb + FlowName _ n0 == FlowName _ n1 = n0 == n1 instance Ord FlowName where - FlowName pa _ `compare` FlowName pb _ = compare (typeOf pa) (typeOf pb) + FlowName _ n0 `compare` FlowName _ n1 = compare n0 n1 +data Flowable where + Flowable :: (Typeable a, FlowTyped a) => Proxy a -> Flowable + +instance Show Flowable where + show (Flowable t) = show (typeRep t) + +instance Eq Flowable where + Flowable a == Flowable b = typeRep a == typeRep b + -- | The main AST for flowtypes. + data FlowTypeF a = Object !(HashMap Text a) | ExactObject !(HashMap Text a) @@ -150,7 +161,8 @@ | Name !FlowName | Instantiate !TypeRep a | PolyVar !TypeRep - | PolyApply a ![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 @@ -273,10 +285,11 @@ 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 getVar vars - return (n PP.<> PP.angles (PP.hsep (PP.punctuate PP.comma (map text vs)))) + vs <- mapM pp vars + return (n PP.<> PP.angles (PP.hsep (PP.punctuate PP.comma vs))) _ -> return (PP.string (show ft)) -- | Pretty-print a flowtype in flowtype syntax @@ -306,9 +319,6 @@ main r 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' @@ -357,10 +367,14 @@ } data Export where - Export :: (Typeable a, FlowTyped a) => Proxy a -> Export + Export :: (Typeable a, FlowTyped a) + => Proxy a + -> Export instance Eq Export where - Export p0 == Export p1 = typeRep p0 == typeRep p1 + Export p0 == Export p1 = + flowTypeName p0 == flowTypeName p1 || + typeRep p0 == typeRep p1 exportsDependencies :: [Export] -> Set.Set FlowName exportsDependencies = foldMap (\(Export a) -> dependencies a) @@ -412,8 +426,11 @@ flowTypeRecur p = case flowTypeName p of Just n | null vars -> Just name - | otherwise -> Just (Fix (PolyApply name vars)) + | 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 @@ -733,6 +750,14 @@ flowType _ = Fix (Array (Fix (Prim Number))) flowTypeName _ = Nothing +instance (Typeable a, FlowTyped a) => FlowTyped (I.IntMap a) where + isPrim _ = False + flowType _ = Fix . Array . Fix . Tuple . V.fromListN 2 $ + [ flowType (Proxy :: Proxy Int) + , flowType (Proxy :: Proxy a) + ] + flowTypeName _ = Nothing + instance (Typeable a, FlowTyped a) => FlowTyped (HashSet.HashSet a) where isPrim _ = False flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a))) @@ -742,16 +767,16 @@ instance (Typeable a, Typeable k) => FlowTyped (Var (a :: k)) where isPrim _ = False - flowType _ = Fix (PolyVar (typeRep (Var :: Var a))) + flowType _ = Fix (PolyVar (typeOf (Var :: Var a))) flowTypeName _ = Nothing -- | This instance is defined recursively. You'll probably need to use -- 'dependencies' to extract a usable definition -instance Typeable a => FlowTyped (Tree.Tree a) where +instance (FlowTyped a, Typeable a) => FlowTyped (Tree.Tree a) where isPrim _ = False flowType _ = Fix (Tuple (V.fromList - [ flowType (Proxy :: Proxy (Var a)) + [ Fix (PolyUse (Flowable (Proxy :: Proxy a))) , Fix (Array (fromJust (flowTypeRecur (Proxy :: Proxy (Tree.Tree a))))) ])) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -64,10 +64,15 @@ instance (Typeable a, FlowTyped a, Typeable b, FlowTyped b) => FlowTyped (Poly2 a b) where flowTypeVars _ = - [ typeRep (Var :: Var 0) - , typeRep (Var :: Var 1) + [ typeRep (Var :: Var a) + , typeRep (Var :: Var b) ] +data Mono = Mono (Poly2 Int Bool) (Poly2 Bool Int) + deriving (Generic) + +instance FlowTyped Mono + main :: IO () main = defaultMain $ testGroup "aeson-flowtyped" [ testCase "nullable" $ @@ -162,4 +167,19 @@ generateFlowModule defaultFlowModuleOptions [ Export (Proxy :: Proxy (Poly2 (Var 0) (Var 1))) ] + + , testCase "monomorphic use of polymorphic type (dependencies)" $ + [ FlowName (Proxy :: Proxy Mono) "Mono" + , FlowName (Proxy :: Proxy (Poly2 () ())) "Poly2" + ] @=? + 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)] + ]