aeson-flowtyped 0.8.1 → 0.9.0

raw patch · 3 files changed

+97/−58 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• aeson-flowtyped.cabal +1/−1
• src/Data/Aeson/Flow.hs +83/−43
• test/Spec.hs +13/−14

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           aeson-flowtyped-version:        0.8.1+version:        0.9.0 synopsis:       Create Flow type definitions from Haskell data types. description:    Create Flow type definitions from Haskell data types. category:       Web

@@ -35,9 +35,11 @@   , generateFlowModule   , writeFlowModule   , exportFlowTypeAs+  , flowTypeAs     -- * Utility functions   , showFlowType   , dependencies+  , exportsDependencies     -- * Internals   , defaultFlowType   , defaultFlowTypeName@@ -86,6 +88,7 @@ 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@@ -285,9 +288,13 @@  -- | Generate a @ export type @ declaration. exportFlowTypeAs :: Text -> FlowType -> Text-exportFlowTypeAs name ft =+exportFlowTypeAs = flowTypeAs True++-- | Generate a @ export type @ declaration.+flowTypeAs :: Bool -> Text -> FlowType -> Text+flowTypeAs isExport name ft =   T.pack . render $-  PP.string "export type " PP.<>+  PP.string (if isExport then "export type " else "type ") PP.<>   PP.string (T.unpack name) PP.<> withVars (runState (pp ft) M.empty)   where     main r = PP.string "=" PP.<$> PP.indent 2 r PP.<> PP.string ";"@@ -297,57 +304,87 @@                                (PP.punctuate PP.comma (map text (M.elems vars))))                     PP.<+>                     main r-     render = ($[]) . PP.displayS . PP.renderPretty 1.0 80 +++ -- | Compute all the dependencies of a 'FlowTyped' thing, including itself.-dependencies :: FlowTyped a => Proxy a -> Set.Set FlowName-dependencies p0 = subDeps (immediateDeps (flowType p0) Set.empty)+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)   where-    this :: Set.Set FlowName-    this = foldMap Set.singleton (FlowName p0 <$> flowTypeName p0)--    subDeps :: Set.Set FlowName -> Set.Set FlowName-    subDeps =+    -- XXX: catch mutual recursion+    addImmediateDeps :: FlowName+                     -> Map FlowName (Set.Set FlowName)+                     -> Map FlowName (Set.Set FlowName)+    addImmediateDeps fn@(FlowName p _) acc0 =       foldr-      (\fn@(FlowName p _) acc ->-         if Set.member fn acc-         then acc-         else dependencies p `Set.union` acc)-      this+      (\(FlowName p _) -> go p)+      (M.insert fn sub acc0)+      sub+      where sub = immediateDeps (flowType p) -    immediateDeps :: FlowType -> Set.Set FlowName -> Set.Set FlowName-    immediateDeps (Fix (Name n)) acc = Set.insert n acc-    immediateDeps (Fix p)        acc = foldr' immediateDeps acc p+    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 (Fix (Name n)) = Set.singleton n+immediateDeps (Fix p)        = foldMap immediateDeps p+ data FlowModuleOptions = FlowModuleOptions   { -- | You might want to change this to include e.g. flow-runtime-    flowPragmas :: [Text]-  , flowHeader  :: [Text]+    flowPragmas     :: [Text]+  , flowHeader      :: [Text]+  , flowExportDeps  :: Bool+  , flowComputeDeps :: Bool   } deriving (Eq, Show)  defaultFlowModuleOptions :: FlowModuleOptions defaultFlowModuleOptions = FlowModuleOptions   { flowPragmas = ["// @flow"]   , flowHeader = ["This module has been generated by aeson-flowtyped."]+  , flowExportDeps = True+  , flowComputeDeps = True   }  data Export where-  Export :: 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++exportsDependencies :: [Export] -> Set.Set FlowName+exportsDependencies = foldMap (\(Export a) -> dependencies a)+ generateFlowModule :: FlowModuleOptions -> [Export] -> Text-generateFlowModule opts =+generateFlowModule opts exports =   T.unlines   . (\m ->        (flowPragmas opts ++ map ("// " `T.append`) (flowHeader opts)) ++        (T.empty : m))-  . foldr addExport []-  . Set.unions-  . map (\(Export a) -> dependencies a)+  . map flowDecl+  . flowNames+  $ exports   where-    addExport (FlowName p name) acc =-      exportFlowTypeAs name (flowType p):acc+    flowNames =+      if flowComputeDeps opts+      then Set.toList . exportsDependencies+      else catMaybes . map (\(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)+ writeFlowModule :: FlowModuleOptions -> FilePath -> [Export] -> IO () writeFlowModule opts path =   TIO.writeFile path . generateFlowModule opts@@ -381,7 +418,7 @@       name = Fix (Name (FlowName p n))   Nothing -> Nothing -class Typeable a => FlowTyped a where+class FlowTyped a where   flowType :: Proxy a -> FlowType   flowTypeName :: Proxy a -> Maybe Text @@ -530,7 +567,7 @@ instance GFlowVal f => GFlowVal (M1 i ('MetaSel mj du ds dl) f) where   gflowVal opt p = gflowVal opt (fmap unM1 p) -instance FlowTyped r => GFlowVal (Rec0 r) where+instance (Typeable r, FlowTyped r) => GFlowVal (Rec0 r) where   gflowVal _opt p = cata noInfo (flowTypePreferName (fmap unK1 p))  instance (GFlowVal a, GFlowVal b) => GFlowVal (a :+: b) where@@ -577,27 +614,28 @@ -------------------------------------------------------------------------------- -- Instances -instance FlowTyped a => FlowTyped [a] where+instance (Typeable a, FlowTyped a) => FlowTyped [a] where   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   isPrim _ = True   flowTypeName _ = Nothing -instance FlowTyped a => FlowTyped (Vector a) where+instance (FlowTyped a, Typeable a) => FlowTyped (Vector a) where   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   isPrim _ = True   flowTypeName _ = Nothing -instance FlowTyped a => FlowTyped (VU.Vector a) where+instance (FlowTyped a, Typeable a) => FlowTyped (VU.Vector a) where   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   isPrim _ = True   flowTypeName _ = Nothing -instance FlowTyped a => FlowTyped (VS.Vector a) where+instance (FlowTyped a, Typeable a) => FlowTyped (VS.Vector a) where   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   isPrim _ = True   flowTypeName _ = Nothing -instance (FlowTyped a, FlowTyped b) => FlowTyped (a, b) where+instance ( FlowTyped a, Typeable a+         , FlowTyped b, Typeable b) => FlowTyped (a, b) where   flowTypeName _ = Nothing   flowType _ =     Fix (Tuple (V.fromList [aFt, bFt]))@@ -605,12 +643,14 @@       aFt = flowTypePreferName (Proxy :: Proxy a)       bFt = flowTypePreferName (Proxy :: Proxy b) -instance FlowTyped a => FlowTyped (Maybe a) where+instance (FlowTyped a, Typeable a) => FlowTyped (Maybe a) where   flowType _ = Fix (Nullable (flowTypePreferName (Proxy :: Proxy a)))   isPrim _ = True   flowTypeName _ = Nothing -instance (FlowTyped a, FlowTyped b) => FlowTyped (Either a b) where+instance ( FlowTyped a, Typeable a+         , FlowTyped b, Typeable b) =>+         FlowTyped (Either a b) where   flowTypeName _ = Nothing   flowType _ = Fix     (Alt@@ -620,10 +660,10 @@       aFt = flowTypePreferName (Proxy :: Proxy a)       bFt = flowTypePreferName (Proxy :: Proxy b) -instance ( FlowTyped a-         , FlowTyped b-         , FlowTyped c-         ) => FlowTyped (a, b, c) where+instance ( FlowTyped a, Typeable a+         , FlowTyped b, Typeable b+         , FlowTyped c, Typeable c) =>+         FlowTyped (a, b, c) where   flowTypeName _ = Nothing   flowType _ = Fix (Tuple (V.fromList [aFt, bFt, cFt]))     where@@ -677,13 +717,13 @@   flowTypeName _ = Nothing  -- | This is at odds with "aeson" which defines 'A.ToJSONKey'-instance FlowTyped a => FlowTyped (HashMap Text a) where+instance (Typeable a, FlowTyped a) => FlowTyped (HashMap Text 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 FlowTyped a => FlowTyped (Set.Set a) where+instance (Typeable a, FlowTyped a) => FlowTyped (Set.Set a) where   isPrim _ = False   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   flowTypeName _ = Nothing@@ -693,7 +733,7 @@   flowType _ = Fix (Array (Fix (Prim Number)))   flowTypeName _ = Nothing -instance FlowTyped a => FlowTyped (HashSet.HashSet a) where+instance (Typeable a, FlowTyped a) => FlowTyped (HashSet.HashSet a) where   isPrim _ = False   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   flowTypeName _ = Nothing

@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds           #-} {-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE GADTs               #-}+{-# LANGUAGE OverloadedLists     #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-} import           Data.Aeson            (Value)@@ -41,9 +42,13 @@ data Adt4 = A4 | B4 | C4 | D4 deriving (Generic) instance FlowTyped Adt4 +data Sub = Sub Adt4 deriving (Generic)+instance FlowTyped Sub+ data Codep = Codep   { corecurs :: [Recur]   , cousers  :: [User]+  , subsub   :: Sub   } deriving (Generic)  instance FlowTyped Codep@@ -128,20 +133,14 @@     \  ?((?string)[]);" @=?     exportFlowTypeAs "T" (flowType (Proxy :: Proxy (Maybe [Maybe Text]))) -  , testCase "module export" $-    "// @flow\n\-    \// This module has been generated by aeson-flowtyped.\n\n\-    \export type Codep =\n\-    \  {| corecurs: Recur[], tag: 'Codep', cousers: User[] |};\n\-    \export type User =\n\-    \  {| extraInfo: mixed,\n\-    \     tag: 'User',\n\-    \     realname: ?string,\n\-    \     username: string,\n\-    \     dob: ?[number,number,number] |};\n\-    \export type Recur =\n\-    \  {| tag: 'Recur', stuff: User[], recurs: Recur[], asdf: number |};\n" @=?-    generateFlowModule defaultFlowModuleOptions+  , testCase "export dependencies" $+    [ FlowName (Proxy :: Proxy Codep) "Codep"+    , FlowName (Proxy :: Proxy User) "User"+    , FlowName (Proxy :: Proxy Recur) "Recur"+    , FlowName (Proxy :: Proxy Sub) "Sub"+    , FlowName (Proxy :: Proxy Adt4) "Adt4"+    ] @=?+    exportsDependencies     [ Export (Proxy :: Proxy Codep)     ]