module Conversions.ToPurescript.FnDef where

import qualified SyntaxTrees.Haskell.FnDef     as H
import qualified SyntaxTrees.Haskell.Type      as H
import qualified SyntaxTrees.Purescript.Common as P
import qualified SyntaxTrees.Purescript.FnDef  as P

import Bookhound.Utils.Foldable         (hasNone)
import Conversions.ToPurescript.Common  (literal, qCtor, qCtorOp, qVar, qVarOp,
                                         var, varOp, varOpFn)
import Conversions.ToPurescript.Pattern (pattern')
import Conversions.ToPurescript.Type    (findTypeParams, type')
import Data.Foldable                    (Foldable (toList))


fnSig :: H.FnSig -> P.FnSig
fnSig :: FnSig -> FnSig
fnSig (H.FnSig Var
x Type
y) = Var -> Type -> FnSig
P.FnSig (Var -> Var
varOpFn Var
x) (Type -> Type
type' Type
typeScoped)
  where
    typeScoped :: Type
typeScoped
      | (H.TypeScope [TypeParam]
_ Type
_) <- Type
y = Type
y
      | forall (m :: * -> *) a. Foldable m => m a -> Bool
hasNone forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams Type
y = Type
y
      | Bool
otherwise             = [TypeParam] -> Type -> Type
H.TypeScope (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams Type
y) Type
y

fnDef :: H.FnDef -> P.FnDef
fnDef :: FnDef -> FnDef
fnDef (H.FnDef [Var]
x [Pattern]
y MaybeGuardedFnBody
z) =
  [Var] -> [Pattern] -> MaybeGuardedFnBody -> FnDef
P.FnDef (Var -> Var
varOpFn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var]
x) (Pattern -> Pattern
pattern' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pattern]
y) (MaybeGuardedFnBody -> MaybeGuardedFnBody
maybeGuardedFnBody MaybeGuardedFnBody
z)


infixFnAnnotation :: H.InfixFnAnnotation -> P.InfixFnDef
infixFnAnnotation :: InfixFnAnnotation -> InfixFnDef
infixFnAnnotation (H.InfixFnAnnotation Associativity
x Integer
y VarOp
z) =
  Associativity -> Integer -> Var -> VarOp -> InfixFnDef
P.InfixFnDef (Associativity -> Associativity
associativity Associativity
x) Integer
y (String -> Var
P.Var String
"infixFn") (VarOp -> VarOp
varOp VarOp
z)

fnDefOrSig :: H.FnDefOrSig -> P.FnDefOrSig
fnDefOrSig :: FnDefOrSig -> FnDefOrSig
fnDefOrSig (H.Def FnDef
x) = FnDef -> FnDefOrSig
P.Def forall a b. (a -> b) -> a -> b
$ FnDef -> FnDef
fnDef FnDef
x
fnDefOrSig (H.Sig FnSig
x) = FnSig -> FnDefOrSig
P.Sig forall a b. (a -> b) -> a -> b
$ FnSig -> FnSig
fnSig FnSig
x

fnBody :: H.FnBody -> P.FnBody
fnBody :: FnBody -> FnBody
fnBody (H.FnApply FnBody
x [FnBody]
y)      = FnBody -> [FnBody] -> FnBody
P.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
P.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)    = FnOp -> FnBody -> FnBody
P.LeftOpSection (FnOp -> FnOp
fnOp FnOp
x) (FnBody -> FnBody
fnBody FnBody
y)
fnBody (H.RightOpSection FnBody
x FnOp
y)   = FnBody -> FnOp -> FnBody
P.RightOpSection (FnBody -> FnBody
fnBody FnBody
x) (FnOp -> FnOp
fnOp FnOp
y)


fnBody (H.LambdaExpr [Pattern]
x FnBody
y)   = [Pattern] -> FnBody -> FnBody
P.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.LetExpr [FnDefOrSig]
x FnBody
y)      = [FnDefOrSig] -> FnBody -> FnBody
P.LetExpr (FnDefOrSig -> FnDefOrSig
fnDefOrSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDefOrSig]
x) (FnBody -> FnBody
fnBody FnBody
y)
fnBody (H.WhereExpr FnBody
x [FnDefOrSig]
y)    = FnBody -> [FnDefOrSig] -> FnBody
P.WhereExpr (FnBody -> FnBody
fnBody FnBody
x) (FnDefOrSig -> FnDefOrSig
fnDefOrSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDefOrSig]
y)

fnBody (H.IfExpr FnBody
x FnBody
y FnBody
z)     = FnBody -> FnBody -> FnBody -> FnBody
P.IfExpr (FnBody -> FnBody
fnBody FnBody
x) (FnBody -> FnBody
fnBody FnBody
y) (FnBody -> FnBody
fnBody FnBody
z)
fnBody (H.MultiWayIfExpr [GuardedFnBody]
x) = [GuardedFnBody] -> FnBody
P.MultiWayIfExpr forall a b. (a -> b) -> a -> b
$ GuardedFnBody -> GuardedFnBody
guardedFnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardedFnBody]
x
fnBody (H.DoExpr [DoStep]
x)         = [DoStep] -> FnBody
P.DoExpr forall a b. (a -> b) -> a -> b
$ DoStep -> DoStep
doStep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DoStep]
x
fnBody (H.CaseOfExpr FnBody
x [CaseBinding]
y)   = FnBody -> [CaseBinding] -> FnBody
P.CaseOfExpr (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) = [CaseBinding] -> FnBody
P.LambdaCaseExpr forall a b. (a -> b) -> a -> b
$ CaseBinding -> CaseBinding
caseBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CaseBinding]
x
fnBody (H.RecordCreate FnBody
x [(Var, FnBody)]
y) = FnBody -> [(Var, FnBody)] -> FnBody
P.RecordCreate (FnBody -> FnBody
fnBody FnBody
x)
                                ((\(Var
z, FnBody
t) -> (Var -> Var
var Var
z, FnBody -> FnBody
fnBody FnBody
t)) 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
P.RecordUpdate (FnBody -> FnBody
fnBody FnBody
x)
                                ((\(Var
z, FnBody
t) -> (Var -> Var
var Var
z, FnBody -> FnBody
fnBody FnBody
t)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, FnBody)]
y)

fnBody (H.TypeAnnotation FnBody
x Type
y) = FnBody -> Type -> FnBody
P.TypeAnnotation (FnBody -> FnBody
fnBody FnBody
x) (Type -> Type
type' Type
y)
fnBody (H.ListRange FnBody
x (Just FnBody
y)) = FnBody -> FnBody -> FnBody
P.ArrayRange (FnBody -> FnBody
fnBody FnBody
x) (FnBody -> FnBody
fnBody FnBody
y)
fnBody (H.ListRange FnBody
x Maybe FnBody
Nothing)  = FnBody -> FnBody -> FnBody
P.ArrayRange (FnBody -> FnBody
fnBody FnBody
x)
  (FnVar -> FnBody
P.FnVar' forall a b. (a -> b) -> a -> b
$ QVar -> FnVar
P.Var' forall a b. (a -> b) -> a -> b
$ Maybe Module -> Var -> QVar
P.QVar forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> Var
P.Var String
"maxBound")
fnBody (H.Tuple [FnBody]
x)          = [FnBody] -> FnBody
P.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.List [FnBody]
x)           = [FnBody] -> FnBody
P.Array 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
P.FnOp' forall a b. (a -> b) -> a -> b
$ FnOp -> FnOp
fnOp FnOp
x
fnBody (H.FnVar' FnVar
x)         = FnVar -> FnBody
P.FnVar' forall a b. (a -> b) -> a -> b
$ FnVar -> FnVar
fnVar FnVar
x
fnBody (H.Literal' Literal
x)       = Literal -> FnBody
P.Literal' forall a b. (a -> b) -> a -> b
$ Literal -> Literal
literal Literal
x


fnVar :: H.FnVar -> P.FnVar
fnVar :: FnVar -> FnVar
fnVar (H.Selector Var
x)    = Var -> FnVar
P.Selector forall a b. (a -> b) -> a -> b
$ Var -> Var
var Var
x
fnVar (H.Selection QVar
x [Var]
y) = QVar -> [Var] -> FnVar
P.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)        = QVar -> FnVar
P.Var' forall a b. (a -> b) -> a -> b
$ QVar -> QVar
qVar QVar
x
fnVar (H.Ctor' QCtor
x)       = QCtor -> FnVar
P.Ctor' forall a b. (a -> b) -> a -> b
$ QCtor -> QCtor
qCtor QCtor
x

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


doStep :: H.DoStep -> P.DoStep
doStep :: DoStep -> DoStep
doStep (H.DoBinding [Var]
x FnBody
y) = [Var] -> FnBody -> DoStep
P.DoBinding (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)  = [FnDefOrSig] -> DoStep
P.LetBinding (FnDefOrSig -> FnDefOrSig
fnDefOrSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FnDefOrSig]
x)
doStep (H.Body FnBody
x)        = FnBody -> DoStep
P.Body forall a b. (a -> b) -> a -> b
$ FnBody -> FnBody
fnBody FnBody
x


caseBinding :: H.CaseBinding -> P.CaseBinding
caseBinding :: CaseBinding -> CaseBinding
caseBinding (H.CaseBinding Pattern
x MaybeGuardedFnBody
y) =
  Pattern -> MaybeGuardedFnBody -> CaseBinding
P.CaseBinding (Pattern -> Pattern
pattern' Pattern
x) (MaybeGuardedFnBody -> MaybeGuardedFnBody
maybeGuardedFnBody MaybeGuardedFnBody
y)


maybeGuardedFnBody :: H.MaybeGuardedFnBody -> P.MaybeGuardedFnBody
maybeGuardedFnBody :: MaybeGuardedFnBody -> MaybeGuardedFnBody
maybeGuardedFnBody (H.Guarded [GuardedFnBody]
x)  = [GuardedFnBody] -> MaybeGuardedFnBody
P.Guarded forall a b. (a -> b) -> a -> b
$ GuardedFnBody -> GuardedFnBody
guardedFnBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuardedFnBody]
x
maybeGuardedFnBody (H.Standard FnBody
x) = FnBody -> MaybeGuardedFnBody
P.Standard forall a b. (a -> b) -> a -> b
$ FnBody -> FnBody
fnBody FnBody
x


guardedFnBody :: H.GuardedFnBody -> P.GuardedFnBody
guardedFnBody :: GuardedFnBody -> GuardedFnBody
guardedFnBody (H.GuardedFnBody Guard
x FnBody
y) =
  Guard -> FnBody -> GuardedFnBody
P.GuardedFnBody (Guard -> Guard
guard Guard
x) (FnBody -> FnBody
fnBody FnBody
y)

guard :: H.Guard -> P.Guard
guard :: Guard -> Guard
guard (H.Guard [PatternGuard]
x) = [PatternGuard] -> Guard
P.Guard forall a b. (a -> b) -> a -> b
$ PatternGuard -> PatternGuard
patternGuard forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PatternGuard]
x
guard Guard
H.Otherwise = Guard
P.Otherwise

patternGuard :: H.PatternGuard -> P.PatternGuard
patternGuard :: PatternGuard -> PatternGuard
patternGuard (H.PatternGuard Pattern
x FnBody
y) =
  Pattern -> FnBody -> PatternGuard
P.PatternGuard (Pattern -> Pattern
pattern' Pattern
x) (FnBody -> FnBody
fnBody FnBody
y)
patternGuard (H.SimpleGuard FnBody
x) =
  FnBody -> PatternGuard
P.SimpleGuard (FnBody -> FnBody
fnBody FnBody
x)

associativity :: H.Associativity -> P.Associativity
associativity :: Associativity -> Associativity
associativity Associativity
H.LAssoc = Associativity
P.LAssoc
associativity Associativity
H.RAssoc = Associativity
P.RAssoc