module Conversions.ToScala.FnDef where

import qualified SyntaxTrees.Haskell.Common as H
import qualified SyntaxTrees.Haskell.FnDef  as H
import qualified SyntaxTrees.Haskell.Type   as H
import qualified SyntaxTrees.Scala.Common   as S
import qualified SyntaxTrees.Scala.FnDef    as S
import qualified SyntaxTrees.Scala.Pattern  as S

import Conversions.ToScala.Common  (autoIds, literal, qCtor, qCtorOp, qVar,
                                    qVarOp, var)
import Conversions.ToScala.Pattern (allVars, extractVars, pattern')
import Conversions.ToScala.Type    (argLists, classScopeSplit, findTypeParams,
                                    typeParam, typeSplit, usingArgList)

import Data.Foldable           (Foldable (fold, toList))
import Data.List               (nubBy)
import Data.Maybe              (fromMaybe, isJust, listToMaybe, mapMaybe)
import Data.Tuple.Extra        (uncurry3, (***))
import SyntaxTrees.Scala.FnDef (WhenExpr (..))
import Utils.List              (groupTuplesByKey, mergeUnion)


emptyFnSig :: S.FnSig
emptyFnSig :: FnSig
emptyFnSig = [TypeParam] -> [ArgList] -> [UsingArgList] -> Maybe Type -> FnSig
S.FnSig [] [] [] forall a. Maybe a
Nothing

namedFnSig :: H.Type -> [H.Var] -> S.FnSig
namedFnSig :: Type -> [Var] -> FnSig
namedFnSig Type
tpe [Var]
args = [TypeParam] -> [ArgList] -> [UsingArgList] -> Maybe Type -> FnSig
S.FnSig (TypeParam -> TypeParam
typeParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams Type
tpe))
                      ([Var] -> [Type] -> [ArgList]
argLists (Var -> Var
var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
args) [Type]
argTypes)
                      [[ClassConstraint] -> UsingArgList
usingArgList [ClassConstraint]
constraints]
                      (forall a. a -> Maybe a
Just Type
retType)
  where
    ([ClassConstraint]
constraints, Type
rest) = Type -> ([ClassConstraint], Type)
classScopeSplit Type
tpe
    ([Type]
argTypes, Type
retType) = Int -> Type -> ([Type], Type)
typeSplit (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
args) Type
rest


unNamedFnSig :: H.Type -> Int -> S.FnSig
unNamedFnSig :: Type -> Int -> FnSig
unNamedFnSig Type
tpe Int
n = [TypeParam] -> [ArgList] -> [UsingArgList] -> Maybe Type -> FnSig
S.FnSig (TypeParam -> TypeParam
typeParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams Type
tpe))
                     ([Var] -> [Type] -> [ArgList]
argLists (String -> Var
S.Var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
autoIds) [Type]
argTypes)
                     [[ClassConstraint] -> UsingArgList
usingArgList [ClassConstraint]
constraints]
                     (forall a. a -> Maybe a
Just Type
retType)
  where
    ([ClassConstraint]
constraints, Type
rest) = Type -> ([ClassConstraint], Type)
classScopeSplit Type
tpe
    ([Type]
argTypes, Type
retType) = Int -> Type -> ([Type], Type)
typeSplit Int
n Type
rest


fnDefOrSigs :: [H.FnDefOrSig] -> [(Maybe H.FnSig, Maybe [H.FnDef])]
fnDefOrSigs :: [FnDefOrSig] -> [(Maybe FnSig, Maybe [FnDef])]
fnDefOrSigs [FnDefOrSig]
defsOrSigs = forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy forall {b} {a} {b} {b}.
(Eq b, HasField "name" a b) =>
(Maybe a, b) -> (Maybe a, b) -> Bool
dedupFn forall a b. (a -> b) -> a -> b
$ forall a b c. Eq a => [(a, b)] -> [(a, c)] -> [(Maybe b, Maybe c)]
mergeUnion [(Var, FnSig)]
sigs [(Var, [FnDef])]
groupedDefs

  where
    dedupFn :: (Maybe a, b) -> (Maybe a, b) -> Bool
dedupFn (Maybe a, b)
x (Maybe a, b)
y = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isJust [forall a b. (a, b) -> a
fst (Maybe a, b)
x, forall a b. (a, b) -> a
fst (Maybe a, b)
y] Bool -> Bool -> Bool
&&
                  ((.name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst (Maybe a, b)
x) forall a. Eq a => a -> a -> Bool
== ((.name) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> a
fst (Maybe a, b)
y)
    defs :: [(Var, FnDef)]
defs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case (H.Def FnDef
x) -> forall a. a -> Maybe a
Just (forall a. [a] -> a
head FnDef
x.names, FnDef
x)
                           (H.Sig FnSig
_) -> forall a. Maybe a
Nothing)
           [FnDefOrSig]
defsOrSigs
    sigs :: [(Var, FnSig)]
sigs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case (H.Def FnDef
_) -> forall a. Maybe a
Nothing
                           (H.Sig FnSig
x) -> forall a. a -> Maybe a
Just (FnSig
x.name, FnSig
x))
           [FnDefOrSig]
defsOrSigs
    groupedDefs :: [(Var, [FnDef])]
groupedDefs = forall a b. Eq a => [(a, b)] -> [(a, [b])]
groupTuplesByKey [(Var, FnDef)]
defs



fnDefs :: (Maybe H.FnSig, Maybe [H.FnDef]) -> S.InternalFnDef
fnDefs :: (Maybe FnSig, Maybe [FnDef]) -> InternalFnDef
fnDefs (Maybe FnSig
x, Just [FnDef
y])
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length  FnDef
y.names forall a. Ord a => a -> a -> Bool
> Int
1 = FnDef -> InternalFnDef
valDef FnDef
y
  | [Pattern] -> Bool
allVars FnDef
y.args      = Maybe FnSig -> FnDef -> InternalFnDef
simpleFnDef Maybe FnSig
x FnDef
y
fnDefs (Maybe FnSig
x, Maybe [FnDef]
y)           = Maybe FnSig -> Maybe [FnDef] -> InternalFnDef
fnDef Maybe FnSig
x Maybe [FnDef]
y


fnDef :: Maybe H.FnSig -> Maybe [H.FnDef] -> S.InternalFnDef
fnDef :: Maybe FnSig -> Maybe [FnDef] -> InternalFnDef
fnDef Maybe FnSig
sig Maybe [FnDef]
defs = MethodDef -> InternalFnDef
S.FnMethod forall a b. (a -> b) -> a -> b
$ [Modifier] -> Var -> Maybe FnSig -> Maybe FnBody -> MethodDef
S.MethodDef [] Var
name Maybe FnSig
fnSig
                              (FnBody -> FnBody
matchFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FnDef] -> FnBody
fnDefToFnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [FnDef]
defs)
  where
    n :: Int
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.args)) forall a b. (a -> b) -> a -> b
$ (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Maybe [FnDef]
defs
    fnSig :: Maybe FnSig
fnSig =  (Type -> Int -> FnSig
`unNamedFnSig` Int
n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.type') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FnSig
sig
    name :: Var
name = Var -> Var
var forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.names) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] Maybe [FnDef]
defs) (.name) Maybe FnSig
sig
    (Int
n', FnBody -> FnBody
matchFn) = if Int
n forall a. Eq a => a -> a -> Bool
== Int
1 then (Int
0, FnBody -> FnBody
topLevelMatch) else (Int
n, forall a. a -> a
id)

simpleFnDef :: Maybe H.FnSig -> H.FnDef -> S.InternalFnDef
simpleFnDef :: Maybe FnSig -> FnDef -> InternalFnDef
simpleFnDef Maybe FnSig
sig FnDef
def = MethodDef -> InternalFnDef
S.FnMethod forall a b. (a -> b) -> a -> b
$ [Modifier] -> Var -> Maybe FnSig -> Maybe FnBody -> MethodDef
S.MethodDef [] Var
name Maybe FnSig
fnSig
                                               (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FnDef -> FnBody
simpleFnDefToFnBody FnDef
def)
  where
    name :: Var
name = Var -> Var
var forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head FnDef
def.names
    args :: [Var]
args = [Pattern] -> [Var]
extractVars forall a b. (a -> b) -> a -> b
$ (.args) FnDef
def
    fnSig :: Maybe FnSig
fnSig = (Type -> [Var] -> FnSig
`namedFnSig` [Var]
args) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.type') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FnSig
sig

valDef :: H.FnDef -> S.InternalFnDef
valDef :: FnDef -> InternalFnDef
valDef FnDef
def = ValDef -> InternalFnDef
S.FnVal forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Var] -> Maybe Type -> Maybe FnBody -> ValDef
S.ValDef [Modifier
S.Lazy] [Var]
names forall a. Maybe a
Nothing
                                (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FnDef -> FnBody
simpleFnDefToFnBody FnDef
def)
  where
    names :: [Var]
names = Var -> Var
var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FnDef
def.names


simpleFnDefToFnBody :: H.FnDef -> S.FnBody
simpleFnDefToFnBody :: FnDef -> FnBody
simpleFnDefToFnBody FnDef
def = MaybeGuardedFnBody -> FnBody
maybeGuardedBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.body) forall a b. (a -> b) -> a -> b
$ FnDef
def

fnDefToFnBody :: [H.FnDef] -> S.FnBody
fnDefToFnBody :: [FnDef] -> FnBody
fnDefToFnBody [FnDef]
defs = FnBody
match
  where
    match :: FnBody
match = FnBody -> FnBody
simplifyMatch forall a b. (a -> b) -> a -> b
$
      FnBody -> [CaseBinding] -> FnBody
S.MatchExpr ([String] -> FnBody
tuple forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
n [String]
autoIds) [CaseBinding]
cases
    casePatterns :: [Pattern]
casePatterns = ([Pattern] -> Pattern
S.TuplePattern  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern -> Pattern
pattern' <$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.args)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDef]
defs
    caseBodies :: [FnBody]
caseBodies =  (MaybeGuardedFnBody -> FnBody
maybeGuardedBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.body)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDef]
defs
    cases :: [CaseBinding]
cases = forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Pattern]
casePatterns (forall a. a -> [a]
repeat forall a. Maybe a
Nothing)
                                              [FnBody]
caseBodies
    tuple :: [String] -> FnBody
tuple [String]
x = [FnBody] -> FnBody
S.Tuple forall a b. (a -> b) -> a -> b
$ (FnVar -> FnBody
S.FnVar' forall b c a. (b -> c) -> (a -> b) -> a -> c
. QVar -> FnVar
S.Var' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Package -> Var -> QVar
S.QVar forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Var
S.Var) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
x
    n :: Int
n = (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.args)) (forall a. [a] -> a
head [FnDef]
defs)



fnBody :: H.FnBody -> S.FnBody
fnBody :: FnBody -> FnBody
fnBody (H.FnApply FnBody
x [FnBody]
y)      = FnBody -> [FnBody] -> FnBody
S.FnApply (FnBody -> FnBody
fnBody FnBody
x) (FnBody -> FnBody
fnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnBody]
y)
fnBody (H.InfixFnApply [FnOp]
x [FnBody]
y) = [FnOp] -> [FnBody] -> FnBody
S.InfixFnApply (FnOp -> FnOp
fnOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnOp]
x) (FnBody -> FnBody
fnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnBody]
y)

fnBody (H.LeftOpSection FnOp
x FnBody
y) = [Pattern] -> FnBody -> FnBody
S.LambdaExpr [] ([FnOp] -> [FnBody] -> FnBody
S.InfixFnApply [FnOp -> FnOp
fnOp FnOp
x]
        [FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> FnVar
S.Var' forall a b. (a -> b) -> a -> b
$ Maybe Package -> Var -> QVar
S.QVar forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Var
S.Var String
"_", FnBody -> FnBody
fnBody FnBody
y])

fnBody (H.RightOpSection FnBody
x FnOp
y) = [Pattern] -> FnBody -> FnBody
S.LambdaExpr [] ([FnOp] -> [FnBody] -> FnBody
S.InfixFnApply [FnOp -> FnOp
fnOp FnOp
y]
        [FnBody -> FnBody
fnBody FnBody
x, FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> FnVar
S.Var' forall a b. (a -> b) -> a -> b
$ Maybe Package -> Var -> QVar
S.QVar forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Var
S.Var String
"_"])

fnBody (H.LambdaExpr [Pattern]
x FnBody
y)   = [Pattern] -> FnBody -> FnBody
S.LambdaExpr (Pattern -> Pattern
pattern' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern]
x)
                                          (FnBody -> FnBody
fnBody FnBody
y)
fnBody (H.IfExpr FnBody
x FnBody
y FnBody
z)     = FnBody -> FnBody -> FnBody -> FnBody
S.IfExpr (FnBody -> FnBody
fnBody FnBody
x) (FnBody -> FnBody
fnBody FnBody
y) (FnBody -> FnBody
fnBody FnBody
z)
fnBody (H.DoExpr [DoStep]
x)         = [ForStep] -> FnBody -> FnBody
S.ForExpr (DoStep -> ForStep
doStep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
init [DoStep]
x) (DoStep -> FnBody
extractDoStep forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [DoStep]
x)
fnBody (H.MultiWayIfExpr [GuardedFnBody]
x) = MaybeGuardedFnBody -> FnBody
maybeGuardedBody forall a b. (a -> b) -> a -> b
$ [GuardedFnBody] -> MaybeGuardedFnBody
H.Guarded [GuardedFnBody]
x
fnBody (H.CaseOfExpr FnBody
x [CaseBinding]
y)   = FnBody -> FnBody
simplifyMatch forall a b. (a -> b) -> a -> b
$
                              FnBody -> [CaseBinding] -> FnBody
S.MatchExpr (FnBody -> FnBody
fnBody FnBody
x) (CaseBinding -> CaseBinding
caseBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CaseBinding]
y)
fnBody (H.LambdaCaseExpr [CaseBinding]
x) = [Pattern] -> FnBody -> FnBody
S.LambdaExpr [] (FnBody -> FnBody
fnBody forall a b. (a -> b) -> a -> b
$ FnBody -> [CaseBinding] -> FnBody
H.CaseOfExpr
                              (FnVar -> FnBody
H.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> FnVar
H.Var' forall a b. (a -> b) -> a -> b
$ Maybe Module -> Var -> QVar
H.QVar forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Var
H.Var String
"_") [CaseBinding]
x)

fnBody (H.TypeAnnotation FnBody
x Type
_) = FnBody -> FnBody
fnBody FnBody
x
fnBody (H.ListRange FnBody
x (Just FnBody
y)) = [FnOp] -> [FnBody] -> FnBody
S.InfixFnApply
    [QVarOp -> FnOp
S.VarOp' forall a b. (a -> b) -> a -> b
$ Maybe Package -> VarOp -> QVarOp
S.QVarOp forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> VarOp
S.VarOp String
"to"] [FnBody -> FnBody
fnBody FnBody
x, FnBody -> FnBody
fnBody FnBody
y]
fnBody (H.ListRange FnBody
x Maybe FnBody
Nothing)  = [FnOp] -> [FnBody] -> FnBody
S.InfixFnApply
    [QVarOp -> FnOp
S.VarOp' forall a b. (a -> b) -> a -> b
$ Maybe Package -> VarOp -> QVarOp
S.QVarOp forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> VarOp
S.VarOp String
"to"]
    [FnBody -> FnBody
fnBody FnBody
x, FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> FnVar
S.Var' forall a b. (a -> b) -> a -> b
$ Maybe Package -> Var -> QVar
S.QVar forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Var
S.Var String
"maxBound"]
fnBody (H.Tuple [FnBody]
x)          = [FnBody] -> FnBody
S.Tuple forall a b. (a -> b) -> a -> b
$ FnBody -> FnBody
fnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnBody]
x
fnBody (H.FnOp' FnOp
x)          = FnOp -> FnBody
S.FnOp' forall a b. (a -> b) -> a -> b
$ FnOp -> FnOp
fnOp FnOp
x
fnBody (H.FnVar' FnVar
x)         = FnVar -> FnBody
fnVar FnVar
x
fnBody (H.Literal' Literal
x)       = Literal -> FnBody
S.Literal' forall a b. (a -> b) -> a -> b
$ Literal -> Literal
literal Literal
x

fnBody (H.List [])        = FnBody -> [FnBody] -> FnBody
S.FnApply
        (FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QCtor -> FnVar
S.Ctor' forall a b. (a -> b) -> a -> b
$ Maybe Package -> Ctor -> QCtor
S.QCtor (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String] -> Package
S.Package [String
"List"])
                                      (String -> Ctor
S.Ctor String
"empty")) []
fnBody (H.List [FnBody]
x)        = FnBody -> [FnBody] -> FnBody
S.FnApply
        (FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QCtor -> FnVar
S.Ctor' forall a b. (a -> b) -> a -> b
$ Maybe Package -> Ctor -> QCtor
S.QCtor forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Ctor
S.Ctor String
"List")
                                     (FnBody -> FnBody
fnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnBody]
x)
fnBody (H.LetExpr [FnDefOrSig]
x FnBody
y)   = [InternalFnDef] -> FnBody -> FnBody
S.LetExpr ((Maybe FnSig, Maybe [FnDef]) -> InternalFnDef
fnDefs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDefOrSig] -> [(Maybe FnSig, Maybe [FnDef])]
fnDefOrSigs [FnDefOrSig]
x)
                                     (FnBody -> FnBody
fnBody FnBody
y)
fnBody (H.WhereExpr FnBody
x [FnDefOrSig]
y) = [InternalFnDef] -> FnBody -> FnBody
S.LetExpr ((Maybe FnSig, Maybe [FnDef]) -> InternalFnDef
fnDefs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDefOrSig] -> [(Maybe FnSig, Maybe [FnDef])]
fnDefOrSigs [FnDefOrSig]
y)
                                     (FnBody -> FnBody
fnBody FnBody
x)
fnBody (H.RecordCreate FnBody
x [(Var, FnBody)]
y) = FnBody -> [(Var, FnBody)] -> FnBody
S.NamedFnApply (FnBody -> FnBody
fnBody FnBody
x)
                                             ((Var -> Var
var forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** FnBody -> FnBody
fnBody) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, FnBody)]
y)
fnBody (H.RecordUpdate FnBody
x [(Var, FnBody)]
y) =
  FnBody -> [(Var, FnBody)] -> FnBody
S.NamedFnApply (FnBody -> [Var] -> FnBody
S.BodySelection (FnBody -> FnBody
fnBody FnBody
x) [String -> Var
S.Var String
"copy"])
                 ((Var -> Var
var forall a a' b b'. (a -> a') -> (b -> b') -> (a, b) -> (a', b')
*** FnBody -> FnBody
fnBody) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, FnBody)]
y)



doStep :: H.DoStep -> S.ForStep
doStep :: DoStep -> ForStep
doStep (H.DoBinding [Var]
x FnBody
y) = [Var] -> FnBody -> ForStep
S.ForBinding (Var -> Var
var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
x) (FnBody -> FnBody
fnBody FnBody
y)
doStep (H.LetBinding [FnDefOrSig]
x)  = [InternalFnDef] -> ForStep
S.LetBinding ((Maybe FnSig, Maybe [FnDef]) -> InternalFnDef
fnDefs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDefOrSig] -> [(Maybe FnSig, Maybe [FnDef])]
fnDefOrSigs [FnDefOrSig]
x)
doStep (H.Body FnBody
x)        = [Var] -> FnBody -> ForStep
S.ForBinding [String -> Var
S.Var String
"_"] (FnBody -> FnBody
fnBody FnBody
x)



caseBinding :: H.CaseBinding -> S.CaseBinding
caseBinding :: CaseBinding -> CaseBinding
caseBinding (H.CaseBinding Pattern
x MaybeGuardedFnBody
y) = Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding (Pattern -> Pattern
pattern' Pattern
x) forall a. Maybe a
Nothing
                                                (MaybeGuardedFnBody -> FnBody
maybeGuardedBody MaybeGuardedFnBody
y)


simplifyMatch :: S.FnBody -> S.FnBody
simplifyMatch :: FnBody -> FnBody
simplifyMatch (S.MatchExpr FnBody
x [CaseBinding]
y) = FnBody -> [CaseBinding] -> FnBody
S.MatchExpr FnBody
x (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CaseBinding -> [CaseBinding]
simplifyCases [CaseBinding]
y)
simplifyMatch FnBody
x                 = FnBody
x

topLevelMatch :: S.FnBody -> S.FnBody
topLevelMatch :: FnBody -> FnBody
topLevelMatch (S.MatchExpr FnBody
_ [CaseBinding]
y) = [CaseBinding] -> FnBody
S.TopLevelMatchExpr [CaseBinding]
y
topLevelMatch FnBody
x                 = FnBody
x


simplifyCases :: S.CaseBinding -> [S.CaseBinding]
simplifyCases :: CaseBinding -> [CaseBinding]
simplifyCases (S.CaseBinding Pattern
x' Maybe FnBody
Nothing (S.MatchExpr FnBody
_ [CaseBinding]
y))
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseBinding -> Maybe (Maybe FnBody, FnBody)
simpleCase) [CaseBinding]
y = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding Pattern
x') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe FnBody, FnBody)]
z
    where
      z :: [(Maybe FnBody, FnBody)]
z = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CaseBinding -> Maybe (Maybe FnBody, FnBody)
simpleCase [CaseBinding]
y
simplifyCases CaseBinding
x = [CaseBinding
x]


simpleCase :: S.CaseBinding -> Maybe (Maybe S.FnBody, S.FnBody)
simpleCase :: CaseBinding -> Maybe (Maybe FnBody, FnBody)
simpleCase (S.CaseBinding Pattern
S.Wildcard Maybe FnBody
x FnBody
y) = forall a. a -> Maybe a
Just (Maybe FnBody
x, FnBody
y)
simpleCase CaseBinding
_                              = forall a. Maybe a
Nothing


maybeGuardedBody :: H.MaybeGuardedFnBody -> S.FnBody
maybeGuardedBody :: MaybeGuardedFnBody -> FnBody
maybeGuardedBody (H.Guarded [GuardedFnBody]
x)
  | Guard
H.Otherwise <-  forall a. [a] -> a
last [Guard]
guards
  , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Guard -> Bool
onlySimpleGuards forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [Guard]
guards
  = [WhenExpr] -> FnBody -> FnBody
S.CondExpr [WhenExpr]
whenBranches FnBody
elseBranch
  where
    guards :: [Guard]
guards = (.guard) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardedFnBody]
x
    bodies :: [FnBody]
bodies = FnBody -> FnBody
fnBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.body)  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardedFnBody]
x
    conds :: [FnBody]
conds = [FnBody] -> FnBody
aggregateConds forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FnBody -> FnBody
fnBody <$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Guard -> [FnBody]
extractSimpleGuards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> [a]
init [Guard]
guards)
    whenBranches :: [WhenExpr]
whenBranches = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FnBody -> FnBody -> WhenExpr
WhenExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [FnBody]
conds (forall a. [a] -> [a]
init [FnBody]
bodies)
    elseBranch :: FnBody
elseBranch = forall a. [a] -> a
last [FnBody]
bodies

maybeGuardedBody (H.Guarded [GuardedFnBody]
x)  = FnBody -> FnBody
simplifyMatch forall a b. (a -> b) -> a -> b
$
  FnBody -> [CaseBinding] -> FnBody
S.MatchExpr (Literal -> FnBody
S.Literal' forall a b. (a -> b) -> a -> b
$ Bool -> Literal
S.BoolLit Bool
True) (GuardedFnBody -> CaseBinding
guardedBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardedFnBody]
x)
maybeGuardedBody (H.Standard FnBody
x) = FnBody -> FnBody
fnBody FnBody
x


guardedBody :: H.GuardedFnBody -> S.CaseBinding
guardedBody :: GuardedFnBody -> CaseBinding
guardedBody (H.GuardedFnBody x :: Guard
x@(H.Guard [PatternGuard]
y) FnBody
body)
      | Guard -> Bool
onlySimpleGuards Guard
x =
        Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding Pattern
S.Wildcard (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [FnBody] -> FnBody
aggregateConds forall a b. (a -> b) -> a -> b
$
                                         FnBody -> FnBody
fnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Guard -> [FnBody]
extractSimpleGuards Guard
x)
                                 (FnBody -> FnBody
fnBody FnBody
body)

      | Bool
otherwise =
        Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding Pattern
S.Wildcard forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PatternGuard -> FnBody -> FnBody
patternGuard (FnBody -> FnBody
fnBody FnBody
body) [PatternGuard]
y

guardedBody (H.GuardedFnBody Guard
H.Otherwise FnBody
body) =
  Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding Pattern
S.Wildcard forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ FnBody -> FnBody
fnBody FnBody
body


patternGuard :: H.PatternGuard -> S.FnBody -> S.FnBody
patternGuard :: PatternGuard -> FnBody -> FnBody
patternGuard (H.PatternGuard Pattern
x FnBody
y) FnBody
body = FnBody -> FnBody
simplifyMatch forall a b. (a -> b) -> a -> b
$
  FnBody -> [CaseBinding] -> FnBody
S.MatchExpr
        (FnBody -> FnBody
fnBody FnBody
y)
        [Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding (Pattern -> Pattern
pattern' Pattern
x) forall a. Maybe a
Nothing FnBody
body]

patternGuard (H.SimpleGuard FnBody
x) FnBody
body = FnBody -> FnBody
simplifyMatch forall a b. (a -> b) -> a -> b
$
  FnBody -> [CaseBinding] -> FnBody
S.MatchExpr
        (Literal -> FnBody
S.Literal' forall a b. (a -> b) -> a -> b
$ Bool -> Literal
S.BoolLit Bool
True)
        [Pattern -> Maybe FnBody -> FnBody -> CaseBinding
S.CaseBinding Pattern
S.Wildcard (forall a. a -> Maybe a
Just (FnBody -> FnBody
fnBody FnBody
x)) FnBody
body]


fnVar :: H.FnVar -> S.FnBody
fnVar :: FnVar -> FnBody
fnVar (H.Selector Var
x)    = [Pattern] -> FnBody -> FnBody
S.LambdaExpr [] forall a b. (a -> b) -> a -> b
$ FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$
                                QVar -> [Var] -> FnVar
S.Selection (Maybe Package -> Var -> QVar
S.QVar forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Var
S.Var String
"_") [Var -> Var
var Var
x]
fnVar (H.Selection QVar
x [Var]
y) = FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> [Var] -> FnVar
S.Selection (QVar -> QVar
qVar QVar
x) (Var -> Var
var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
y)
fnVar (H.Var' QVar
x)        = FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> FnVar
S.Var' forall a b. (a -> b) -> a -> b
$ QVar -> QVar
qVar QVar
x
fnVar (H.Ctor' QCtor
x)       = FnVar -> FnBody
S.FnVar' forall a b. (a -> b) -> a -> b
$ QCtor -> FnVar
S.Ctor' forall a b. (a -> b) -> a -> b
$ QCtor -> QCtor
qCtor QCtor
x


fnOp :: H.FnOp -> S.FnOp
fnOp :: FnOp -> FnOp
fnOp (H.VarOp' QVarOp
x)  = QVarOp -> FnOp
S.VarOp' forall a b. (a -> b) -> a -> b
$ QVarOp -> QVarOp
qVarOp QVarOp
x
fnOp (H.CtorOp' QCtorOp
x) = QCtorOp -> FnOp
S.CtorOp' forall a b. (a -> b) -> a -> b
$ QCtorOp -> QCtorOp
qCtorOp QCtorOp
x


extractDoStep :: H.DoStep -> S.FnBody
extractDoStep :: DoStep -> FnBody
extractDoStep (H.DoBinding [Var]
_ FnBody
y) = FnBody -> FnBody
fnBody FnBody
y
extractDoStep (H.Body FnBody
x)        = FnBody -> FnBody
fnBody FnBody
x
extractDoStep (H.LetBinding  [FnDefOrSig]
_) = [FnBody] -> FnBody
S.Tuple []


extractSimpleGuards :: H.Guard -> [H.FnBody]
extractSimpleGuards :: Guard -> [FnBody]
extractSimpleGuards (H.Guard [PatternGuard]
x) =
  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\case (H.SimpleGuard FnBody
y) -> [FnBody
y]; PatternGuard
_ -> []) [PatternGuard]
x
extractSimpleGuards Guard
_ = []


onlySimpleGuards :: H.Guard -> Bool
onlySimpleGuards :: Guard -> Bool
onlySimpleGuards (H.Guard [PatternGuard]
x) =
  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case (H.SimpleGuard FnBody
_) -> Bool
True; PatternGuard
_ -> Bool
False ) [PatternGuard]
x
onlySimpleGuards Guard
H.Otherwise = Bool
False


aggregateConds :: [S.FnBody] -> S.FnBody
aggregateConds :: [FnBody] -> FnBody
aggregateConds [FnBody
x] = FnBody
x
aggregateConds [FnBody]
x = [FnOp] -> [FnBody] -> FnBody
S.InfixFnApply
                     [QVarOp -> FnOp
S.VarOp' forall a b. (a -> b) -> a -> b
$ Maybe Package -> VarOp -> QVarOp
S.QVarOp forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> VarOp
S.VarOp String
"&&"] [FnBody]
x