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]