aeson-flowtyped 0.7.5 → 0.8.0

raw patch · 3 files changed

+153/−75 lines, 3 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• aeson-flowtyped.cabal +4/−2
• src/Data/Aeson/Flow.hs +116/−70
• test/Spec.hs +33/−3

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           aeson-flowtyped-version:        0.7.5+version:        0.8.0 synopsis:       Create Flow type definitions from Haskell data types. description:    Create Flow type definitions from Haskell data types. category:       Web@@ -29,13 +29,14 @@     , vector     , text     , recursion-schemes+    , containers     , time     , unordered-containers-    , containers     , reflection     , wl-pprint     , free     , scientific+    , transformers   exposed-modules:       Data.Aeson.Flow   other-modules:@@ -53,6 +54,7 @@     , vector     , text     , recursion-schemes+    , containers     , aeson-flowtyped     , tasty     , tasty-hunit

@@ -47,41 +47,47 @@   , FlowTypeI   , Info (..)   , Var (..)+  , Typeable+  , typeRep   ) where import           Control.Monad-import qualified Data.Aeson              as A-import           Data.Aeson.Types        (Options (..), SumEncoding (..))-import           Data.Fixed              (Fixed)+import           Control.Monad.Trans.State.Strict+import qualified Data.Aeson                       as A+import           Data.Aeson.Types                 (Options (..),+                                                   SumEncoding (..))+import           Data.Fixed                       (Fixed) import           Data.Foldable import           Data.Functor.Classes import           Data.Functor.Compose-import           Data.Functor.Foldable   hiding (fold)-import           Data.HashMap.Strict     (HashMap)-import qualified Data.HashMap.Strict     as H-import qualified Data.HashSet            as HashSet+import           Data.Functor.Foldable            hiding (fold)+import           Data.HashMap.Strict              (HashMap)+import qualified Data.HashMap.Strict              as H+import qualified Data.HashSet                     as HashSet import           Data.Int-import qualified Data.IntSet             as IntSet+import qualified Data.IntSet                      as IntSet+import           Data.Kind                        (Type)+import           Data.Map.Strict                  (Map)+import qualified Data.Map.Strict                  as M import           Data.Proxy import           Data.Reflection-import           Data.Scientific         (Scientific)-import qualified Data.Set                as Set-import qualified Data.Set                as Set-import           Data.Text               (Text)-import qualified Data.Text               as T-import qualified Data.Text.IO            as TIO-import qualified Data.Text.Lazy          as TL-import           Data.Time               (UTCTime)-import qualified Data.Tree               as Tree+import           Data.Scientific                  (Scientific)+import qualified Data.Set                         as Set+import           Data.Text                        (Text)+import qualified Data.Text                        as T+import qualified Data.Text.IO                     as TIO+import qualified Data.Text.Lazy                   as TL+import           Data.Time                        (UTCTime)+import qualified Data.Tree                        as Tree import           Data.Typeable-import           Data.Vector             (Vector)-import qualified Data.Vector             as V-import qualified Data.Vector.Storable    as VS-import qualified Data.Vector.Unboxed     as VU-import qualified Data.Void               as Void+import           Data.Vector                      (Vector)+import qualified Data.Vector                      as V+import qualified Data.Vector.Storable             as VS+import qualified Data.Vector.Unboxed              as VU+import qualified Data.Void                        as Void import           Data.Word import           GHC.Generics import           GHC.TypeLits-import qualified Text.PrettyPrint.Leijen as PP+import qualified Text.PrettyPrint.Leijen          as PP  -------------------------------------------------------------------------------- -- Magical newtype for injecting showsPrec into any arbitrary Show@@ -110,9 +116,6 @@   | Any   deriving (Show, Read, Eq, Ord) -newtype Var = Var { varName :: Text }-  deriving (Show, Read, Eq, Ord)- -- | A name for a flowtyped data-type. These are returned by 'dependencies'. data FlowName where   FlowName :: (Typeable a, FlowTyped a) => Proxy a -> Text -> FlowName@@ -141,8 +144,9 @@   | Literal !A.Value   | Tag !Text   | Name !FlowName-  | Poly !Var !(Vector a)-  | PolyVar !Var+  | Instantiate !TypeRep a+  | PolyVar !TypeRep+  | PolyApply a ![TypeRep]   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@@ -168,10 +172,12 @@ text :: Text -> PP.Doc text = PP.text . T.unpack -ppAlts :: [FlowType] -> FlowType -> PP.Doc+type Poly = State (Map TypeRep Text)++ppAlts :: [FlowType] -> FlowType -> Poly PP.Doc ppAlts alts (Fix f) = case f of   Alt a b -> ppAlts (a:alts) b-  x       -> PP.align (sep (map pp (reverse (Fix x:alts))))+  x       -> PP.align . sep <$> mapM pp (reverse (Fix x:alts))   where     sep [x]    = x     sep (x:xs) = x PP.<+> PP.string "|" PP.<$> sep xs@@ -213,43 +219,65 @@   Array _    -> PP.parens x   _          -> x -ppObject :: HashMap Text FlowType -> [PP.Doc]-ppObject = map-  (\(name, fty') ->-     case fty' of-       Fix (Omitable fty) -> text name PP.<> PP.text "?" PP.<> PP.colon PP.<+> pp fty-       fty -> text name PP.<> PP.colon PP.<+> pp fty)-  . H.toList+ppObject :: HashMap Text FlowType -> Poly [PP.Doc]+ppObject = mapM ppField . H.toList+  where+    ppField (name, fty) = do+      case fty of+        Fix (Omitable fty') ->+          (\fty'' -> text name PP.<> PP.text "?" PP.<> PP.colon PP.<+> fty'') <$> pp fty'+        fty' ->+          (\fty'' -> text name PP.<> PP.colon PP.<+> fty'') <$> pp fty' -pp :: FlowType -> PP.Doc+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 (Fix ft) = case ft of-  ObjectMap keyName a -> braceList-    [ PP.brackets (text keyName PP.<> PP.text ": string") PP.<>-      PP.colon PP.<+>-      pp a-    ]-  Object hm -> braceList (ppObject hm)-  ExactObject hm -> braceBarList (ppObject hm)-  Array a -> mayWrap a (pp a) PP.<> PP.string "[]"-  Tuple t -> PP.list (map pp (V.toList t))+  ObjectMap keyName 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 -> case pt of+  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 -> PP.char '?' PP.<> mayWrap a (pp a)-  Omitable a -> PP.char '?' PP.<> mayWrap a (pp a) -- hopefully these are caught-  Literal a -> ppJson a-  Tag t -> PP.squotes (text t)-  Name (FlowName _ t) -> text t-  _ -> PP.string (show ft)+  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+  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))))+  _ -> return (PP.string (show ft))  -- | Pretty-print a flowtype in flowtype syntax showFlowType :: FlowType -> Text-showFlowType = T.pack . show . pp+showFlowType ft = T.pack (show (evalState (pp ft) M.empty))  -------------------------------------------------------------------------------- -- Module exporting@@ -259,9 +287,16 @@ exportFlowTypeAs name ft =   T.pack . render $   PP.string "export type " PP.<>-  PP.string (T.unpack name) PP.<+> PP.string "=" PP.<$>-  PP.indent 2 (pp ft) PP.<> PP.string ";"+  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 ";"+    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+     render = ($[]) . PP.displayS . PP.renderPretty 1.0 80  -- | Compute all the dependencies of a 'FlowTyped' thing, including itself.@@ -334,13 +369,20 @@  flowTypePreferName :: (Typeable a, FlowTyped a) => Proxy a -> FlowType flowTypePreferName p = case flowTypeName p of-  Just n  -> Fix (Name (FlowName p n))+  Just n | null vars -> name+         | otherwise -> Fix (PolyApply name vars)+    where+      vars = flowTypeVars p+      name = Fix (Name (FlowName p n))   Nothing -> flowType p  class Typeable a => FlowTyped a where   flowType :: Proxy a -> FlowType   flowTypeName :: Proxy a -> Maybe Text +  flowTypeVars :: Proxy a -> [TypeRep]+  flowTypeVars _ = []+   flowOptions :: Proxy a -> Options   flowOptions _ = A.defaultOptions @@ -484,12 +526,7 @@   gflowVal opt p = gflowVal opt (fmap unM1 p)  instance FlowTyped r => GFlowVal (Rec0 r) where-  gflowVal _opt p = case flowTypePreferName (fmap unK1 p) of-    ty-      | not (isPrim p'), Just name <- flowTypeName p' -> noInfo (Name (FlowName p' name))-      | otherwise -> cata noInfo ty-    where-      p' = fmap unK1 p+  gflowVal _opt p = cata noInfo (flowTypePreferName (fmap unK1 p))  instance (GFlowVal a, GFlowVal b) => GFlowVal (a :+: b) where   gflowVal opt _ = noInfo@@ -656,16 +693,25 @@   flowType _ = Fix (Array (flowTypePreferName (Proxy :: Proxy a)))   flowTypeName _ = Nothing +data Var :: Nat -> Type where Var :: Var a++instance Typeable a => FlowTyped (Var a) where+  isPrim _ = False+  flowType _ = Fix (PolyVar (typeRep (Proxy :: Proxy (Var a))))+  flowTypeName _ = Nothing+ -- | This instance is defined recursively. You'll probably need to use -- 'dependencies' to extract a usable definition-instance FlowTyped a => FlowTyped (Tree.Tree a) where+instance (Typeable a, KnownNat a, v ~ Var a) => FlowTyped (Tree.Tree v) where   isPrim _ = False-  flowType _ = Fix (Tuple-                    (V.fromList-                     [ flowType (Proxy :: Proxy a)-                     , Fix (Array (flowType (Proxy :: Proxy (Tree.Tree a))))-                     ]))+  flowType _ = Fix+    (Tuple+     (V.fromList+      [ flowType (Proxy :: Proxy v)+      , Fix (Array (flowTypePreferName (Proxy :: Proxy (Tree.Tree v))))+      ]))   flowTypeName _ = Just "Tree"+  flowTypeVars _ = [typeRep (Proxy :: Proxy v)]  instance FlowTyped () where   isPrim _ = False

@@ -1,12 +1,15 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-} import           Data.Aeson            (Value) import           Data.Aeson.Flow import           Data.Functor.Foldable (Fix (..)) import           Data.HashMap.Strict   (HashMap)-import qualified Data.HashMap.Strict   as H import           Data.Proxy            (Proxy (..)) import           Data.Text             (Text)+import           Data.Tree             (Tree) import           Data.Vector           (Vector) import           GHC.Generics import           Test.Tasty@@ -50,6 +53,15 @@  instance FlowTyped Hmap +data Poly2 a b = Poly2 a b | Poly2Go (Poly2 a b)+  deriving (Generic)++instance (a ~ Var 0, b ~ Var 1) => FlowTyped (Poly2 a b) where+  flowTypeVars _ =+    [ typeRep (Proxy :: Proxy a)+    , typeRep (Proxy :: Proxy b)+    ]+ main :: IO () main = defaultMain $ testGroup "aeson-flowtyped"   [ testCase "nullable" $@@ -132,4 +144,22 @@     [ Export (Proxy :: Proxy Codep)     ] +  , testCase "polymorphism (arity 1)" $+    "// @flow\n\+    \// This module has been generated by aeson-flowtyped.\n\n\+    \export type Tree<A> =\n\+    \  [A,Tree<A>[]];\n" @=?+    generateFlowModule defaultFlowModuleOptions+    [ 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<A, B> =\n\+    \  {| tag: 'Poly2', contents: [A,B] |} |\n\+    \  {| tag: 'Poly2Go', contents: Poly2<A, B> |};\n" @=?+    generateFlowModule defaultFlowModuleOptions+    [ Export (Proxy :: Proxy (Poly2 (Var 0) (Var 1)))+    ]   ]