module SyntaxTrees.Purescript.ClassDef where import Data.List (intercalate) import Data.Monoid.HT (when) import SyntaxTrees.Purescript.Common (Class, Var) import SyntaxTrees.Purescript.FnDef (FnDefOrSig) import SyntaxTrees.Purescript.Type (AnyKindedType, ClassConstraint, TypeParam, showAnyKindedTypeNested) import Utils.Foldable (wrapMaybe) import Utils.String (Wrapper (Wrapper), joinMaybePost, joinWords, str, wrapBlock, wrapParensCsv) data ClassDef = ClassDef { ClassDef -> [ClassConstraint] constraints :: [ClassConstraint] , ClassDef -> Class name :: Class , ClassDef -> [TypeParam] typeParams :: [TypeParam] , ClassDef -> [FnDefOrSig] defs :: [FnDefOrSig] } data InstanceDef = InstanceDef { InstanceDef -> [ClassConstraint] constraints :: [ClassConstraint] , InstanceDef -> Maybe Var name :: Maybe Var , InstanceDef -> Class class' :: Class , InstanceDef -> [AnyKindedType] types :: [AnyKindedType] , InstanceDef -> [FnDefOrSig] defs :: [FnDefOrSig] } data DerivingDef = DerivingDef { DerivingDef -> DerivingStrategy strategy :: DerivingStrategy , DerivingDef -> [ClassConstraint] constraints :: [ClassConstraint] , DerivingDef -> Maybe Var name :: Maybe Var , DerivingDef -> Class class' :: Class , DerivingDef -> [AnyKindedType] types :: [AnyKindedType] } data DerivingStrategy = StandardDeriving | NewTypeDeriving deriving (DerivingStrategy -> DerivingStrategy -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: DerivingStrategy -> DerivingStrategy -> Bool $c/= :: DerivingStrategy -> DerivingStrategy -> Bool == :: DerivingStrategy -> DerivingStrategy -> Bool $c== :: DerivingStrategy -> DerivingStrategy -> Bool Eq) instance Show ClassDef where show :: ClassDef -> String show (ClassDef [ClassConstraint] x Class y [TypeParam] z [FnDefOrSig] t) = [String] -> String joinWords [String "class", (String -> Wrapper Wrapper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a) wrapMaybe (forall a. Show a => [a] -> String wrapParensCsv [ClassConstraint] x)) forall a. Show a => Maybe a -> ShowS `joinMaybePost` String "<=", forall a. Show a => a -> String show Class y, forall a. Show a => String -> [a] -> String str String " " [TypeParam] z, forall a. Show a => [a] -> String wrapBlock [FnDefOrSig] t] instance Show InstanceDef where show :: InstanceDef -> String show (InstanceDef [ClassConstraint] x Maybe Var y Class z [AnyKindedType] t [FnDefOrSig] u) = [String] -> String joinWords [String "instance", (String -> Wrapper Wrapper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a) wrapMaybe (forall a. Show a => [a] -> String wrapParensCsv [ClassConstraint] x)) forall a. Show a => Maybe a -> ShowS `joinMaybePost` String "<=", Maybe Var y forall a. Show a => Maybe a -> ShowS `joinMaybePost` String "::", forall a. Show a => a -> String show Class z, forall a. [a] -> [[a]] -> [a] intercalate String " " forall a b. (a -> b) -> a -> b $ AnyKindedType -> String showAnyKindedTypeNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [AnyKindedType] t, forall a. Show a => [a] -> String wrapBlock [FnDefOrSig] u] instance Show DerivingDef where show :: DerivingDef -> String show (DerivingDef DerivingStrategy x [ClassConstraint] y Maybe Var z Class t [AnyKindedType] u) = [String] -> String joinWords [String "derive", forall m. Monoid m => Bool -> m -> m when (DerivingStrategy x forall a. Eq a => a -> a -> Bool == DerivingStrategy NewTypeDeriving) String "newtype", String "instance", (String -> Wrapper Wrapper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a) wrapMaybe (forall a. Show a => [a] -> String wrapParensCsv [ClassConstraint] y)) forall a. Show a => Maybe a -> ShowS `joinMaybePost` String "<=", Maybe Var z forall a. Show a => Maybe a -> ShowS `joinMaybePost` String "::", forall a. Show a => a -> String show Class t, forall a. [a] -> [[a]] -> [a] intercalate String " " forall a b. (a -> b) -> a -> b $ AnyKindedType -> String showAnyKindedTypeNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [AnyKindedType] u]