module SyntaxTrees.Scala.FnDef where

import Data.Foldable             (Foldable (fold))
import Data.Monoid.HT            (when)
import SyntaxTrees.Scala.Common  (Literal, Modifier, QCtor, QCtorOp, QVar,
                                  QVarOp, Var)
import SyntaxTrees.Scala.Pattern (Pattern)
import SyntaxTrees.Scala.Type    (ArgList, Type, TypeParam,
                                  UsingArgList (UsingArgList))

import Data.List (intercalate)

import Conversions.ToScala.Pattern (allVars')
import Utils.Foldable              (hasSome, wrapMaybe)
import Utils.String


data FnSig
  = FnSig
      { FnSig -> [TypeParam]
typeParams :: [TypeParam]
      , FnSig -> [ArgList]
argLists   :: [ArgList]
      , FnSig -> [UsingArgList]
usingArgs  :: [UsingArgList]
      , FnSig -> Maybe Type
returnType :: Maybe Type
      }

data ValDef
  = ValDef
      { ValDef -> [Modifier]
qualifiers :: [Modifier]
      , ValDef -> [Var]
names      :: [Var]
      , ValDef -> Maybe Type
returnType :: Maybe Type
      , ValDef -> Maybe FnBody
body       :: Maybe FnBody
      }

data MethodDef
  = MethodDef
      { MethodDef -> [Modifier]
qualifiers :: [Modifier]
      , MethodDef -> Var
name       :: Var
      , MethodDef -> Maybe FnSig
sig        :: Maybe FnSig
      , MethodDef -> Maybe FnBody
body       :: Maybe FnBody
      }

data GivenDef
  = GivenDef
      { GivenDef -> [Modifier]
qualifiers :: [Modifier]
      , GivenDef -> Maybe Var
name       :: Maybe Var
      , GivenDef -> [TypeParam]
typeParams :: [TypeParam]
      , GivenDef -> [UsingArgList]
usingArgs  :: [UsingArgList]
      , GivenDef -> Type
returnType :: Type
      , GivenDef -> Either FnBody [InternalFnDef]
bodyOrDefs :: Either FnBody [InternalFnDef]
      }


data FnBody
  = FnApply
      { FnBody -> FnBody
fn   :: FnBody
      , FnBody -> [FnBody]
args :: [FnBody]
      }
  | NamedFnApply
      { fn        :: FnBody
      , FnBody -> [(Var, FnBody)]
namedArgs :: [(Var, FnBody)]
      }
  | InfixFnApply
      { FnBody -> [FnOp]
fnOps :: [FnOp]
      , args  :: [FnBody]
      }
  | LambdaExpr
      { FnBody -> [Pattern]
patterns :: [Pattern]
      , FnBody -> FnBody
body     :: FnBody
      }
  | LetExpr
      { FnBody -> [InternalFnDef]
fnBindings :: [InternalFnDef]
      , body       :: FnBody
      }
  | IfExpr
      { FnBody -> FnBody
cond       :: FnBody
      , FnBody -> FnBody
ifBranch   :: FnBody
      , FnBody -> FnBody
elseBranch :: FnBody
      }
  | CondExpr
      { FnBody -> [WhenExpr]
whenBranches :: [WhenExpr]
      , elseBranch   :: FnBody
      }
  | ForExpr
      { FnBody -> [ForStep]
steps :: [ForStep]
      , FnBody -> FnBody
yield :: FnBody
      }
  | MatchExpr
      { FnBody -> FnBody
matchee :: FnBody
      , FnBody -> [CaseBinding]
cases   :: [CaseBinding]
      }
  | TopLevelMatchExpr
      { cases :: [CaseBinding]
      }
  | BodySelection FnBody [Var]
  | Tuple [FnBody]
  | FnOp' FnOp
  | FnVar' FnVar
  | Literal' Literal

data FnVar
  = Selection QVar [Var]
  | Var' QVar
  | Ctor' QCtor

data FnOp
  = VarOp' QVarOp
  | CtorOp' QCtorOp

data ForStep
  = ForBinding [Var] FnBody
  | LetBinding [InternalFnDef]
  | Condition FnBody

data CaseBinding
  = CaseBinding
      { CaseBinding -> Pattern
pattern' :: Pattern
      , CaseBinding -> Maybe FnBody
guard    :: Maybe FnBody
      , CaseBinding -> FnBody
body     :: FnBody
      }

data InternalFnDef
  = FnVal ValDef
  | FnMethod MethodDef
  | FnGiven GivenDef

data WhenExpr
  = WhenExpr
      { WhenExpr -> FnBody
cond :: FnBody
      , WhenExpr -> FnBody
body :: FnBody
      }



instance Show FnSig where
  show :: FnSig -> String
show (FnSig [TypeParam]
x [ArgList]
y [UsingArgList]
z Maybe Type
t) =
    (String
"" forall a. Show a => String -> Maybe a -> String
`joinMaybe`
     (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 ([String] -> String
joinWords [forall a. Show a => [a] -> String
wrapSquareCsv [TypeParam]
x,
                                        forall a. Show a => String -> [a] -> String
str String
" " [ArgList]
y,
                                        forall a. Show a => String -> [a] -> String
str String
" " [UsingArgList]
z])))
    forall a. [a] -> [a] -> [a]
++ String
":" forall a. Show a => String -> Maybe a -> String
`joinMaybe` Maybe Type
t

instance Show ValDef where
  show :: ValDef -> String
show (ValDef [Modifier]
x [Var]
y Maybe Type
z Maybe FnBody
t) =
    [String] -> String
joinWords [forall a. Show a => String -> [a] -> String
str String
" " [Modifier]
x,
               String
"val",
               [Var] -> Maybe Type -> Maybe FnBody -> String
showVal [Var]
y Maybe Type
z Maybe FnBody
t]

instance Show MethodDef where
  show :: MethodDef -> String
show (MethodDef [Modifier]
x Var
y Maybe FnSig
z Maybe FnBody
t) =
    [String] -> String
joinWords [forall a. Show a => String -> [a] -> String
str String
" " [Modifier]
x,
               String
"def",
               Var -> Maybe FnSig -> Maybe FnBody -> String
showDef Var
y Maybe FnSig
z Maybe FnBody
t]

instance Show GivenDef where
  show :: GivenDef -> String
show (GivenDef [Modifier]
x Maybe Var
y [TypeParam]
z [UsingArgList]
t Type
u Either FnBody [InternalFnDef]
v) =
    [String] -> String
joinWords [forall a. Show a => String -> [a] -> String
str String
" " [Modifier]
x,
               String
"given",
               Maybe Var
-> [TypeParam]
-> [UsingArgList]
-> Type
-> Either FnBody [InternalFnDef]
-> String
showGiven Maybe Var
y [TypeParam]
z [UsingArgList]
t Type
u Either FnBody [InternalFnDef]
v]

instance Show FnBody where
  show :: FnBody -> String
show (FnApply FnBody
x [FnBody]
y)
    | (FnVar' (Ctor' QCtor
_)) <- FnBody
x = [String] -> String
joinWords [forall a. Show a => a -> String
show FnBody
x, forall a. Show a => [a] -> String
wrapParensCsv [FnBody]
y]
    | Bool
otherwise = [String] -> String
joinWords [forall a. Show a => a -> String
show FnBody
x,
                             [String] -> String
joinWords forall a b. (a -> b) -> a -> b
$ ShowS
wrapParens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnBody]
y]
  show (NamedFnApply FnBody
x [(Var, FnBody)]
y) = [String] -> String
joinWords [forall a. Show a => a -> String
show FnBody
x, forall a. Show a => [a] -> String
wrapParensCsv forall a b. (a -> b) -> a -> b
$ String -> Wrapper
Wrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                      (\(Var
a, FnBody
b) -> forall a. Show a => a -> String
show Var
a String -> ShowS
+++ String
"=" String -> ShowS
+++ forall a. Show a => a -> String
show FnBody
b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, FnBody)]
y]
  show (InfixFnApply [FnOp]
x [FnBody
y]) = FnBody -> String
showForInfix FnBody
y String -> ShowS
+++ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Show a => a -> String
show [FnOp]
x
  show (InfixFnApply [FnOp]
x [FnBody]
y) = [String] -> [String] -> String
strs (ShowS
wrapSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnOp]
x)
                                 (FnBody -> String
showForInfix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnBody]
y)

  show (BodySelection FnBody
x [Var]
y) = forall a. [a] -> [[a]] -> [a]
intercalate String
"." (forall a. Show a => a -> String
show FnBody
x forall a. a -> [a] -> [a]
: (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
y))

  show (LambdaExpr [] FnBody
y)  = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show FnBody
y
  show (LambdaExpr [Pattern
x] FnBody
y)
    | [Pattern] -> Bool
allVars' [Pattern
x] = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ [String] -> String
joinWords [forall a. Show a => a -> String
show Pattern
x, String
"=>", forall a. Show a => a -> String
show FnBody
y]
  show (LambdaExpr [Pattern]
x FnBody
y)
    | [Pattern] -> Bool
allVars' [Pattern]
x = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ [String] -> String
joinWords [forall a. Show a => [a] -> String
wrapParensCsv [Pattern]
x, String
"=>", forall a. Show a => a -> String
show FnBody
y]
    | Bool
otherwise  = ShowS
wrapCurly forall a b. (a -> b) -> a -> b
$ [String] -> String
joinWords [String
"case", forall a. Show a => [a] -> String
wrapParensCsv [Pattern]
x,
                                          String
"=>", forall a. Show a => a -> String
show FnBody
y]
  show (LetExpr [InternalFnDef]
x FnBody
y)      = forall a b. (Show a, Show b) => [a] -> b -> String
wrapLetContext [InternalFnDef]
x FnBody
y
  show (Tuple [FnBody
x])        = forall a. Show a => a -> String
show FnBody
x
  show (Tuple [FnBody]
x)          = forall a. Show a => [a] -> String
wrapParensCsv [FnBody]
x
  show (FnOp' FnOp
x)          = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show FnOp
x
  show (FnVar' FnVar
x)         = forall a. Show a => a -> String
show FnVar
x
  show (Literal' Literal
x)       = forall a. Show a => a -> String
show Literal
x
  show (IfExpr FnBody
x FnBody
y FnBody
z)     = [String] -> String
joinWords [String
"if", forall a. Show a => a -> String
show FnBody
x,
                                       String
"then", forall a. Show a => a -> String
show FnBody
y,
                                       String
"else", forall a. Show a => a -> String
show FnBody
z]
  show (CondExpr [WhenExpr]
x FnBody
y)     = forall a. Show a => String -> [a] -> String
str (String
"\n" String -> ShowS
+++ ShowS
wrapSpaces String
"else")
                                (String -> Wrapper
Wrapper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WhenExpr]
x) forall a. [a] -> [a] -> [a]
++ [forall a. Show a => a -> String
show FnBody
y]))
  show (ForExpr [ForStep]
x FnBody
y)      = [String] -> String
joinWords [String
"for",
                                      forall a. Show a => [a] -> String
wrapBlock [ForStep]
x,
                                      String
"yield",
                                      forall a. Show a => a -> String
show FnBody
y]
  show (MatchExpr FnBody
x [CaseBinding]
y)    = [String] -> String
joinWords [forall a. Show a => a -> String
show FnBody
x,
                                      String
"match",
                                      forall a. Show a => [a] -> String
wrapBlock [CaseBinding]
y]
  show (TopLevelMatchExpr [CaseBinding]
x) = forall a. Show a => [a] -> String
wrapBlock [CaseBinding]
x

instance Show ForStep where
  show :: ForStep -> String
show (ForBinding [Var]
x FnBody
y) = [String] -> String
joinWords [forall a. Show a => [a] -> String
showTuple [Var]
x, String
"<-", forall a. Show a => a -> String
show FnBody
y]
  show (LetBinding [InternalFnDef]
x)   = [String] -> String
unlines (InternalFnDef -> String
showBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InternalFnDef]
x)
  show (Condition FnBody
x)    = [String] -> String
joinWords [String
"if", forall a. Show a => a -> String
show FnBody
x]

instance Show CaseBinding where
  show :: CaseBinding -> String
show (CaseBinding Pattern
x Maybe FnBody
y FnBody
z) = [String] -> String
joinWords [String
"case", forall a. Show a => a -> String
show Pattern
x,
                                        String
"if" forall a. Show a => String -> Maybe a -> String
`joinMaybe` Maybe FnBody
y,
                                        String
"=>", forall a. Show a => a -> String
show FnBody
z]
instance Show WhenExpr where
  show :: WhenExpr -> String
show (WhenExpr FnBody
x FnBody
y) = [String] -> String
joinWords [String
"if", forall a. Show a => a -> String
show FnBody
x,
                                  String
"then", forall a. Show a => a -> String
show FnBody
y]

instance Show FnVar where
  show :: FnVar -> String
show (Selection QVar
x [Var]
y) = forall a. [a] -> [[a]] -> [a]
intercalate String
"." (forall a. Show a => a -> String
show QVar
x forall a. a -> [a] -> [a]
: (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
y))
  show (Var' QVar
x)        = forall a. Show a => a -> String
show QVar
x
  show (Ctor' QCtor
x)       = forall a. Show a => a -> String
show QCtor
x

instance Show FnOp where
  show :: FnOp -> String
show (VarOp' QVarOp
x)  = forall a. Show a => a -> String
show QVarOp
x
  show (CtorOp' QCtorOp
x) = forall a. Show a => a -> String
show QCtorOp
x

instance Show InternalFnDef where
  show :: InternalFnDef -> String
show (FnVal ValDef
x)    = forall a. Show a => a -> String
show ValDef
x
  show (FnMethod MethodDef
x) = forall a. Show a => a -> String
show MethodDef
x
  show (FnGiven GivenDef
x)  = forall a. Show a => a -> String
show GivenDef
x


showBinding :: InternalFnDef -> String
showBinding :: InternalFnDef -> String
showBinding (FnVal (ValDef [Modifier]
_ [Var]
y Maybe Type
_ Maybe FnBody
t))         = [Var] -> Maybe Type -> Maybe FnBody -> String
showVal [Var]
y forall a. Maybe a
Nothing Maybe FnBody
t
showBinding (FnMethod (MethodDef [Modifier]
_ Var
y Maybe FnSig
_ Maybe FnBody
t))   = Var -> Maybe FnSig -> Maybe FnBody -> String
showDef Var
y forall a. Maybe a
Nothing Maybe FnBody
t
showBinding (FnGiven (GivenDef [Modifier]
_ Maybe Var
y [TypeParam]
z [UsingArgList]
t Type
u Either FnBody [InternalFnDef]
v)) = Maybe Var
-> [TypeParam]
-> [UsingArgList]
-> Type
-> Either FnBody [InternalFnDef]
-> String
showGiven Maybe Var
y [TypeParam]
z [UsingArgList]
t Type
u Either FnBody [InternalFnDef]
v


showForInfix :: FnBody -> String
showForInfix :: FnBody -> String
showForInfix x :: FnBody
x@(InfixFnApply [FnOp]
_ [FnBody]
_) = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show FnBody
x
showForInfix FnBody
x                    = forall a. Show a => a -> String
show FnBody
x


showVal :: [Var] -> Maybe Type -> Maybe FnBody -> String
showVal :: [Var] -> Maybe Type -> Maybe FnBody -> String
showVal [Var]
x Maybe Type
y Maybe FnBody
z = forall a. Show a => [a] -> String
showTuple [Var]
x forall a. [a] -> [a] -> [a]
++  String
":" forall a. Show a => String -> Maybe a -> String
`joinMaybe` Maybe Type
y
                            String -> ShowS
+++ String
"=" forall a. Show a => String -> Maybe a -> String
`joinMaybe` Maybe FnBody
z

showDef :: Var -> Maybe FnSig -> Maybe FnBody -> String
showDef :: Var -> Maybe FnSig -> Maybe FnBody -> String
showDef Var
x Maybe FnSig
y Maybe FnBody
z = forall a. Show a => a -> String
show Var
x forall a. [a] -> [a] -> [a]
++ (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FnSig
y)
                       String -> ShowS
+++ String
"=" forall a. Show a => String -> Maybe a -> String
`joinMaybe` (String -> Wrapper
Wrapper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
wrapSingleBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FnBody
z)


showGiven :: Maybe Var -> [TypeParam] -> [UsingArgList]
             -> Type -> Either FnBody [InternalFnDef] -> String

showGiven :: Maybe Var
-> [TypeParam]
-> [UsingArgList]
-> Type
-> Either FnBody [InternalFnDef]
-> String
showGiven Maybe Var
x [TypeParam]
y [UsingArgList]
z Type
t Either FnBody [InternalFnDef]
u = [String] -> String
joinWords [forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Show a => a -> String
show Maybe Var
x,
                                 forall a. Show a => [a] -> String
wrapSquareCsv [TypeParam]
y,
                                 forall a. Show a => String -> [a] -> String
str String
" " [UsingArgList]
z,
                                 forall m. Monoid m => Bool -> m -> m
when Bool
displaySep String
":",
                                 forall a. Show a => a -> String
show Type
t]
   forall a. [a] -> [a] -> [a]
++ case Either FnBody [InternalFnDef]
u of
        Left FnBody
body -> [String] -> String
joinWords [String
"=",
                               forall a. Show a => a -> String
show FnBody
body]
        Right [InternalFnDef]
defs -> [String] -> String
joinWords [String
"with",
                                forall a. Show a => [a] -> String
wrapSpacedBlock [InternalFnDef]
defs]

  where
    displaySep :: Bool
displaySep = forall (t :: * -> *) a. Foldable t => t a -> Bool
hasSome Maybe Var
x Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
hasSome [TypeParam]
y Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
hasSome (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap UsingArgList -> [UsingArgField]
fields [UsingArgList]
z)
    fields :: UsingArgList -> [UsingArgField]
fields (UsingArgList [UsingArgField]
h) = [UsingArgField]
h


showTuple :: Show a => [a] -> String
showTuple :: forall a. Show a => [a] -> String
showTuple [a
x] = forall a. Show a => a -> String
show a
x
showTuple [a]
x   = ShowS
wrapParens forall a b. (a -> b) -> a -> b
$ forall a. Show a => String -> [a] -> String
str String
", " [a]
x