Add more to SimplifySyntax.

app/SimplifySyntax.hs

@@ -2,14 +2,14 @@ module SimplifySyntax where
 
 import qualified Language.Haskell.Exts as Exts
 
-import Translate(qOpToExp)
+import Translate(qOpToExp, qNameToString)
 -- A simplified Haskell syntax tree
 
 -- rhs is now SimpExp
 
 -- A simplified Haskell expression.
 data SimpExp l =
-  SeName l (Exts.QName l)
+  SeName l String
   | SeLit l (Exts.Literal l)
   | SeApp l
     (SimpExp l)  -- function
@@ -41,7 +41,8 @@ data SimpPat l =
   | SpApp l (Exts.QName l) [SimpPat l]
   | SpAsPat l (Exts.Name l) (SimpPat l)
 
-infixAppToSeApp :: a -> Exts.Exp a -> Exts.QOp a -> Exts.Exp a -> SimpExp a
+infixAppToSeApp :: Show a =>
+  a -> Exts.Exp a -> Exts.QOp a -> Exts.Exp a -> SimpExp a
 infixAppToSeApp l e1 op e2 = case op of
   Exts.QVarOp _ (Exts.UnQual _ (Exts.Symbol _ sym)) -> case sym of
     "$" -> hsExpToSimpExp (Exts.App l e1 e2)
@@ -53,10 +54,34 @@ infixAppToSeApp l e1 op e2 = case op of
   where
     defaultCase = hsExpToSimpExp $ Exts.App l (Exts.App l (qOpToExp op) e1) e2
 
-hsExpToSimpExp :: Exts.Exp a -> SimpExp a
-hsExpToSimpExp e = case e of
-  Exts.Var l n -> SeName l n
-  Exts.Con l n -> SeName l n
+hsPatToSimpPat :: Exts.Pat a -> SimpPat a
+hsPatToSimpPat = undefined
+
+hsBindsToDecls :: Exts.Binds a -> [SimpDecl a]
+hsBindsToDecls = undefined
+
+hsAltToSimpAlt :: Exts.Alt a -> SimpAlt a
+hsAltToSimpAlt = undefined
+
+ifToGuard :: a -> SimpExp a -> SimpExp a -> SimpExp a -> SimpExp a
+ifToGuard l e1 e2 e3
+  = SeGuard l [SelectorAndVal{svSelector=e1, svVal=e2}
+              , SelectorAndVal{svSelector=otherwiseExp, svVal=e3}]
+  where
+    otherwiseExp = SeName l "otherwise"
+
+hsExpToSimpExp :: Show a => Exts.Exp a -> SimpExp a
+hsExpToSimpExp x = case x of
+  Exts.Var l n -> SeName l (qNameToString n)
+  Exts.Con l n -> SeName l (qNameToString n)
   Exts.Lit l n -> SeLit l n
   Exts.InfixApp l e1 op e2 -> infixAppToSeApp l e1 op e2
   Exts.App l f arg -> SeApp l (hsExpToSimpExp f) (hsExpToSimpExp arg)
+  Exts.Lambda l patterns e
+    -> SeLambda l (fmap hsPatToSimpPat patterns) (hsExpToSimpExp e)
+  Exts.Let l bs e -> SeLet l (hsBindsToDecls bs) (hsExpToSimpExp e)
+  Exts.If l e1 e2 e3
+    -> ifToGuard l (hsExpToSimpExp e1) (hsExpToSimpExp e2) (hsExpToSimpExp e3)
+  Exts.Case l e alts -> SeCase l (hsExpToSimpExp e) (fmap hsAltToSimpAlt alts)
+  Exts.Paren _ e -> hsExpToSimpExp e
+  _ -> error $ "Unsupported syntax in hsExpToSimpExp: " ++ show x

app/Translate.hs

@@ -3,7 +3,8 @@ module Translate(
   translateStringToSyntaxGraph,
   translateStringToCollapsedGraphAndDecl,
   translateModuleToCollapsedGraphs,
-  qOpToExp
+  qOpToExp,
+  qNameToString
 ) where
 
 import Diagrams.Prelude((<>))
@@ -495,7 +496,7 @@ evalBinds c (BDecls _ decls) =
     boundNames = concatMap getBoundVarName decls
     augmentedContext = boundNames <> c
   in
-    ((,augmentedContext) . mconcat) <$>  mapM (evalDecl augmentedContext) decls
+    (,augmentedContext) . mconcat <$> mapM (evalDecl augmentedContext) decls
 evalBinds _ binds = error $ "Unsupported syntax in evalBinds: " <> show binds
 
 evalGeneralLet :: Show l =>