{-# LANGUAGE AllowAmbiguousTypes       #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE DefaultSignatures         #-}
{-# LANGUAGE DeriveAnyClass            #-}
{-# LANGUAGE DeriveTraversable         #-}
{-# LANGUAGE DerivingStrategies        #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE InstanceSigs              #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE PatternSynonyms           #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TypeApplications          #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeInType                #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE ViewPatterns              #-}
-- | Derive <https://flow.org/ Flow types> using aeson 'Options'.
--
-- Does not currently support the 'unwrapUnaryRecords' option.
module Data.Aeson.Flow
  ( -- * AST types
    FlowTyped(..)
  , callType
  , FlowTypeF
  , FlowType
  -- , 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/typescript modules
  , Export
  , export
  , RenderMode(..)
  , RenderOptions(..)
  , ModuleOptions(..)
  , typeScriptModuleOptions
  , flowModuleOptions
  , generateModule
  , writeModule
  , showTypeAs
  , exportTypeAs
    -- ** Convenience for generating flowtypes from other types
  , FlowTyFields(..)
  , FlowDeconstructField
    -- ** TS specific
  , showTypeScriptType
    -- ** Flow specific
  , showFlowType
    -- * Dependencies
  , exportsDependencies
  , dependencies
    -- * Utility
  , FlowName(..)
  , Flowable(..)
  , defaultFlowTypeName
  , defaultFlowType
  ) where
import           Control.Monad.Reader
import           Control.Monad.State.Strict
import qualified Data.Aeson                    as A
import qualified Data.Aeson.Key                as AK
import qualified Data.Aeson.KeyMap             as AKM
import           Data.Aeson.Types               ( Options(..)
                                                , SumEncoding(..)
                                                )
import           Data.Eq.Deriving               ( deriveEq1 )
import           Data.Fix                       ( Fix(..) )
import           Data.Fixed                     ( Fixed )
import           Data.Functor.Classes
import           Data.HashMap.Strict            ( HashMap )
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 qualified Data.Map.Strict               as M
import           Data.Maybe
import qualified Data.Monoid                   as Monoid
import           Data.Proxy
import           Data.Reflection
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.Word
import           GHC.Generics                   ( D1
                                                , Generic
                                                , Meta(..)
                                                , Rep
                                                , from
                                                )
import           GHC.TypeLits
import qualified Generics.SOP                  as SOP
import qualified Generics.SOP.GGP              as SOP
import qualified Text.PrettyPrint.Leijen       as PP

-- | 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
  | TypeDoc !(Vector Text) a
  deriving (Int -> FlowTypeF a -> ShowS
forall a. Show a => Int -> FlowTypeF a -> ShowS
forall a. Show a => [FlowTypeF a] -> ShowS
forall a. Show a => FlowTypeF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlowTypeF a] -> ShowS
$cshowList :: forall a. Show a => [FlowTypeF a] -> ShowS
show :: FlowTypeF a -> String
$cshow :: forall a. Show a => FlowTypeF a -> String
showsPrec :: Int -> FlowTypeF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FlowTypeF a -> ShowS
Show, FlowTypeF a -> FlowTypeF a -> Bool
forall a. Eq a => FlowTypeF a -> FlowTypeF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlowTypeF a -> FlowTypeF a -> Bool
$c/= :: forall a. Eq a => FlowTypeF a -> FlowTypeF a -> Bool
== :: FlowTypeF a -> FlowTypeF a -> Bool
$c== :: forall a. Eq a => FlowTypeF a -> FlowTypeF a -> Bool
Eq, forall a b. a -> FlowTypeF b -> FlowTypeF a
forall a b. (a -> b) -> FlowTypeF a -> FlowTypeF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FlowTypeF b -> FlowTypeF a
$c<$ :: forall a b. a -> FlowTypeF b -> FlowTypeF a
fmap :: forall a b. (a -> b) -> FlowTypeF a -> FlowTypeF b
$cfmap :: forall a b. (a -> b) -> FlowTypeF a -> FlowTypeF b
Functor, Functor FlowTypeF
Foldable FlowTypeF
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FlowTypeF (m a) -> m (FlowTypeF a)
forall (f :: * -> *) a.
Applicative f =>
FlowTypeF (f a) -> f (FlowTypeF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FlowTypeF a -> m (FlowTypeF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlowTypeF a -> f (FlowTypeF b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FlowTypeF (m a) -> m (FlowTypeF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FlowTypeF (m a) -> m (FlowTypeF a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FlowTypeF a -> m (FlowTypeF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FlowTypeF a -> m (FlowTypeF b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FlowTypeF (f a) -> f (FlowTypeF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FlowTypeF (f a) -> f (FlowTypeF a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlowTypeF a -> f (FlowTypeF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlowTypeF a -> f (FlowTypeF b)
Traversable, forall a. Eq a => a -> FlowTypeF a -> Bool
forall a. Num a => FlowTypeF a -> a
forall a. Ord a => FlowTypeF a -> a
forall m. Monoid m => FlowTypeF m -> m
forall a. FlowTypeF a -> Bool
forall a. FlowTypeF a -> Int
forall a. FlowTypeF a -> [a]
forall a. (a -> a -> a) -> FlowTypeF a -> a
forall m a. Monoid m => (a -> m) -> FlowTypeF a -> m
forall b a. (b -> a -> b) -> b -> FlowTypeF a -> b
forall a b. (a -> b -> b) -> b -> FlowTypeF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FlowTypeF a -> a
$cproduct :: forall a. Num a => FlowTypeF a -> a
sum :: forall a. Num a => FlowTypeF a -> a
$csum :: forall a. Num a => FlowTypeF a -> a
minimum :: forall a. Ord a => FlowTypeF a -> a
$cminimum :: forall a. Ord a => FlowTypeF a -> a
maximum :: forall a. Ord a => FlowTypeF a -> a
$cmaximum :: forall a. Ord a => FlowTypeF a -> a
elem :: forall a. Eq a => a -> FlowTypeF a -> Bool
$celem :: forall a. Eq a => a -> FlowTypeF a -> Bool
length :: forall a. FlowTypeF a -> Int
$clength :: forall a. FlowTypeF a -> Int
null :: forall a. FlowTypeF a -> Bool
$cnull :: forall a. FlowTypeF a -> Bool
toList :: forall a. FlowTypeF a -> [a]
$ctoList :: forall a. FlowTypeF a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FlowTypeF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FlowTypeF a -> a
foldr1 :: forall a. (a -> a -> a) -> FlowTypeF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FlowTypeF a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FlowTypeF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FlowTypeF a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FlowTypeF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FlowTypeF a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FlowTypeF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FlowTypeF a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FlowTypeF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FlowTypeF a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FlowTypeF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FlowTypeF a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FlowTypeF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FlowTypeF a -> m
fold :: forall m. Monoid m => FlowTypeF m -> m
$cfold :: forall m. Monoid m => FlowTypeF m -> m
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 (Int -> PrimType -> ShowS
[PrimType] -> ShowS
PrimType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimType] -> ShowS
$cshowList :: [PrimType] -> ShowS
show :: PrimType -> String
$cshow :: PrimType -> String
showsPrec :: Int -> PrimType -> ShowS
$cshowsPrec :: Int -> PrimType -> ShowS
Show, ReadPrec [PrimType]
ReadPrec PrimType
Int -> ReadS PrimType
ReadS [PrimType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrimType]
$creadListPrec :: ReadPrec [PrimType]
readPrec :: ReadPrec PrimType
$creadPrec :: ReadPrec PrimType
readList :: ReadS [PrimType]
$creadList :: ReadS [PrimType]
readsPrec :: Int -> ReadS PrimType
$creadsPrec :: Int -> ReadS PrimType
Read, PrimType -> PrimType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimType -> PrimType -> Bool
$c/= :: PrimType -> PrimType -> Bool
== :: PrimType -> PrimType -> Bool
$c== :: PrimType -> PrimType -> Bool
Eq, Eq PrimType
PrimType -> PrimType -> Bool
PrimType -> PrimType -> Ordering
PrimType -> PrimType -> PrimType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimType -> PrimType -> PrimType
$cmin :: PrimType -> PrimType -> PrimType
max :: PrimType -> PrimType -> PrimType
$cmax :: PrimType -> PrimType -> PrimType
>= :: PrimType -> PrimType -> Bool
$c>= :: PrimType -> PrimType -> Bool
> :: PrimType -> PrimType -> Bool
$c> :: PrimType -> PrimType -> Bool
<= :: PrimType -> PrimType -> Bool
$c<= :: PrimType -> PrimType -> Bool
< :: PrimType -> PrimType -> Bool
$c< :: PrimType -> PrimType -> Bool
compare :: PrimType -> PrimType -> Ordering
$ccompare :: PrimType -> PrimType -> Ordering
Ord)

-- | A name for a flowtyped data-type. These are returned by 'dependencies'.
data FlowName where
  FlowName ::(FlowTyped a) => Proxy a -> Text -> FlowName

data Flowable where
  Flowable ::(FlowTyped 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 :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Showy FlowTypeF a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
i (Showy FlowTypeF (Inj s a)
a) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
i FlowTypeF (Inj s a)
a


--------------------------------------------------------------------------------
-- Magical newtype for injecting showsPrec into any arbitrary Show

inj :: Proxy s -> a -> Inj s a
inj :: forall {k} (s :: k) a. Proxy s -> a -> Inj s a
inj Proxy s
_ = forall {k} (s :: k) a. a -> Inj s a
Inj

newtype Inj s a = Inj a
-- needs UndecidableInstances

instance Reifies s (Int -> a -> ShowS) => Show (Inj s a) where
  showsPrec :: Int -> Inj s a -> ShowS
showsPrec Int
i (Inj a
a) = forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
reflect (forall {k} (t :: k). Proxy t
Proxy :: Proxy s) Int
i a
a

--------------------------------------------------------------------------------

data RenderMode = RenderTypeScript | RenderFlow
  deriving (RenderMode -> RenderMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderMode -> RenderMode -> Bool
$c/= :: RenderMode -> RenderMode -> Bool
== :: RenderMode -> RenderMode -> Bool
$c== :: RenderMode -> RenderMode -> Bool
Eq, Int -> RenderMode -> ShowS
[RenderMode] -> ShowS
RenderMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderMode] -> ShowS
$cshowList :: [RenderMode] -> ShowS
show :: RenderMode -> String
$cshow :: RenderMode -> String
showsPrec :: Int -> RenderMode -> ShowS
$cshowsPrec :: Int -> RenderMode -> ShowS
Show)

data RenderOptions = RenderOptions
  { RenderOptions -> RenderMode
renderMode :: !RenderMode
  }
  deriving (RenderOptions -> RenderOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderOptions -> RenderOptions -> Bool
$c/= :: RenderOptions -> RenderOptions -> Bool
== :: RenderOptions -> RenderOptions -> Bool
$c== :: RenderOptions -> RenderOptions -> Bool
Eq, Int -> RenderOptions -> ShowS
[RenderOptions] -> ShowS
RenderOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderOptions] -> ShowS
$cshowList :: [RenderOptions] -> ShowS
show :: RenderOptions -> String
$cshow :: RenderOptions -> String
showsPrec :: Int -> RenderOptions -> ShowS
$cshowsPrec :: Int -> RenderOptions -> ShowS
Show)

instance Show FlowName where
  show :: FlowName -> String
show (FlowName Proxy a
_ Text
t) = forall a. Show a => a -> String
show Text
t

instance Eq FlowName where
  FlowName Proxy a
_t0 Text
n0 == :: FlowName -> FlowName -> Bool
== FlowName Proxy a
_t1 Text
n1 = Text
n0 forall a. Eq a => a -> a -> Bool
== Text
n1
    -- case eqT :: Maybe (t0 :~: t1) of
    --   Just Refl -> (t0, n0) == (t1, n1)
    --   Nothing -> False

instance Ord FlowName where
  FlowName Proxy a
_t0 Text
n0 compare :: FlowName -> FlowName -> Ordering
`compare` FlowName Proxy a
_t1 Text
n1 = Text
n0 forall a. Ord a => a -> a -> Ordering
`compare` Text
n1
  -- XXX this breaks using (typeRep t0, n0) `compare` (typeRep t1, n1) for some
  -- reason... dunno why

instance Show Flowable where
  show :: Flowable -> String
show (Flowable Proxy a
t) = forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
t)

instance Eq Flowable where
  Flowable Proxy a
a == :: Flowable -> Flowable -> Bool
== Flowable Proxy a
b = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a forall a. Eq a => a -> a -> Bool
== forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b

instance Ord Flowable where
  Flowable Proxy a
a compare :: Flowable -> Flowable -> Ordering
`compare` Flowable Proxy a
b = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
a forall a. Ord a => a -> a -> Ordering
`compare` forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
b

-- 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 $bFObject :: HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
$mFObject :: forall {r}.
Fix FlowTypeF
-> (HashMap Text (Fix FlowTypeF) -> r) -> ((# #) -> r) -> r
FObject x = Fix (Object x)

pattern FExactObject :: HashMap Text FlowType -> FlowType
pattern $bFExactObject :: HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
$mFExactObject :: forall {r}.
Fix FlowTypeF
-> (HashMap Text (Fix FlowTypeF) -> r) -> ((# #) -> r) -> r
FExactObject x = Fix (ExactObject x)

pattern FObjectMap :: Text -> FlowType -> FlowType -> FlowType
pattern $bFObjectMap :: Text -> Fix FlowTypeF -> Fix FlowTypeF -> Fix FlowTypeF
$mFObjectMap :: forall {r}.
Fix FlowTypeF
-> (Text -> Fix FlowTypeF -> Fix FlowTypeF -> r)
-> ((# #) -> r)
-> r
FObjectMap keyName keyType vals = Fix (ObjectMap keyName keyType vals)

pattern FArray :: FlowType -> FlowType
pattern $bFArray :: Fix FlowTypeF -> Fix FlowTypeF
$mFArray :: forall {r}.
Fix FlowTypeF -> (Fix FlowTypeF -> r) -> ((# #) -> r) -> r
FArray a = Fix (Array a)

pattern FTuple :: Vector FlowType -> FlowType
pattern $bFTuple :: Vector (Fix FlowTypeF) -> Fix FlowTypeF
$mFTuple :: forall {r}.
Fix FlowTypeF -> (Vector (Fix FlowTypeF) -> r) -> ((# #) -> r) -> r
FTuple a = Fix (Tuple a)

pattern FLabelledTuple :: Vector (Maybe Text, FlowType) -> FlowType
pattern $bFLabelledTuple :: Vector (Maybe Text, Fix FlowTypeF) -> Fix FlowTypeF
$mFLabelledTuple :: forall {r}.
Fix FlowTypeF
-> (Vector (Maybe Text, Fix FlowTypeF) -> r) -> ((# #) -> r) -> r
FLabelledTuple a = Fix (LabelledTuple a)

pattern FFun :: Vector (Text, FlowType) -> FlowType -> FlowType
pattern $bFFun :: Vector (Text, Fix FlowTypeF) -> Fix FlowTypeF -> Fix FlowTypeF
$mFFun :: forall {r}.
Fix FlowTypeF
-> (Vector (Text, Fix FlowTypeF) -> Fix FlowTypeF -> r)
-> ((# #) -> r)
-> r
FFun v t = Fix (Fun v t)

pattern FAlt :: FlowType -> FlowType -> FlowType
pattern $bFAlt :: Fix FlowTypeF -> Fix FlowTypeF -> Fix FlowTypeF
$mFAlt :: forall {r}.
Fix FlowTypeF
-> (Fix FlowTypeF -> Fix FlowTypeF -> r) -> ((# #) -> r) -> r
FAlt a b = Fix (Alt a b)

pattern FPrim :: PrimType -> FlowType
pattern $bFPrim :: PrimType -> Fix FlowTypeF
$mFPrim :: forall {r}. Fix FlowTypeF -> (PrimType -> r) -> ((# #) -> r) -> r
FPrim a = Fix (Prim a)

pattern FPrimBoolean :: FlowType
pattern $bFPrimBoolean :: Fix FlowTypeF
$mFPrimBoolean :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimBoolean = FPrim Boolean

pattern FPrimNumber :: FlowType
pattern $bFPrimNumber :: Fix FlowTypeF
$mFPrimNumber :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimNumber = FPrim Number

pattern FPrimString :: FlowType
pattern $bFPrimString :: Fix FlowTypeF
$mFPrimString :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimString = FPrim String

pattern FPrimBottom :: FlowType
pattern $bFPrimBottom :: Fix FlowTypeF
$mFPrimBottom :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimBottom = FPrim Bottom

pattern FPrimMixed :: FlowType
pattern $bFPrimMixed :: Fix FlowTypeF
$mFPrimMixed :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimMixed = FPrim Mixed

pattern FPrimUnknown :: FlowType
pattern $bFPrimUnknown :: Fix FlowTypeF
$mFPrimUnknown :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimUnknown = FPrim Mixed

pattern FPrimAny :: FlowType
pattern $bFPrimAny :: Fix FlowTypeF
$mFPrimAny :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimAny = FPrim Any

pattern FPrimNever :: FlowType
pattern $bFPrimNever :: Fix FlowTypeF
$mFPrimNever :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimNever = FPrim Bottom

pattern FPrimNull :: FlowType
pattern $bFPrimNull :: Fix FlowTypeF
$mFPrimNull :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimNull = FPrim Null

pattern FPrimUndefined :: FlowType
pattern $bFPrimUndefined :: Fix FlowTypeF
$mFPrimUndefined :: forall {r}. Fix FlowTypeF -> ((# #) -> r) -> ((# #) -> r) -> r
FPrimUndefined = FPrim Undefined

pattern FNullable :: FlowType -> FlowType
pattern $bFNullable :: Fix FlowTypeF -> Fix FlowTypeF
$mFNullable :: forall {r}.
Fix FlowTypeF -> (Fix FlowTypeF -> r) -> ((# #) -> r) -> r
FNullable a = Fix (Nullable a)

pattern FOmitable :: FlowType -> FlowType
pattern $bFOmitable :: Fix FlowTypeF -> Fix FlowTypeF
$mFOmitable :: forall {r}.
Fix FlowTypeF -> (Fix FlowTypeF -> r) -> ((# #) -> r) -> r
FOmitable a = Fix (Omitable a)

pattern FLiteral :: A.Value -> FlowType
pattern $bFLiteral :: Value -> Fix FlowTypeF
$mFLiteral :: forall {r}. Fix FlowTypeF -> (Value -> r) -> ((# #) -> r) -> r
FLiteral a = Fix (Literal a)

pattern FTag :: Text -> FlowType
pattern $bFTag :: Text -> Fix FlowTypeF
$mFTag :: forall {r}. Fix FlowTypeF -> (Text -> r) -> ((# #) -> r) -> r
FTag a = Fix (Tag a)

pattern FName :: FlowName -> FlowType
pattern $bFName :: FlowName -> Fix FlowTypeF
$mFName :: forall {r}. Fix FlowTypeF -> (FlowName -> r) -> ((# #) -> r) -> r
FName a = Fix (CallType a [])

pattern FGenericParam :: Int -> FlowType
pattern $bFGenericParam :: Int -> Fix FlowTypeF
$mFGenericParam :: forall {r}. Fix FlowTypeF -> (Int -> r) -> ((# #) -> r) -> r
FGenericParam a = Fix (GenericParam a)

pattern FCallType :: FlowName -> [FlowType] -> FlowType
pattern $bFCallType :: FlowName -> [Fix FlowTypeF] -> Fix FlowTypeF
$mFCallType :: forall {r}.
Fix FlowTypeF
-> (FlowName -> [Fix FlowTypeF] -> r) -> ((# #) -> r) -> r
FCallType f xs = Fix (CallType f xs)

pattern FTypeDoc :: Vector Text -> FlowType -> FlowType
pattern $bFTypeDoc :: Vector Text -> Fix FlowTypeF -> Fix FlowTypeF
$mFTypeDoc :: forall {r}.
Fix FlowTypeF
-> (Vector Text -> Fix FlowTypeF -> r) -> ((# #) -> r) -> r
FTypeDoc f xs = Fix (TypeDoc f xs)

--------------------------------------------------------------------------------

instance Show1 FlowTypeF where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FlowTypeF a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
i FlowTypeF a
a =
    forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
i (forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify Int -> a -> ShowS
sp (\Proxy s
p -> forall (f :: * -> *) a {k} (s :: k).
Reifies s (Int -> a -> ShowS) =>
f (Inj s a) -> Showy f a
Showy (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (s :: k) a. Proxy s -> a -> Inj s a
inj Proxy s
p) FlowTypeF a
a)))

type FlowType = Fix FlowTypeF

text :: Text -> PP.Doc
text :: Text -> Doc
text = String -> Doc
PP.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

squotes :: Text -> PP.Doc
squotes :: Text -> Doc
squotes = Doc -> Doc
PP.squotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"'" Text
"\\'"

type Poly = ReaderT RenderOptions (Reader [Flowable])

ppAlts :: [FlowType] -> FlowType -> Poly PP.Doc
ppAlts :: [Fix FlowTypeF] -> Fix FlowTypeF -> Poly Doc
ppAlts [Fix FlowTypeF]
alts (Fix FlowTypeF (Fix FlowTypeF)
f) = case FlowTypeF (Fix FlowTypeF)
f of
  Alt Fix FlowTypeF
a Fix FlowTypeF
b -> [Fix FlowTypeF] -> Fix FlowTypeF -> Poly Doc
ppAlts (Fix FlowTypeF
a forall a. a -> [a] -> [a]
: [Fix FlowTypeF]
alts) Fix FlowTypeF
b
  FlowTypeF (Fix FlowTypeF)
x -> Doc -> Doc
PP.align forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
sep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Fix FlowTypeF -> Poly Doc
pp (forall a. [a] -> [a]
reverse (forall (f :: * -> *). f (Fix f) -> Fix f
Fix FlowTypeF (Fix FlowTypeF)
x forall a. a -> [a] -> [a]
: [Fix FlowTypeF]
alts))
 where
  sep :: [Doc] -> Doc
sep [Doc
x] = Doc
x
  sep (Doc
x : [Doc]
xs) = Doc
x Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.string String
"|" Doc -> Doc -> Doc
PP.<$> [Doc] -> Doc
sep [Doc]
xs
  sep [Doc]
_ = Doc
PP.empty

braceList :: [PP.Doc] -> PP.Doc
braceList :: [Doc] -> Doc
braceList =
  (\Doc
s -> Doc
PP.lbrace Doc -> Doc -> Doc
PP.</> Doc
s Doc -> Doc -> Doc
PP.</> Doc
PP.rbrace)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
PP.align
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
PP.sep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma

braceBarList :: [PP.Doc] -> PP.Doc
braceBarList :: [Doc] -> Doc
braceBarList =
  (\Doc
s -> String -> Doc
PP.text String
"{|" Doc -> Doc -> Doc
PP.</> Doc
s Doc -> Doc -> Doc
PP.</> String -> Doc
PP.text String
"|}")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
PP.align
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
PP.sep
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma

ppJson :: A.Value -> PP.Doc
ppJson :: Value -> Doc
ppJson Value
v = case Value
v of
  A.Array Array
a -> [Doc] -> Doc
PP.list (forall a b. (a -> b) -> [a] -> [b]
map Value -> Doc
ppJson (forall a. Vector a -> [a]
V.toList Array
a))
  A.String Text
t -> Text -> Doc
squotes Text
t
  A.Number Scientific
n -> String -> Doc
PP.string (forall a. Show a => a -> String
show Scientific
n)
  A.Bool Bool
t -> if Bool
t then String -> Doc
PP.string String
"true" else String -> Doc
PP.string String
"false"
  Value
A.Null -> String -> Doc
PP.string String
"null"
  A.Object Object
obj -> [Doc] -> Doc
braceBarList
    (forall a b. (a -> b) -> [a] -> [b]
map
      (\(Key
name, Value
fty) ->
        Doc
PP.space
          forall a. Semigroup a => a -> a -> a
PP.<> Text -> Doc
text (Key -> Text
AK.toText Key
name)
          Doc -> Doc -> Doc
PP.<+> Doc
PP.colon
          Doc -> Doc -> Doc
PP.<+> Value -> Doc
ppJson Value
fty
          forall a. Semigroup a => a -> a -> a
PP.<> Doc
PP.space
      )
      (forall v. KeyMap v -> [(Key, v)]
AKM.toList Object
obj)
    )

mayWrap :: FlowType -> PP.Doc -> PP.Doc
mayWrap :: Fix FlowTypeF -> Doc -> Doc
mayWrap (Fix FlowTypeF (Fix FlowTypeF)
f) Doc
x = case FlowTypeF (Fix FlowTypeF)
f of
  Nullable Fix FlowTypeF
_ -> Doc -> Doc
PP.parens Doc
x
  Omitable Fix FlowTypeF
_ -> Doc -> Doc
PP.parens Doc
x
  Alt Fix FlowTypeF
_ Fix FlowTypeF
_ -> Doc -> Doc
PP.parens Doc
x
  Array Fix FlowTypeF
_ -> Doc -> Doc
PP.parens Doc
x
  FlowTypeF (Fix FlowTypeF)
_ -> Doc
x

ppObject :: HashMap Text FlowType -> Poly [PP.Doc]
ppObject :: HashMap Text (Fix FlowTypeF) -> Poly [Doc]
ppObject = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Fix FlowTypeF) -> Poly Doc
ppField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
H.toList
 where
  ppField :: (Text, Fix FlowTypeF) -> Poly Doc
ppField (Text
name, Fix FlowTypeF
fty) = do
    case Fix FlowTypeF
fty of
      Fix (Omitable Fix FlowTypeF
fty') ->
        -- key?: type
        (\Doc
fty'' -> Text -> Doc
text Text
name forall a. Semigroup a => a -> a -> a
PP.<> String -> Doc
PP.text String
"?" forall a. Semigroup a => a -> a -> a
PP.<> Doc
PP.colon Doc -> Doc -> Doc
PP.<+> Doc
fty'')
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
fty'

      Fix FlowTypeF
fty' ->
        -- key: type
        (\Doc
fty'' -> Text -> Doc
text Text
name forall a. Semigroup a => a -> a -> a
PP.<> Doc
PP.colon Doc -> Doc -> Doc
PP.<+> Doc
fty'') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
fty'

polyVarNames :: [Text]
polyVarNames :: [Text]
polyVarNames =
  forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'A' .. Char
'Z']
    forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Text
t -> Text
t Text -> Text -> Text
`T.append` String -> Text
T.pack (forall a. Show a => a -> String
show Int
i)) [Int
0 :: Int ..] [Text]
polyVarNames

pp :: FlowType -> Poly PP.Doc
pp :: Fix FlowTypeF -> Poly Doc
pp (Fix FlowTypeF (Fix FlowTypeF)
ft) = case FlowTypeF (Fix FlowTypeF)
ft of
  ObjectMap Text
keyName Fix FlowTypeF
keyType Fix FlowTypeF
a -> do
    Doc
keyTy <- Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
keyType
    Doc
r <- Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
a
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ([Doc] -> Doc
braceList
        [ Doc -> Doc
PP.brackets (Text -> Doc
text Text
keyName forall a. Semigroup a => a -> a -> a
PP.<> String -> Doc
PP.text String
":" Doc -> Doc -> Doc
PP.<+> Doc
keyTy)
          forall a. Semigroup a => a -> a -> a
PP.<> Doc
PP.colon
          Doc -> Doc -> Doc
PP.<+> Doc
r
        ]
      )

  Object HashMap Text (Fix FlowTypeF)
hm -> [Doc] -> Doc
braceList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Fix FlowTypeF) -> Poly [Doc]
ppObject HashMap Text (Fix FlowTypeF)
hm

  ExactObject HashMap Text (Fix FlowTypeF)
hm -> do
    RenderMode
mode <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderOptions -> RenderMode
renderMode
    case RenderMode
mode of
      RenderMode
RenderFlow -> [Doc] -> Doc
braceBarList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Fix FlowTypeF) -> Poly [Doc]
ppObject HashMap Text (Fix FlowTypeF)
hm
      RenderMode
RenderTypeScript -> [Doc] -> Doc
braceList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Fix FlowTypeF) -> Poly [Doc]
ppObject HashMap Text (Fix FlowTypeF)
hm

  -- x[]
  Array Fix FlowTypeF
a -> (\Doc
r -> Fix FlowTypeF -> Doc -> Doc
mayWrap Fix FlowTypeF
a Doc
r forall a. Semigroup a => a -> a -> a
PP.<> String -> Doc
PP.string String
"[]") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
a

  -- [x, y, z]
  Tuple Vector (Fix FlowTypeF)
t -> [Doc] -> Doc
PP.list forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Fix FlowTypeF -> Poly Doc
pp (forall a. Vector a -> [a]
V.toList Vector (Fix FlowTypeF)
t)

  -- [l1: x, y, l2: z]
  LabelledTuple Vector (Maybe Text, Fix FlowTypeF)
t -> [Doc] -> Doc
PP.list forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
    (\(Maybe Text
mlbl, Fix FlowTypeF
ty) -> case Maybe Text
mlbl of
      Just Text
lbl -> ((Text -> Doc
text Text
lbl forall a. Semigroup a => a -> a -> a
PP.<> String -> Doc
PP.string String
":") Doc -> Doc -> Doc
PP.<+>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
ty
      Maybe Text
Nothing -> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
ty
    )
    (forall a. Vector a -> [a]
V.toList Vector (Maybe Text, Fix FlowTypeF)
t)

  Alt Fix FlowTypeF
a Fix FlowTypeF
b -> [Fix FlowTypeF] -> Fix FlowTypeF -> Poly Doc
ppAlts [Fix FlowTypeF
a] Fix FlowTypeF
b

  Prim PrimType
pt -> do
    RenderMode
mode <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RenderOptions -> RenderMode
renderMode
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case PrimType
pt of
      PrimType
Boolean -> String -> Doc
PP.text String
"boolean"
      PrimType
Number -> String -> Doc
PP.text String
"number"
      PrimType
String -> String -> Doc
PP.text String
"string"
      PrimType
Null -> String -> Doc
PP.text String
"null"
      PrimType
Undefined -> String -> Doc
PP.text String
"undefined"
      PrimType
Any -> String -> Doc
PP.text String
"any"
      PrimType
Mixed -> case RenderMode
mode of
        RenderMode
RenderFlow -> String -> Doc
PP.text String
"mixed"
        RenderMode
RenderTypeScript -> String -> Doc
PP.text String
"unknown"
      PrimType
Bottom -> case RenderMode
mode of
        RenderMode
RenderFlow -> String -> Doc
PP.text String
"empty"
        RenderMode
RenderTypeScript -> String -> Doc
PP.text String
"never"

  Nullable Fix FlowTypeF
a ->
    -- n.b. there is no 'undefined' in json. void is undefined | null in both ts
    -- and flow (and ?x syntax for void|x)
    (\Doc
a' -> String -> Doc
PP.text String
"null" Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.string String
"|" Doc -> Doc -> Doc
PP.<+> Doc
a') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
a

  Omitable Fix FlowTypeF
a -> Fix FlowTypeF -> Poly Doc
pp (Fix FlowTypeF -> Fix FlowTypeF
FNullable Fix FlowTypeF
a)

  Literal Value
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Doc
ppJson Value
a)

  Tag Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Doc
squotes Text
t)

  GenericParam Int
ix -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Doc
text ([Text]
polyVarNames forall a. [a] -> Int -> a
!! Int
ix))

  CallType (FlowName Proxy a
_ Text
t) [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Doc
text Text
t)

  CallType (FlowName Proxy a
_ Text
t) [Fix FlowTypeF]
args -> do
    [Doc]
vs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Fix FlowTypeF -> Poly Doc
pp [Fix FlowTypeF]
args
    forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Doc
text Text
t forall a. Semigroup a => a -> a -> a
PP.<> Doc -> Doc
PP.angles ([Doc] -> Doc
PP.hsep (Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma [Doc]
vs)))

  TypeDoc Vector Text
_doc Fix FlowTypeF
t -> Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
t

  FlowTypeF (Fix FlowTypeF)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Doc
PP.string (forall a. Show a => a -> String
show FlowTypeF (Fix FlowTypeF)
ft))

-- | Pretty-print a flowtype in flowtype syntax
renderTypeWithOptions :: RenderOptions -> FlowType -> [Flowable] -> PP.Doc
renderTypeWithOptions :: RenderOptions -> Fix FlowTypeF -> [Flowable] -> Doc
renderTypeWithOptions RenderOptions
opts Fix FlowTypeF
ft [Flowable]
params =
  (Fix FlowTypeF -> Poly Doc
pp Fix FlowTypeF
ft forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` RenderOptions
opts) forall r a. Reader r a -> r -> a
`runReader` [Flowable]
params

-- | Pretty-print a flowtype in flowtype syntax
showFlowType :: FlowType -> [Flowable] -> Text
showFlowType :: Fix FlowTypeF -> [Flowable] -> Text
showFlowType Fix FlowTypeF
ft [Flowable]
params = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RenderOptions -> Fix FlowTypeF -> [Flowable] -> Doc
renderTypeWithOptions
  RenderOptions { renderMode :: RenderMode
renderMode = RenderMode
RenderFlow }
  Fix FlowTypeF
ft
  [Flowable]
params

-- | Pretty-print a flowtype in flowtype syntax
showTypeScriptType :: FlowType -> [Flowable] -> Text
showTypeScriptType :: Fix FlowTypeF -> [Flowable] -> Text
showTypeScriptType Fix FlowTypeF
ft [Flowable]
params = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ RenderOptions -> Fix FlowTypeF -> [Flowable] -> Doc
renderTypeWithOptions
  RenderOptions { renderMode :: RenderMode
renderMode = RenderMode
RenderTypeScript }
  Fix FlowTypeF
ft
  [Flowable]
params

--------------------------------------------------------------------------------
-- Module exporting

-- | Generate a @ export type @ declaration.
exportTypeAs :: RenderOptions -> Text -> FlowType -> [Flowable] -> Text
exportTypeAs :: RenderOptions -> Text -> Fix FlowTypeF -> [Flowable] -> Text
exportTypeAs RenderOptions
opts = RenderOptions
-> Bool -> Text -> Fix FlowTypeF -> [Flowable] -> Text
showTypeAs RenderOptions
opts Bool
True

-- | Generate a @ type @ declaration, possibly an export.
showTypeAs :: RenderOptions -> Bool -> Text -> FlowType -> [Flowable] -> Text
showTypeAs :: RenderOptions
-> Bool -> Text -> Fix FlowTypeF -> [Flowable] -> Text
showTypeAs RenderOptions
opts Bool
isExport Text
name Fix FlowTypeF
ft [Flowable]
params =
  String -> Text
T.pack
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render
    forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.string (if Bool
isExport then String
"export type " else String
"type ")
    forall a. Semigroup a => a -> a -> a
PP.<> Text -> Doc
text Text
name
    forall a. Semigroup a => a -> a -> a
PP.<> Doc
renderedParams
    Doc -> Doc -> Doc
PP.<+> Text -> Doc
text Text
"="
    Doc -> Doc -> Doc
PP.<+> Doc
renderedTypeDecl
    forall a. Semigroup a => a -> a -> a
PP.<> Text -> Doc
text Text
";"
    forall a. Semigroup a => a -> a -> a
PP.<> Doc
PP.linebreak
 where
  renderedTypeDecl :: Doc
renderedTypeDecl = RenderOptions -> Fix FlowTypeF -> [Flowable] -> Doc
renderTypeWithOptions RenderOptions
opts Fix FlowTypeF
ft [Flowable]
params
  renderedParams :: Doc
renderedParams
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Flowable]
params = forall a. Monoid a => a
mempty
    | Bool
otherwise = Doc -> Doc
PP.angles
      ([Doc] -> Doc
PP.hsep
        (Doc -> [Doc] -> [Doc]
PP.punctuate Doc
PP.comma (forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
text (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Flowable]
params) [Text]
polyVarNames)))
      )

  render :: Doc -> String
render = (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> ShowS
PP.displayS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int -> Doc -> SimpleDoc
PP.renderPretty Float
1.0 Int
80

-- | Compute all the dependencies of a 'FlowTyped' thing, including itself.
dependencies :: (FlowTyped a) => Proxy a -> Set.Set FlowName
dependencies :: forall a. FlowTyped a => Proxy a -> Set FlowName
dependencies Proxy a
p0 =
  (case forall a. FlowTyped a => Proxy a -> Maybe Text
flowTypeName Proxy a
p0 of
      Just Text
t -> forall a. Ord a => a -> Set a -> Set a
Set.insert (forall a. FlowTyped a => Proxy a -> Text -> FlowName
FlowName Proxy a
p0 Text
t)
      Maybe Text
Nothing -> forall a. a -> a
id
    )
    (forall a b k. (a -> b -> a) -> a -> Map k b -> a
M.foldl' forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a. Set a
Set.empty (Flowable
-> Map Flowable (Set FlowName) -> Map Flowable (Set FlowName)
transitiveDeps (forall a. FlowTyped a => Proxy a -> Flowable
Flowable Proxy a
p0) forall k a. Map k a
M.empty))
 where
  flowNameToFlowable :: FlowName -> Flowable
flowNameToFlowable (FlowName Proxy a
fn Text
_) = forall a. FlowTyped a => Proxy a -> Flowable
Flowable Proxy a
fn

  immediateDeps :: FlowType -> Set.Set FlowName
  immediateDeps :: Fix FlowTypeF -> Set FlowName
immediateDeps (FCallType FlowName
n [Fix FlowTypeF]
tys) =
    forall a. Ord a => a -> Set a -> Set a
Set.insert FlowName
n (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions (forall a b. (a -> b) -> [a] -> [b]
map Fix FlowTypeF -> Set FlowName
immediateDeps [Fix FlowTypeF]
tys))
  immediateDeps (Fix FlowTypeF (Fix FlowTypeF)
p) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Fix FlowTypeF -> Set FlowName
immediateDeps FlowTypeF (Fix FlowTypeF)
p

  transitiveDeps
    :: Flowable
    -> M.Map Flowable (Set.Set FlowName)
    -> M.Map Flowable (Set.Set FlowName)
  transitiveDeps :: Flowable
-> Map Flowable (Set FlowName) -> Map Flowable (Set FlowName)
transitiveDeps fpf :: Flowable
fpf@(Flowable Proxy a
p) Map Flowable (Set FlowName)
acc
    | Flowable
fpf forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map Flowable (Set FlowName)
acc
    = let imms :: Set FlowName
imms = Fix FlowTypeF -> Set FlowName
immediateDeps (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
flowType Proxy a
p)
          withThis :: Map Flowable (Set FlowName)
withThis = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Flowable
fpf Set FlowName
imms Map Flowable (Set FlowName)
acc
      in  forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' (Flowable
-> Map Flowable (Set FlowName) -> Map Flowable (Set FlowName)
transitiveDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowName -> Flowable
flowNameToFlowable) Map Flowable (Set FlowName)
withThis Set FlowName
imms
    | Bool
otherwise
    = Map Flowable (Set FlowName)
acc

data ModuleOptions = ModuleOptions
  { -- | You might want to change this to include e.g. flow-runtime
    ModuleOptions -> [Text]
pragmas :: [Text]
  , ModuleOptions -> [Text]
header :: [Text]
  , ModuleOptions -> Bool
exportDeps :: Bool
  , ModuleOptions -> Bool
computeDeps :: Bool
  , ModuleOptions -> RenderOptions
renderOptions :: RenderOptions
  }
  deriving (ModuleOptions -> ModuleOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleOptions -> ModuleOptions -> Bool
$c/= :: ModuleOptions -> ModuleOptions -> Bool
== :: ModuleOptions -> ModuleOptions -> Bool
$c== :: ModuleOptions -> ModuleOptions -> Bool
Eq, Int -> ModuleOptions -> ShowS
[ModuleOptions] -> ShowS
ModuleOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleOptions] -> ShowS
$cshowList :: [ModuleOptions] -> ShowS
show :: ModuleOptions -> String
$cshow :: ModuleOptions -> String
showsPrec :: Int -> ModuleOptions -> ShowS
$cshowsPrec :: Int -> ModuleOptions -> ShowS
Show)

flowModuleOptions :: ModuleOptions
flowModuleOptions :: ModuleOptions
flowModuleOptions = ModuleOptions
  { pragmas :: [Text]
pragmas = [Text
"// @flow"]
  , header :: [Text]
header = [Text
"This module has been generated by aeson-flowtyped."]
  , exportDeps :: Bool
exportDeps = Bool
True
  , computeDeps :: Bool
computeDeps = Bool
True
  , renderOptions :: RenderOptions
renderOptions = RenderOptions { renderMode :: RenderMode
renderMode = RenderMode
RenderFlow }
  }

typeScriptModuleOptions :: ModuleOptions
typeScriptModuleOptions :: ModuleOptions
typeScriptModuleOptions = ModuleOptions
  { pragmas :: [Text]
pragmas = []
  , header :: [Text]
header = [Text
"This module has been generated by aeson-flowtyped."]
  , exportDeps :: Bool
exportDeps = Bool
True
  , computeDeps :: Bool
computeDeps = Bool
True
  , renderOptions :: RenderOptions
renderOptions = RenderOptions { renderMode :: RenderMode
renderMode = RenderMode
RenderTypeScript }
  }

data Export where
  Export ::FlowTyped a => Proxy a -> Export

export :: forall a . FlowTyped a => Export
export :: forall a. FlowTyped a => Export
export = forall a. FlowTyped a => Proxy a -> Export
Export (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance Eq Export where
  Export Proxy a
p0 == :: Export -> Export -> Bool
== Export Proxy a
p1 =
    forall a. FlowTyped a => Proxy a -> Maybe Text
flowTypeName Proxy a
p0 forall a. Eq a => a -> a -> Bool
== forall a. FlowTyped a => Proxy a -> Maybe Text
flowTypeName Proxy a
p1 Bool -> Bool -> Bool
|| forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p0 forall a. Eq a => a -> a -> Bool
== forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
p1

exportsDependencies :: [Export] -> Set.Set FlowName
exportsDependencies :: [Export] -> Set FlowName
exportsDependencies = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b. (a -> b) -> a -> b
$ \Export
e -> case Export
e of
  Export Proxy a
a -> forall a. FlowTyped a => Proxy a -> Set FlowName
dependencies Proxy a
a

generateModule :: ModuleOptions -> [Export] -> Text
generateModule :: ModuleOptions -> [Export] -> Text
generateModule ModuleOptions
opts [Export]
exports =
  [Text] -> Text
T.unlines
    forall a b. (a -> b) -> a -> b
$ (\[Text]
m ->
        (ModuleOptions -> [Text]
pragmas ModuleOptions
opts forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text
"// " Text -> Text -> Text
`T.append`) (ModuleOptions -> [Text]
header ModuleOptions
opts)) forall a. [a] -> [a] -> [a]
++ (Text
T.empty forall a. a -> [a] -> [a]
: [Text]
m)
      )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FlowName -> Text
flowDecl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Export] -> [FlowName]
flowNames
    forall a b. (a -> b) -> a -> b
$ [Export]
exports
 where
  flowNames :: [Export] -> [FlowName]
flowNames = if ModuleOptions -> Bool
computeDeps ModuleOptions
opts
    then forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Export] -> Set FlowName
exportsDependencies
    else forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map
      (\Export
ex -> case Export
ex of
        Export Proxy a
p -> forall a. FlowTyped a => Proxy a -> Text -> FlowName
FlowName Proxy a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FlowTyped a => Proxy a -> Maybe Text
flowTypeName Proxy a
p
      )

  flowDecl :: FlowName -> Text
flowDecl (FlowName Proxy a
p Text
name) = if forall a. FlowTyped a => Proxy a -> Export
Export Proxy a
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Export]
exports Bool -> Bool -> Bool
|| ModuleOptions -> Bool
exportDeps ModuleOptions
opts
    then RenderOptions
-> Bool -> Text -> Fix FlowTypeF -> [Flowable] -> Text
showTypeAs (ModuleOptions -> RenderOptions
renderOptions ModuleOptions
opts) Bool
True Text
name (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
flowType Proxy a
p) (forall a. FlowTyped a => Proxy a -> [Flowable]
flowTypeVars Proxy a
p)
    else RenderOptions
-> Bool -> Text -> Fix FlowTypeF -> [Flowable] -> Text
showTypeAs (ModuleOptions -> RenderOptions
renderOptions ModuleOptions
opts)
                    Bool
False
                    Text
name
                    (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
flowType Proxy a
p)
                    (forall a. FlowTyped a => Proxy a -> [Flowable]
flowTypeVars Proxy a
p)

writeModule :: ModuleOptions -> FilePath -> [Export] -> IO ()
writeModule :: ModuleOptions -> String -> [Export] -> IO ()
writeModule ModuleOptions
opts String
path = String -> Text -> IO ()
TIO.writeFile String
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleOptions -> [Export] -> Text
generateModule ModuleOptions
opts

--------------------------------------------------------------------------------

type family FlowDeconstructField (k :: t) :: (Symbol, *)
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 :: * -> [k] -> * where
  FlowTyFields ::FlowTyFields k fs

class ReifyFlowTyFields a where
  reifyFlowTyFields :: Proxy a -> HashMap Text FlowType -> HashMap Text FlowType

instance ReifyFlowTyFields '[] where
  reifyFlowTyFields :: Proxy '[]
-> HashMap Text (Fix FlowTypeF) -> HashMap Text (Fix FlowTypeF)
reifyFlowTyFields Proxy '[]
_ = forall a. a -> a
id

instance ( FlowDeconstructField x ~ '(k, v)
         , KnownSymbol k
         , FlowTyped v
         , ReifyFlowTyFields xs
         ) =>
         ReifyFlowTyFields (x:xs) where
  reifyFlowTyFields :: Proxy (x : xs)
-> HashMap Text (Fix FlowTypeF) -> HashMap Text (Fix FlowTypeF)
reifyFlowTyFields Proxy (x : xs)
_ HashMap Text (Fix FlowTypeF)
acc =
    forall {k} (a :: k).
ReifyFlowTyFields a =>
Proxy a
-> HashMap Text (Fix FlowTypeF) -> HashMap Text (Fix FlowTypeF)
reifyFlowTyFields (forall {k} (t :: k). Proxy t
Proxy :: Proxy xs)
      forall a b. (a -> b) -> a -> b
$! forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert (String -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy k)))
                  (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
flowType (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))
                  HashMap Text (Fix FlowTypeF)
acc

instance (FlowTyped a, ReifyFlowTyFields (fs :: [k]), Typeable fs, Typeable k) => FlowTyped (FlowTyFields a fs) where
  flowType :: Proxy (FlowTyFields a fs) -> Fix FlowTypeF
flowType Proxy (FlowTyFields a fs)
_ = HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject (forall {k} (a :: k).
ReifyFlowTyFields a =>
Proxy a
-> HashMap Text (Fix FlowTypeF) -> HashMap Text (Fix FlowTypeF)
reifyFlowTyFields (forall {k} (t :: k). Proxy t
Proxy :: Proxy fs) forall k v. HashMap k v
H.empty)
  flowTypeName :: Proxy (FlowTyFields a fs) -> Maybe Text
flowTypeName Proxy (FlowTyFields a fs)
_ = forall a. FlowTyped a => Proxy a -> Maybe Text
flowTypeName (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

--------------------------------------------------------------------------------

callType' :: (FlowTyped a) => Proxy a -> [FlowType] -> FlowType
callType' :: forall a.
FlowTyped a =>
Proxy a -> [Fix FlowTypeF] -> Fix FlowTypeF
callType' Proxy a
p [Fix FlowTypeF]
args = case forall a. FlowTyped a => Proxy a -> Maybe Text
flowTypeName Proxy a
p of
  Just Text
n -> FlowName -> [Fix FlowTypeF] -> Fix FlowTypeF
FCallType (forall a. FlowTyped a => Proxy a -> Text -> FlowName
FlowName Proxy a
p Text
n) [Fix FlowTypeF]
args
  Maybe Text
Nothing -> forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
flowType Proxy a
p

callType :: forall a . FlowTyped a => Proxy a -> FlowType
callType :: forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType Proxy a
p = forall a.
FlowTyped a =>
Proxy a -> [Fix FlowTypeF] -> Fix FlowTypeF
callType' Proxy a
p (forall a b. (a -> b) -> [a] -> [b]
map (\(Flowable Proxy a
t) -> forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType Proxy a
t) (forall a. FlowTyped a => Proxy a -> [Flowable]
flowTypeVars Proxy a
p))

class Typeable a => FlowTyped a where
  flowType :: Proxy a -> FlowType
  flowTypeName :: Proxy a -> Maybe Text

  flowTypeVars :: Proxy a -> [Flowable]
  flowTypeVars Proxy a
_ = []

  flowOptions :: Proxy a -> Options
  flowOptions Proxy a
_ = Options
A.defaultOptions

  isPrim :: Proxy a -> Bool
  isPrim Proxy a
_ = Bool
False

  default flowType
    :: (SOP.GDatatypeInfo a, SOP.All2 FlowTyped (SOP.GCode a))
    => Proxy a
    -> FlowType
  flowType Proxy a
p = forall (ty :: [[*]]).
All2 FlowTyped ty =>
Options -> DatatypeInfo ty -> Fix FlowTypeF
flowTypeFromSOP (forall a. FlowTyped a => Proxy a -> Options
flowOptions Proxy a
p) (forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
SOP.gdatatypeInfo Proxy a
p)

  default flowTypeName
    :: (Generic a, Rep a ~ D1 ('MetaData name mod pkg t) c, KnownSymbol name)
    => Proxy a
    -> Maybe Text
  flowTypeName = forall a (name :: Symbol) (mod :: Symbol) (pkg :: Symbol)
       (t :: Bool) (c :: * -> *).
(Generic a, Rep a ~ D1 ('MetaData name mod pkg t) c,
 KnownSymbol name) =>
Proxy a -> Maybe Text
defaultFlowTypeName

-- | 'flowType' using 'SOP.HasDatatypeInfo'
defaultFlowType
  :: (SOP.HasDatatypeInfo a, SOP.All2 FlowTyped (SOP.Code a))
  => Options
  -> Proxy a
  -> FlowType
defaultFlowType :: forall a.
(HasDatatypeInfo a, All2 FlowTyped (Code a)) =>
Options -> Proxy a -> Fix FlowTypeF
defaultFlowType Options
opts Proxy a
p = forall (ty :: [[*]]).
All2 FlowTyped ty =>
Options -> DatatypeInfo ty -> Fix FlowTypeF
flowTypeFromSOP Options
opts (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo Proxy a
p)

flowTypeFromSOP
  :: SOP.All2 FlowTyped ty => Options -> SOP.DatatypeInfo ty -> FlowType
flowTypeFromSOP :: forall (ty :: [[*]]).
All2 FlowTyped ty =>
Options -> DatatypeInfo ty -> Fix FlowTypeF
flowTypeFromSOP Options
opts DatatypeInfo ty
di = case [Text]
comments of
  [] -> Fix FlowTypeF
ft
  [Text]
_ -> Vector Text -> Fix FlowTypeF -> Fix FlowTypeF
FTypeDoc (forall a. [a] -> Vector a
V.fromList [Text]
comments) Fix FlowTypeF
ft
 where
  (Fix FlowTypeF
ft, [Text]
comments) =
    (case DatatypeInfo ty
di of
        SOP.ADT String
moduleName String
typeName NP ConstructorInfo ty
constrInfos POP StrictnessInfo ty
_strictness -> do
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (String -> Text
moduleComment String
moduleName forall a. a -> [a] -> [a]
:)
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (String -> Text
typeComment String
typeName forall a. a -> [a] -> [a]
:)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Fix FlowTypeF -> Fix FlowTypeF -> Fix FlowTypeF
FAlt forall a b. (a -> b) -> a -> b
$! case forall (ty :: [[*]]).
NP ConstructorInfo ty
-> Int -> Int -> Int -> Bool -> ConstructorsKind
constrsKind NP ConstructorInfo ty
constrInfos Int
0 Int
0 Int
0 Bool
True of
            ConstructorsKind
SumRecords -> forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
sumEncode NP ConstructorInfo ty
constrInfos
            ConstructorsKind
SumConstructors -> forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
sumEncode NP ConstructorInfo ty
constrInfos
            ConstructorsKind
SumNullaryConstructors -> forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
sumNullaryEncode NP ConstructorInfo ty
constrInfos
            ConstructorsKind
SingleRecord -> forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
singleEncode NP ConstructorInfo ty
constrInfos
            ConstructorsKind
SingleConstructor -> forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
singleEncode NP ConstructorInfo ty
constrInfos
            ConstructorsKind
SingleNullaryConstructor -> [Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple forall a. Vector a
V.empty]
            ConstructorsKind
Unsupported ->
              forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"aeson-flowtyped: Unsupported type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
typeName

        SOP.Newtype String
moduleName String
typeName ConstructorInfo '[x]
constrInfo -> do
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (String -> Text
moduleComment String
moduleName forall a. a -> [a] -> [a]
:)
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (String -> Text
typeComment String
typeName forall a. a -> [a] -> [a]
:)
          case ConstructorInfo '[x]
constrInfo of

            (SOP.Constructor String
constrName :: SOP.ConstructorInfo '[x]) -> do
              forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (String -> Text
constrComment String
constrName forall a. a -> [a] -> [a]
:)
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy x))

            SOP.Record String
constrName ((SOP.FieldInfo String
_fname :: SOP.FieldInfo x) SOP.:* NP FieldInfo xs
SOP.Nil)
              -> do
                forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (String -> Text
constrComment String
constrName forall a. a -> [a] -> [a]
:)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy x))
      )
      forall s a. State s a -> s -> (a, s)
`runState` []

  constrsKind
    :: SOP.NP SOP.ConstructorInfo ty
    -> Int -- ^ total number of record or plain constructors
    -> Int -- ^ number of record constructors
    -> Int -- ^ number of plain constructors
    -> Bool -- ^ whether every constructor is nullary
    -> ConstructorsKind
  constrsKind :: forall (ty :: [[*]]).
NP ConstructorInfo ty
-> Int -> Int -> Int -> Bool -> ConstructorsKind
constrsKind NP ConstructorInfo ty
SOP.Nil !Int
total !Int
recs !Int
plains !Bool
allNullary
    | Int
recs forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
plains forall a. Eq a => a -> a -> Bool
== Int
0 = ConstructorsKind
SingleRecord
    | Int
plains forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
recs forall a. Eq a => a -> a -> Bool
== Int
0 = if Bool
allNullary
      then ConstructorsKind
SingleNullaryConstructor
      else ConstructorsKind
SingleConstructor
    | Int
recs forall a. Eq a => a -> a -> Bool
== Int
total Bool -> Bool -> Bool
&& Int
plains forall a. Eq a => a -> a -> Bool
== Int
0 = ConstructorsKind
SumRecords
    | Int
plains forall a. Eq a => a -> a -> Bool
== Int
total Bool -> Bool -> Bool
&& Int
recs forall a. Eq a => a -> a -> Bool
== Int
0 = if Bool
allNullary
      then ConstructorsKind
SumNullaryConstructors
      else ConstructorsKind
SumConstructors
    | Bool
otherwise = ConstructorsKind
Unsupported
  constrsKind (ConstructorInfo x
constr SOP.:* NP ConstructorInfo xs
rest) Int
total Int
recs Int
plains Bool
allNullary =
    case ConstructorInfo x
constr of
      (SOP.Constructor{} :: SOP.ConstructorInfo flds) -> forall (ty :: [[*]]).
NP ConstructorInfo ty
-> Int -> Int -> Int -> Bool -> ConstructorsKind
constrsKind
        NP ConstructorInfo xs
rest
        (Int
total forall a. Num a => a -> a -> a
+ Int
1)
        Int
recs
        (Int
plains forall a. Num a => a -> a -> a
+ Int
1)
        (Bool
allNullary Bool -> Bool -> Bool
&& forall {k} (xs :: [k]). SListI xs => Bool
isNullary @flds)

      (SOP.Record{} :: SOP.ConstructorInfo flds) -> forall (ty :: [[*]]).
NP ConstructorInfo ty
-> Int -> Int -> Int -> Bool -> ConstructorsKind
constrsKind
        NP ConstructorInfo xs
rest
        (Int
total forall a. Num a => a -> a -> a
+ Int
1)
        (Int
recs forall a. Num a => a -> a -> a
+ Int
1)
        Int
plains
        (Bool
allNullary Bool -> Bool -> Bool
&& forall {k} (xs :: [k]). SListI xs => Bool
isNullary @flds)

      ConstructorInfo x
_ -> ConstructorsKind
Unsupported

  sumEncode, singleEncode, sumNullaryEncode
    :: SOP.All2 FlowTyped ty => SOP.NP SOP.ConstructorInfo ty -> [FlowType]
  sumEncode :: forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
sumEncode NP ConstructorInfo ty
constrsNP = forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap
    (forall {k} (t :: k). Proxy t
Proxy :: Proxy (SOP.All FlowTyped))
    (\case
      (SOP.Constructor String
constrName :: SOP.ConstructorInfo xs) ->
        let
          value :: Fix FlowTypeF
value =
            let tuple :: Vector (Fix FlowTypeF)
tuple = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$! forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap
                  (forall {k} (t :: k). Proxy t
Proxy :: Proxy FlowTyped)
                  (\(Proxy a
Proxy :: SOP.Proxy x) -> [forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy x)])
                  (forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
SOP.hpure forall {k} (t :: k). Proxy t
Proxy :: SOP.NP Proxy xs)
            in  case forall a. Vector a -> Int
V.length Vector (Fix FlowTypeF)
tuple of
                  Int
1 -> forall a. Vector a -> a
V.head Vector (Fix FlowTypeF)
tuple
                  Int
_ -> Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple Vector (Fix FlowTypeF)
tuple

          hasContents :: Bool
hasContents = Any -> Bool
Monoid.getAny forall a b. (a -> b) -> a -> b
$! forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap
            (forall {k} (t :: k). Proxy t
Proxy :: Proxy SOP.Top)
            (\Proxy a
_ -> Bool -> Any
Monoid.Any Bool
True)
            (forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
SOP.hpure forall {k} (t :: k). Proxy t
Proxy :: SOP.NP Proxy xs)
        in
          case Options -> SumEncoding
sumEncoding Options
opts of
            TaggedObject (String -> Text
T.pack -> Text
tagFld) String
contentsFld
              | Bool
hasContents
              -> [ HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject
                     (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
                       [ (Text
tagFld, String -> Fix FlowTypeF
renderConstrTag String
constrName)
                       , (String -> Text
T.pack String
contentsFld, Fix FlowTypeF
value)
                       ]
                     )
                 ]
              | Bool
otherwise
              -> [ HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject
                     (forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
tagFld (String -> Fix FlowTypeF
renderConstrTag String
constrName))
                 ]
            SumEncoding
UntaggedValue -> [Fix FlowTypeF
value]
            SumEncoding
ObjectWithSingleField ->
              [ HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject
                  (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
                    [(String -> Text
T.pack (Options -> ShowS
constructorTagModifier Options
opts String
constrName), Fix FlowTypeF
value)]
                  )
              ]
            SumEncoding
TwoElemArray ->
              [Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple (forall a. Int -> [a] -> Vector a
V.fromListN Int
2 [String -> Fix FlowTypeF
renderConstrTag String
constrName, Fix FlowTypeF
value])]

      SOP.Record String
constrName NP FieldInfo a
flds ->
        let
          fldsList :: H.HashMap Text FlowType
          fldsList :: HashMap Text (Fix FlowTypeF)
fldsList =
            forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
              forall a b. (a -> b) -> a -> b
$! forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap
                   (forall {k} (t :: k). Proxy t
Proxy :: Proxy FlowTyped)
                   (\(SOP.FieldInfo String
fname :: SOP.FieldInfo x) ->
                     [ ( String -> Text
T.pack (Options -> ShowS
fieldLabelModifier Options
opts String
fname)
                       , forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy x)
                       )
                     ]
                   )
                   NP FieldInfo a
flds
        in
          case Options -> SumEncoding
sumEncoding Options
opts of
              -- The contents field is not used here but the tag one is
            TaggedObject (String -> Text
T.pack -> Text
tagFld) String
_contentsFld ->
              [ HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject
                  (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
tagFld (String -> Fix FlowTypeF
renderConstrTag String
constrName) HashMap Text (Fix FlowTypeF)
fldsList)
              ]
            SumEncoding
UntaggedValue -> [HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject HashMap Text (Fix FlowTypeF)
fldsList]
            SumEncoding
ObjectWithSingleField ->
              [ HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject
                  (forall k v. Hashable k => k -> v -> HashMap k v
H.singleton
                    (String -> Text
T.pack (Options -> ShowS
constructorTagModifier Options
opts String
constrName))
                    (HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject HashMap Text (Fix FlowTypeF)
fldsList)
                  )
              ]
            SumEncoding
TwoElemArray ->
              [ Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple
                  (forall a. Int -> [a] -> Vector a
V.fromListN
                    Int
2
                    [String -> Fix FlowTypeF
renderConstrTag String
constrName, HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject HashMap Text (Fix FlowTypeF)
fldsList]
                  )
              ]
      SOP.Infix{} ->
        forall a. HasCallStack => String -> a
error String
"aeson-flowtyped: Unsupported use of infix constructor"
    )
    NP ConstructorInfo ty
constrsNP

  singleEncode :: forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
singleEncode (ConstructorInfo x
constr SOP.:* NP ConstructorInfo xs
SOP.Nil) = case ConstructorInfo x
constr of
    (SOP.Constructor String
_constrName :: SOP.ConstructorInfo xs) ->
      [ Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$! forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap
          (forall {k} (t :: k). Proxy t
Proxy :: Proxy FlowTyped)
          (\(Proxy a
Proxy :: SOP.Proxy x) -> [forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy x)])
          (forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
SOP.hpure forall {k} (t :: k). Proxy t
Proxy :: SOP.NP Proxy xs)
      ]
    SOP.Record String
_constrName NP FieldInfo x
flds ->
      [ HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject
          forall a b. (a -> b) -> a -> b
$! forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
          forall a b. (a -> b) -> a -> b
$! forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap
               (forall {k} (t :: k). Proxy t
Proxy :: Proxy FlowTyped)
               (\(SOP.FieldInfo String
fname :: SOP.FieldInfo x) ->
                 [ ( String -> Text
T.pack (Options -> ShowS
fieldLabelModifier Options
opts String
fname)
                   , forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy x)
                   )
                 ]
               )
               NP FieldInfo x
flds
      ]
    SOP.Infix{} ->
      forall a. HasCallStack => String -> a
error String
"aeson-flowtyped: Unsupported use of infix constructor"
  singleEncode NP ConstructorInfo ty
_ =
    forall a. HasCallStack => String -> a
error String
"aeson-flowtyped: Errorneous detection of single constructor"

  sumNullaryEncode :: forall (ty :: [[*]]).
All2 FlowTyped ty =>
NP ConstructorInfo ty -> [Fix FlowTypeF]
sumNullaryEncode NP ConstructorInfo ty
constrsNP
    | Options -> Bool
allNullaryToStringTag Options
opts
    = [ Value -> Fix FlowTypeF
FLiteral (Text -> Value
A.String (String -> Text
T.pack (Options -> ShowS
constructorTagModifier Options
opts String
tag)))
      | String
tag <- forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap (forall {k} (t :: k). Proxy t
Proxy :: Proxy SOP.Top)
                             (\(SOP.Constructor String
constrName) -> [String
constrName])
                             NP ConstructorInfo ty
constrsNP
      ]
    | Bool
otherwise
    = [ Text -> Fix FlowTypeF
nullarySumObject (String -> Text
T.pack (Options -> ShowS
constructorTagModifier Options
opts String
tag))
      | String
tag <- forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
SOP.hcfoldMap (forall {k} (t :: k). Proxy t
Proxy :: Proxy SOP.Top)
                             (\(SOP.Constructor String
constrName) -> [String
constrName])
                             NP ConstructorInfo ty
constrsNP
      ]

  nullarySumObject :: Text -> Fix FlowTypeF
nullarySumObject Text
tagValue = case Options -> SumEncoding
sumEncoding Options
opts of
    TaggedObject (String -> Text
T.pack -> Text
tagFld) String
_contentsFld ->
      HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject (forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
tagFld (Value -> Fix FlowTypeF
FLiteral (Text -> Value
A.String Text
tagValue)))
    SumEncoding
UntaggedValue -> Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple forall a. Vector a
V.empty
    SumEncoding
ObjectWithSingleField ->
      HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject (forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Text
tagValue (Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple forall a. Vector a
V.empty))
    SumEncoding
TwoElemArray ->
      Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple (forall a. Int -> [a] -> Vector a
V.fromListN Int
2 [Value -> Fix FlowTypeF
FLiteral (Text -> Value
A.String Text
tagValue), Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple forall a. Vector a
V.empty])

  renderConstrTag :: String -> Fix FlowTypeF
renderConstrTag = Value -> Fix FlowTypeF
FLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ShowS
constructorTagModifier Options
opts

  moduleComment :: String -> Text
moduleComment String
s = [Text] -> Text
T.concat [Text
"Origin module: `", String -> Text
T.pack String
s, Text
"`"]
  typeComment :: String -> Text
typeComment String
s = [Text] -> Text
T.concat [Text
"Origin type: ", String -> Text
T.pack String
s]
  constrComment :: String -> Text
constrComment String
s = [Text] -> Text
T.concat [Text
"Origin constructor: ", String -> Text
T.pack String
s]

  isNullary :: forall xs . SOP.SListI xs => Bool
  isNullary :: forall {k} (xs :: [k]). SListI xs => Bool
isNullary = forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
SOP.lengthSList (forall {k} (t :: k). Proxy t
Proxy :: Proxy xs) forall a. Eq a => a -> a -> Bool
== Int
0


data ConstructorsKind
  = SumRecords
  | SumConstructors
  | SumNullaryConstructors
  | SingleRecord
  | SingleConstructor
  | SingleNullaryConstructor
  | Unsupported

-- | 'flowTypeName' using 'Generic'
defaultFlowTypeName
  :: (Generic a, Rep a ~ D1 ('MetaData name mod pkg t) c, KnownSymbol name)
  => Proxy a
  -> Maybe Text
defaultFlowTypeName :: forall a (name :: Symbol) (mod :: Symbol) (pkg :: Symbol)
       (t :: Bool) (c :: * -> *).
(Generic a, Rep a ~ D1 ('MetaData name mod pkg t) c,
 KnownSymbol name) =>
Proxy a -> Maybe Text
defaultFlowTypeName Proxy a
p =
  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
cleanup forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (name :: Symbol) (mod :: Symbol) (pkg :: Symbol)
       (t :: Bool) (c :: k -> *) (x :: k).
Proxy (D1 ('MetaData name mod pkg t) c x) -> Proxy name
pGetName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a x. Generic a => a -> Rep a x
from forall a b. (a -> b) -> a -> b
$ Proxy a
p
 where
  pGetName :: Proxy (D1 ( 'MetaData name mod pkg t) c x) -> Proxy name
  pGetName :: forall {k} (name :: Symbol) (mod :: Symbol) (pkg :: Symbol)
       (t :: Bool) (c :: k -> *) (x :: k).
Proxy (D1 ('MetaData name mod pkg t) c x) -> Proxy name
pGetName Proxy (D1 ('MetaData name mod pkg t) c x)
_ = forall {k} (t :: k). Proxy t
Proxy
  cleanup :: Text -> Text
cleanup = Text -> Text -> Text -> Text
T.replace Text
"'" Text
"_" -- I think this is the only illegal token in JS
                                -- that's allowed in Haskell, other than type
                                -- operators... TODO, rename type operators

--------------------------------------------------------------------------------
-- Instances

instance (FlowTyped a) => FlowTyped [a] where
  flowType :: Proxy [a] -> Fix FlowTypeF
flowType Proxy [a]
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  isPrim :: Proxy [a] -> Bool
isPrim Proxy [a]
_ = Bool
True
  flowTypeName :: Proxy [a] -> Maybe Text
flowTypeName Proxy [a]
_ = forall a. Maybe a
Nothing

instance (FlowTyped a) => FlowTyped (Vector a) where
  flowType :: Proxy (Vector a) -> Fix FlowTypeF
flowType Proxy (Vector a)
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  isPrim :: Proxy (Vector a) -> Bool
isPrim Proxy (Vector a)
_ = Bool
True
  flowTypeName :: Proxy (Vector a) -> Maybe Text
flowTypeName Proxy (Vector a)
_ = forall a. Maybe a
Nothing

instance (FlowTyped a) => FlowTyped (VU.Vector a) where
  flowType :: Proxy (Vector a) -> Fix FlowTypeF
flowType Proxy (Vector a)
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  isPrim :: Proxy (Vector a) -> Bool
isPrim Proxy (Vector a)
_ = Bool
True
  flowTypeName :: Proxy (Vector a) -> Maybe Text
flowTypeName Proxy (Vector a)
_ = forall a. Maybe a
Nothing

instance (FlowTyped a) => FlowTyped (VS.Vector a) where
  flowType :: Proxy (Vector a) -> Fix FlowTypeF
flowType Proxy (Vector a)
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  isPrim :: Proxy (Vector a) -> Bool
isPrim Proxy (Vector a)
_ = Bool
True
  flowTypeName :: Proxy (Vector a) -> Maybe Text
flowTypeName Proxy (Vector a)
_ = forall a. Maybe a
Nothing

instance ( FlowTyped a
         , FlowTyped b
         ) => FlowTyped (a, b) where
  flowTypeName :: Proxy (a, b) -> Maybe Text
flowTypeName Proxy (a, b)
_ = forall a. Maybe a
Nothing
  flowType :: Proxy (a, b) -> Fix FlowTypeF
flowType Proxy (a, b)
_ = Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple (forall a. [a] -> Vector a
V.fromList [Fix FlowTypeF
aFt, Fix FlowTypeF
bFt])
   where
    aFt :: Fix FlowTypeF
aFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    bFt :: Fix FlowTypeF
bFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

instance (FlowTyped a) => FlowTyped (Maybe a) where
  flowType :: Proxy (Maybe a) -> Fix FlowTypeF
flowType Proxy (Maybe a)
_ = Fix FlowTypeF -> Fix FlowTypeF
FNullable (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  isPrim :: Proxy (Maybe a) -> Bool
isPrim Proxy (Maybe a)
_ = Bool
True
  flowTypeName :: Proxy (Maybe a) -> Maybe Text
flowTypeName Proxy (Maybe a)
_ = forall a. Maybe a
Nothing

instance ( FlowTyped a
         , FlowTyped b) =>
         FlowTyped (Either a b) where
  flowTypeName :: Proxy (Either a b) -> Maybe Text
flowTypeName Proxy (Either a b)
_ = forall a. Maybe a
Nothing
  flowType :: Proxy (Either a b) -> Fix FlowTypeF
flowType Proxy (Either a b)
_ = Fix FlowTypeF -> Fix FlowTypeF -> Fix FlowTypeF
FAlt (HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text
"Left", Fix FlowTypeF
aFt)]))
                    (HashMap Text (Fix FlowTypeF) -> Fix FlowTypeF
FExactObject (forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text
"Right", Fix FlowTypeF
bFt)]))
   where
    aFt :: Fix FlowTypeF
aFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    bFt :: Fix FlowTypeF
bFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

instance ( FlowTyped a
         , FlowTyped b
         , FlowTyped c) =>
         FlowTyped (a, b, c) where
  flowTypeName :: Proxy (a, b, c) -> Maybe Text
flowTypeName Proxy (a, b, c)
_ = forall a. Maybe a
Nothing
  flowType :: Proxy (a, b, c) -> Fix FlowTypeF
flowType Proxy (a, b, c)
_ = Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple (forall a. [a] -> Vector a
V.fromList [Fix FlowTypeF
aFt, Fix FlowTypeF
bFt, Fix FlowTypeF
cFt])
   where
    aFt :: Fix FlowTypeF
aFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    bFt :: Fix FlowTypeF
bFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
    cFt :: Fix FlowTypeF
cFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)

instance ( FlowTyped a
         , FlowTyped b
         , FlowTyped c
         , FlowTyped d
         ) =>
         FlowTyped (a, b, c, d) where
  flowTypeName :: Proxy (a, b, c, d) -> Maybe Text
flowTypeName Proxy (a, b, c, d)
_ = forall a. Maybe a
Nothing
  flowType :: Proxy (a, b, c, d) -> Fix FlowTypeF
flowType Proxy (a, b, c, d)
_ = Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple (forall a. [a] -> Vector a
V.fromList [Fix FlowTypeF
aFt, Fix FlowTypeF
bFt, Fix FlowTypeF
cFt, Fix FlowTypeF
dFt])
   where
    aFt :: Fix FlowTypeF
aFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    bFt :: Fix FlowTypeF
bFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
    cFt :: Fix FlowTypeF
cFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
    dFt :: Fix FlowTypeF
dFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)

instance ( FlowTyped a
         , FlowTyped b
         , FlowTyped c
         , FlowTyped d
         , FlowTyped e
         ) =>
         FlowTyped (a, b, c, d, e) where
  flowTypeName :: Proxy (a, b, c, d, e) -> Maybe Text
flowTypeName Proxy (a, b, c, d, e)
_ = forall a. Maybe a
Nothing
  flowType :: Proxy (a, b, c, d, e) -> Fix FlowTypeF
flowType Proxy (a, b, c, d, e)
_ = Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple (forall a. [a] -> Vector a
V.fromList [Fix FlowTypeF
aFt, Fix FlowTypeF
bFt, Fix FlowTypeF
cFt, Fix FlowTypeF
dFt, Fix FlowTypeF
eFt])
   where
    aFt :: Fix FlowTypeF
aFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    bFt :: Fix FlowTypeF
bFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
    cFt :: Fix FlowTypeF
cFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)
    dFt :: Fix FlowTypeF
dFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy d)
    eFt :: Fix FlowTypeF
eFt = forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy e)

instance FlowTyped Text where
  isPrim :: Proxy Text -> Bool
isPrim Proxy Text
_ = Bool
True
  flowType :: Proxy Text -> Fix FlowTypeF
flowType Proxy Text
_ = Fix FlowTypeF
FPrimString
  flowTypeName :: Proxy Text -> Maybe Text
flowTypeName Proxy Text
_ = forall a. Maybe a
Nothing

instance FlowTyped TL.Text where
  isPrim :: Proxy Text -> Bool
isPrim Proxy Text
_ = Bool
True
  flowType :: Proxy Text -> Fix FlowTypeF
flowType Proxy Text
_ = Fix FlowTypeF
FPrimString
  flowTypeName :: Proxy Text -> Maybe Text
flowTypeName Proxy Text
_ = forall a. Maybe a
Nothing

instance {-# OVERLAPS #-} FlowTyped String where
  isPrim :: Proxy String -> Bool
isPrim Proxy String
_ = Bool
True
  flowType :: Proxy String -> Fix FlowTypeF
flowType Proxy String
_ = Fix FlowTypeF
FPrimString
  flowTypeName :: Proxy String -> Maybe Text
flowTypeName Proxy String
_ = forall a. Maybe a
Nothing

instance FlowTyped Void.Void where
  isPrim :: Proxy Void -> Bool
isPrim Proxy Void
_ = Bool
True
  flowType :: Proxy Void -> Fix FlowTypeF
flowType Proxy Void
_ = Fix FlowTypeF
FPrimBottom
  flowTypeName :: Proxy Void -> Maybe Text
flowTypeName Proxy Void
_ = forall a. Maybe a
Nothing

instance FlowTyped Char where
  isPrim :: Proxy Char -> Bool
isPrim Proxy Char
_ = Bool
True
  flowType :: Proxy Char -> Fix FlowTypeF
flowType Proxy Char
_ = Fix FlowTypeF
FPrimString
  flowTypeName :: Proxy Char -> Maybe Text
flowTypeName Proxy Char
_ = forall a. Maybe a
Nothing

instance FlowTyped Bool where
  isPrim :: Proxy Bool -> Bool
isPrim Proxy Bool
_ = Bool
True
  flowType :: Proxy Bool -> Fix FlowTypeF
flowType Proxy Bool
_ = Fix FlowTypeF
FPrimBoolean
  flowTypeName :: Proxy Bool -> Maybe Text
flowTypeName Proxy Bool
_ = forall a. Maybe a
Nothing

instance FlowTyped A.Value where
  isPrim :: Proxy Value -> Bool
isPrim Proxy Value
_ = Bool
True
  flowType :: Proxy Value -> Fix FlowTypeF
flowType Proxy Value
_ = Fix FlowTypeF
FPrimMixed
  flowTypeName :: Proxy Value -> Maybe Text
flowTypeName Proxy Value
_ = forall a. Maybe a
Nothing

instance FlowTyped UTCTime where
  isPrim :: Proxy UTCTime -> Bool
isPrim Proxy UTCTime
_ = Bool
False
  flowType :: Proxy UTCTime -> Fix FlowTypeF
flowType Proxy UTCTime
_ = Fix FlowTypeF
FPrimString
  flowTypeName :: Proxy UTCTime -> Maybe Text
flowTypeName Proxy UTCTime
_ = forall a. Maybe a
Nothing

instance (Typeable (a :: k), Typeable k) => FlowTyped (Fixed a) where
  isPrim :: Proxy (Fixed a) -> Bool
isPrim Proxy (Fixed a)
_ = Bool
False
  flowType :: Proxy (Fixed a) -> Fix FlowTypeF
flowType Proxy (Fixed a)
_ = Fix FlowTypeF
FPrimNumber
  flowTypeName :: Proxy (Fixed a) -> Maybe Text
flowTypeName Proxy (Fixed a)
_ = forall a. Maybe a
Nothing

instance ( FlowTyped k
         , FlowTyped a
         , A.ToJSONKey k
         ) => FlowTyped (HashMap k a) where
  -- XXX this is getting quite incoherent, what makes something "Prim" or not...
  isPrim :: Proxy (HashMap k a) -> Bool
isPrim Proxy (HashMap k a)
_ = Bool
True

  flowType :: Proxy (HashMap k a) -> Fix FlowTypeF
flowType Proxy (HashMap k a)
_ = case forall a. ToJSONKey a => ToJSONKeyFunction a
A.toJSONKey :: A.ToJSONKeyFunction k of
    A.ToJSONKeyText{} ->
      Text -> Fix FlowTypeF -> Fix FlowTypeF -> Fix FlowTypeF
FObjectMap Text
"key" Fix FlowTypeF
FPrimString (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

    A.ToJSONKeyValue{} -> Fix FlowTypeF -> Fix FlowTypeF
FArray
      (Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple
        (forall a. Int -> [a] -> Vector a
V.fromListN
          Int
2
          [forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy k), forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)]
        )
      )

  flowTypeName :: Proxy (HashMap k a) -> Maybe Text
flowTypeName Proxy (HashMap k a)
_ = forall a. Maybe a
Nothing

instance (FlowTyped a) => FlowTyped (Set.Set a) where
  isPrim :: Proxy (Set a) -> Bool
isPrim Proxy (Set a)
_ = Bool
False
  flowType :: Proxy (Set a) -> Fix FlowTypeF
flowType Proxy (Set a)
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  flowTypeName :: Proxy (Set a) -> Maybe Text
flowTypeName Proxy (Set a)
_ = forall a. Maybe a
Nothing

instance FlowTyped IntSet.IntSet where
  isPrim :: Proxy IntSet -> Bool
isPrim Proxy IntSet
_ = Bool
False
  flowType :: Proxy IntSet -> Fix FlowTypeF
flowType Proxy IntSet
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray Fix FlowTypeF
FPrimNumber -- (Fix (Prim Number))
  flowTypeName :: Proxy IntSet -> Maybe Text
flowTypeName Proxy IntSet
_ = forall a. Maybe a
Nothing

instance (FlowTyped a) => FlowTyped (I.IntMap a) where
  isPrim :: Proxy (IntMap a) -> Bool
isPrim Proxy (IntMap a)
_ = Bool
False
  flowType :: Proxy (IntMap a) -> Fix FlowTypeF
flowType Proxy (IntMap a)
_ =
    forall (f :: * -> *). f (Fix f) -> Fix f
Fix
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FlowTypeF a
Array
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). f (Fix f) -> Fix f
Fix
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> FlowTypeF a
Tuple
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> Vector a
V.fromListN Int
2
      forall a b. (a -> b) -> a -> b
$ [Fix FlowTypeF
FPrimNumber, forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)]
  flowTypeName :: Proxy (IntMap a) -> Maybe Text
flowTypeName Proxy (IntMap a)
_ = forall a. Maybe a
Nothing

instance (FlowTyped a) => FlowTyped (HashSet.HashSet a) where
  isPrim :: Proxy (HashSet a) -> Bool
isPrim Proxy (HashSet a)
_ = Bool
False
  flowType :: Proxy (HashSet a) -> Fix FlowTypeF
flowType Proxy (HashSet a)
_ = Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a. FlowTyped a => Proxy a -> Fix FlowTypeF
callType (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
  flowTypeName :: Proxy (HashSet a) -> Maybe Text
flowTypeName Proxy (HashSet a)
_ = forall a. Maybe a
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
  isPrim :: Proxy (Tree a) -> Bool
isPrim Proxy (Tree a)
_ = Bool
False
  flowType :: Proxy (Tree a) -> Fix FlowTypeF
flowType Proxy (Tree a)
_ = Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple
    (forall a. [a] -> Vector a
V.fromList
      [ Int -> Fix FlowTypeF
FGenericParam Int
0
      , Fix FlowTypeF -> Fix FlowTypeF
FArray (forall a.
FlowTyped a =>
Proxy a -> [Fix FlowTypeF] -> Fix FlowTypeF
callType' (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Tree.Tree a)) [Int -> Fix FlowTypeF
FGenericParam Int
0])
      ]
    )
  flowTypeName :: Proxy (Tree a) -> Maybe Text
flowTypeName Proxy (Tree a)
_ = forall a. a -> Maybe a
Just Text
"Tree"
  flowTypeVars :: Proxy (Tree a) -> [Flowable]
flowTypeVars Proxy (Tree a)
_ = [forall a. FlowTyped a => Proxy a -> Flowable
Flowable (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)]

instance FlowTyped () where
  isPrim :: Proxy () -> Bool
isPrim Proxy ()
_ = Bool
False
  flowType :: Proxy () -> Fix FlowTypeF
flowType Proxy ()
_ = Vector (Fix FlowTypeF) -> Fix FlowTypeF
FTuple forall a. Vector a
V.empty
  flowTypeName :: Proxy () -> Maybe Text
flowTypeName Proxy ()
_ = forall a. Maybe a
Nothing

-- monomorphic numeric instances
$(concat <$> mapM
  (\ty ->
     [d|
      instance FlowTyped $ty where
        isPrim  _ = False
        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