module SyntaxTrees.Purescript.ModuleDef where

import Data.Monoid.HT                  (when)
import SyntaxTrees.Purescript.ClassDef (ClassDef, DerivingDef, InstanceDef)
import SyntaxTrees.Purescript.Common   (Class, Module, Var, VarOp)
import SyntaxTrees.Purescript.DataDef  (DataDef, NewTypeDef, TypeDef)
import SyntaxTrees.Purescript.FnDef    (FnDefOrSig (Sig), InfixFnDef)
import SyntaxTrees.Purescript.Type     (TypeVar)
import Utils.String                    (joinMaybe, joinWords, wrapParens,
                                        wrapParensCsv, (+++))


data ModuleDef
  = ModuleDef
      { ModuleDef -> Module
name    :: Module
      , ModuleDef -> Maybe ModuleExport
export  :: Maybe ModuleExport
      , ModuleDef -> [ModuleImport]
imports :: [ModuleImport]
      , ModuleDef -> [InternalDef]
defs    :: [InternalDef]
      }

newtype ModuleExport
  = ModuleExport [ModuleExportDef]

data ModuleExportDef
  = ModuleExportDef ImportExportDef
  | FullModuleExport Module

data ModuleImport
  = ModuleImport
      { ModuleImport -> Module
module'   :: Module
      , ModuleImport -> Bool
hiding    :: Bool
      , ModuleImport -> [ModuleImportDef]
imporDefs :: [ModuleImportDef]
      , ModuleImport -> Maybe Module
alias     :: Maybe Module
      }

data ModuleImportDef
  = ModuleImportDef ImportExportDef

data ImportExportDef
  = Member ModuleMember
  | FullData TypeVar
  | FilteredData TypeVar [ModuleMember]
  | FullClass Class

data ModuleMember
  = VarMember Var
  | VarOpMember VarOp
  | DataMember TypeVar

data InternalDef
  = TypeDef' TypeDef
  | NewTypeDef' NewTypeDef
  | DataDef' DataDef
  | FnDefOrSig' FnDefOrSig
  | ClassDef' ClassDef
  | InstanceDef' InstanceDef
  | DerivingDef' DerivingDef
  | InfixFnDef' InfixFnDef




instance Show ModuleDef where
  show :: ModuleDef -> String
show (ModuleDef Module
x Maybe ModuleExport
y [ModuleImport]
z [InternalDef]
t) =
    [String] -> String
joinWords [String
"module",
               forall a. Show a => a -> String
show Module
x,
               forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Show a => a -> String
show Maybe ModuleExport
y,
               String
"where",
               String
"\n\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ModuleImport]
z),
               String
"\n\n" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\InternalDef
def ->
                  InternalDef -> String
internalDefPrefixSeparator InternalDef
def forall a. [a] -> [a] -> [a]
++
                  forall a. Show a => a -> String
show InternalDef
def forall a. [a] -> [a] -> [a]
++
                  InternalDef -> String
internalDefPostfixSeparator InternalDef
def) [InternalDef]
t]

instance Show ModuleExport where
  show :: ModuleExport -> String
show (ModuleExport [ModuleExportDef]
x) = forall a. Show a => [a] -> String
wrapParensCsv [ModuleExportDef]
x

instance Show ModuleExportDef where
  show :: ModuleExportDef -> String
show (ModuleExportDef ImportExportDef
x)  = forall a. Show a => a -> String
show ImportExportDef
x
  show (FullModuleExport Module
x) = String
"module" String -> ShowS
+++ forall a. Show a => a -> String
show Module
x

instance Show ModuleImport where
  show :: ModuleImport -> String
show (ModuleImport Module
x Bool
y [ModuleImportDef]
z Maybe Module
t) =
    [String] -> String
joinWords [String
"import",
               forall a. Show a => a -> String
show Module
x,
               forall m. Monoid m => Bool -> m -> m
when Bool
y String
"hiding",
               forall a. Show a => [a] -> String
wrapParensCsv [ModuleImportDef]
z,
               String
"as" forall a. Show a => String -> Maybe a -> String
`joinMaybe` Maybe Module
t]

instance Show ModuleImportDef where
  show :: ModuleImportDef -> String
show (ModuleImportDef ImportExportDef
x) = forall a. Show a => a -> String
show ImportExportDef
x

instance Show ImportExportDef where
  show :: ImportExportDef -> String
show (Member ModuleMember
x)         = forall a. Show a => a -> String
show ModuleMember
x
  show (FullData TypeVar
x)       = forall a. Show a => a -> String
show TypeVar
x forall a. [a] -> [a] -> [a]
++ ShowS
wrapParens String
".."
  show (FilteredData TypeVar
x [ModuleMember]
y) = forall a. Show a => a -> String
show TypeVar
x forall a. [a] -> [a] -> [a]
++ forall a. Show a => [a] -> String
wrapParensCsv [ModuleMember]
y
  show (FullClass Class
x)      = String
"class" String -> ShowS
+++ forall a. Show a => a -> String
show Class
x

instance Show ModuleMember where
  show :: ModuleMember -> String
show (VarMember Var
x)   = forall a. Show a => a -> String
show Var
x
  show (VarOpMember VarOp
x) = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show VarOp
x
  show (DataMember TypeVar
x)  = forall a. Show a => a -> String
show TypeVar
x

instance Show InternalDef where
  show :: InternalDef -> String
show (TypeDef' TypeDef
x)     = forall a. Show a => a -> String
show TypeDef
x
  show (NewTypeDef' NewTypeDef
x)  = forall a. Show a => a -> String
show NewTypeDef
x
  show (DataDef' DataDef
x)     = forall a. Show a => a -> String
show DataDef
x
  show (FnDefOrSig' FnDefOrSig
x)  = forall a. Show a => a -> String
show FnDefOrSig
x
  show (ClassDef' ClassDef
x)    = forall a. Show a => a -> String
show ClassDef
x
  show (InstanceDef' InstanceDef
x) = forall a. Show a => a -> String
show InstanceDef
x
  show (DerivingDef' DerivingDef
x) = forall a. Show a => a -> String
show DerivingDef
x
  show (InfixFnDef' InfixFnDef
x)  = forall a. Show a => a -> String
show InfixFnDef
x


internalDefPrefixSeparator :: InternalDef -> String
internalDefPrefixSeparator :: InternalDef -> String
internalDefPrefixSeparator (DerivingDef' DerivingDef
_) = forall a. Monoid a => a
mempty
internalDefPrefixSeparator InternalDef
_                = String
"\n"

internalDefPostfixSeparator :: InternalDef -> String
internalDefPostfixSeparator :: InternalDef -> String
internalDefPostfixSeparator (FnDefOrSig' (Sig FnSig
_)) = forall a. Monoid a => a
mempty
internalDefPostfixSeparator InternalDef
_                     =  String
"\n"