Update stackage, fix warnings and format some app files with Ormolu.

app/Translate.hs

@@ -1,44 +1,85 @@
-{-# LANGUAGE NoMonomorphismRestriction, TupleSections #-}
-module Translate(
-  translateStringToSyntaxGraph,
+-- This file is formatted with Ormolu
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+module Translate
+  ( translateStringToSyntaxGraph,
     translateStringToCollapsedGraphAndDecl,
     translateModuleToCollapsedGraphs,
-  customParseDecl
-) where
-
-import Diagrams.Prelude((<>))
+    customParseDecl,
+  )
+where
 
 import Control.Monad (replicateM)
 import Control.Monad.State (State, evalState)
 import Data.Either (partitionEithers)
 import qualified Data.Graph.Inductive.PatriciaTree as FGR
-import Data.List(unzip5, partition, intercalate)
+import Data.List (intercalate, partition, unzip5)
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe, mapMaybe)
 import qualified Data.Set as Set
-
+import GraphAlgorithms (annotateGraph, collapseAnnotatedGraph)
+import Icons
+  ( argumentPorts,
+    casePatternPorts,
+    caseRhsPorts,
+    inputPort,
+    resultPort,
+  )
 import qualified Language.Haskell.Exts as Exts
 import qualified Language.Haskell.Exts.Pretty as PExts
-
-import GraphAlgorithms(annotateGraph, collapseAnnotatedGraph)
-import Icons(inputPort, resultPort, argumentPorts, caseRhsPorts,
-             casePatternPorts)
-import SimplifySyntax(SimpAlt(..), stringToSimpDecl, SimpExp(..), SimpPat(..)
-                     , qNameToString, nameToString, customParseDecl
-                     , SimpDecl(..), hsDeclToSimpDecl, SelectorAndVal(..))
-import TranslateCore(Reference, SyntaxGraph(..), EvalContext, GraphAndRef(..)
-                    , SgSink(..), syntaxGraphFromNodes
-                    , syntaxGraphFromNodesEdges, getUniqueName
-                    , edgesForRefPortList, makeApplyGraph, makeMultiIfGraph
-                    , combineExpressions, namesInPattern, lookupReference
-                    , deleteBindings, makeEdges, makeBox, syntaxGraphToFglGraph
-                    , getUniqueString, bindsToSyntaxGraph, SgBind(..)
-                    , graphAndRefToGraph, initialIdState)
-import Types(AnnotatedGraph, Labeled(..), NameAndPort(..), IDState,
-             Edge, SyntaxNode(..), NodeName, SgNamedNode,
-             LikeApplyFlavor(..), CaseOrMultiIfTag(..), Named(..)
-            , mkEmbedder)
-import Util(makeSimpleEdge, nameAndPort, justName)
+import SimplifySyntax
+  ( SelectorAndVal (..),
+    SimpAlt (..),
+    SimpDecl (..),
+    SimpExp (..),
+    SimpPat (..),
+    customParseDecl,
+    hsDeclToSimpDecl,
+    nameToString,
+    qNameToString,
+    stringToSimpDecl,
+  )
+import TranslateCore
+  ( EvalContext,
+    GraphAndRef (..),
+    Reference,
+    SgBind (..),
+    SgSink (..),
+    SyntaxGraph (..),
+    bindsToSyntaxGraph,
+    combineExpressions,
+    deleteBindings,
+    edgesForRefPortList,
+    getUniqueName,
+    getUniqueString,
+    graphAndRefToGraph,
+    initialIdState,
+    lookupReference,
+    makeApplyGraph,
+    makeBox,
+    makeEdges,
+    makeMultiIfGraph,
+    namesInPattern,
+    syntaxGraphFromNodes,
+    syntaxGraphFromNodesEdges,
+    syntaxGraphToFglGraph,
+  )
+import Types
+  ( AnnotatedGraph,
+    CaseOrMultiIfTag (..),
+    Edge,
+    IDState,
+    Labeled (..),
+    LikeApplyFlavor (..),
+    NameAndPort (..),
+    Named (..),
+    NodeName,
+    SgNamedNode,
+    SyntaxNode (..),
+    mkEmbedder,
+  )
+import Util (justName, makeSimpleEdge, nameAndPort)
 
 {-# ANN module "HLint: ignore Use record patterns" #-}
 
@@ -52,8 +93,8 @@ import Util(makeSimpleEdge, nameAndPort, justName)
 -- | Make a syntax graph that has the bindings for a list of "as pattern" (@)
 -- names.
 makeAsBindGraph :: Reference -> [Maybe String] -> SyntaxGraph
-makeAsBindGraph ref asNames
-  = bindsToSyntaxGraph $ mapMaybe makeBind asNames
+makeAsBindGraph ref asNames =
+  bindsToSyntaxGraph $ mapMaybe makeBind asNames
   where
     makeBind mName = case mName of
       Nothing -> Nothing
@@ -63,21 +104,21 @@ grNamePortToGrRef :: (SyntaxGraph, NameAndPort) -> GraphAndRef
 grNamePortToGrRef (graph, np) = GraphAndRef graph (Right np)
 
 -- TODO Find a better name for bindOrAltHelper
-bindOrAltHelper :: Show l =>
-  EvalContext
-  -> SimpPat l
-  -> SimpExp l
-  -> State IDState ((GraphAndRef, Maybe String), GraphAndRef)
+bindOrAltHelper ::
+  Show l =>
+  EvalContext ->
+  SimpPat l ->
+  SimpExp l ->
+  State IDState ((GraphAndRef, Maybe String), GraphAndRef)
 bindOrAltHelper c pat e = do
   patGraphAndRef <- evalPattern pat
-  let
-    rhsContext = namesInPattern patGraphAndRef <> c
+  let rhsContext = namesInPattern patGraphAndRef <> c
   rhsGraphAndRef <- evalExp rhsContext e
   pure (patGraphAndRef, rhsGraphAndRef)
 
-
 patternName :: (GraphAndRef, Maybe String) -> String
-patternName (GraphAndRef _ ref, mStr) = fromMaybe
+patternName (GraphAndRef _ ref, mStr) =
+  fromMaybe
     ( case ref of
         Left str -> str
         Right _ -> ""
@@ -118,10 +159,10 @@ asNameBind (GraphAndRef _ ref, mAsName) = case mAsName of
   Just asName -> Just $ SgBind asName ref
 
 patternArgumentMapper ::
-  ((GraphAndRef, Maybe String), t)
-  -> (String, Either (GraphAndRef, t) (SgNamedNode, SyntaxGraph))
-patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port)
-  = (patName, eitherVal)
+  ((GraphAndRef, Maybe String), t) ->
+  (String, Either (GraphAndRef, t) (SgNamedNode, SyntaxGraph))
+patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port) =
+  (patName, eitherVal)
   where
     graph = graphAndRefToGraph graphAndRef
     patName = patternName asGraphAndRef
@@ -130,38 +171,37 @@ patternArgumentMapper (asGraphAndRef@(graphAndRef, _), port)
       (SyntaxGraph [namedNode] [] _ _ _) -> Right (namedNode, graph)
       _ -> Left (graphAndRef, port)
 
-
 graphToTuple ::
-  SyntaxGraph
-  -> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
+  SyntaxGraph ->
+  ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
 graphToTuple (SyntaxGraph a b c d e) = (a, b, c, d, e)
 
 graphsToComponents ::
-  [SyntaxGraph]
-  -> ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
-graphsToComponents graphs
-  = (mconcat a, mconcat b, mconcat c, mconcat d, mconcat e)
+  [SyntaxGraph] ->
+  ([SgNamedNode], [Edge], [SgSink], [SgBind], Map.Map NodeName NodeName)
+graphsToComponents graphs =
+  (mconcat a, mconcat b, mconcat c, mconcat d, mconcat e)
   where
     (a, b, c, d, e) = unzip5 $ fmap graphToTuple graphs
 
 makeNestedPatternGraph ::
-  NodeName
-  -> String
-  -> [(GraphAndRef, Maybe String)]
-  -> (SyntaxGraph, NameAndPort)
+  NodeName ->
+  String ->
+  [(GraphAndRef, Maybe String)] ->
+  (SyntaxGraph, NameAndPort)
 makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
   where
     dummyNode = PatternApplyNode "" []
 
-    argsAndPorts
-      = zip argVals $ map (nameAndPort applyIconName) $ argumentPorts dummyNode
+    argsAndPorts =
+      zip argVals $ map (nameAndPort applyIconName) $ argumentPorts dummyNode
     mappedArgs = fmap patternArgumentMapper argsAndPorts
 
-    (unnestedArgsAndPort, nestedNamedNodesAndGraphs)
-      = partitionEithers (fmap snd mappedArgs)
+    (unnestedArgsAndPort, nestedNamedNodesAndGraphs) =
+      partitionEithers (fmap snd mappedArgs)
 
-    (nestedArgs, _, nestedSinks, nestedBinds, nestedEMaps)
-      = graphsToComponents $ fmap snd nestedNamedNodesAndGraphs
+    (nestedArgs, _, nestedSinks, nestedBinds, nestedEMaps) =
+      graphsToComponents $ fmap snd nestedNamedNodesAndGraphs
 
     argListMapper (str, arg) = case arg of
       Left _ -> Labeled Nothing str
@@ -177,24 +217,28 @@ makeNestedPatternGraph applyIconName funStr argVals = nestedApplyResult
     asNameBinds = mapMaybe asNameBind argVals
     allBinds = nestedBinds <> asNameBinds
 
-    newEMap = Map.fromList
+    newEMap =
+      Map.fromList
         ((\(Named n _) -> (n, applyIconName)) <$> nestedArgs)
         <> nestedEMaps
 
-    newGraph = SyntaxGraph
+    newGraph =
+      SyntaxGraph
         icons
         []
         nestedSinks
         allBinds
         newEMap
-    nestedApplyResult = (newGraph <> combinedGraph
-                        , nameAndPort applyIconName (resultPort pAppNode))
+    nestedApplyResult =
+      ( newGraph <> combinedGraph,
+        nameAndPort applyIconName (resultPort pAppNode)
+      )
 
-
-evalPApp :: Show l =>
-  Exts.QName l
-  -> [SimpPat l]
-  -> State IDState (SyntaxGraph, NameAndPort)
+evalPApp ::
+  Show l =>
+  Exts.QName l ->
+  [SimpPat l] ->
+  State IDState (SyntaxGraph, NameAndPort)
 evalPApp name patterns = case patterns of
   [] -> makeBox constructorName
   _ -> do
@@ -226,22 +270,29 @@ evalPLit ::
 evalPLit sign l = case sign of
   Exts.Signless _ -> evalLit l
   Exts.Negative _ -> makeBox ('-' : showLiteral l)
+
 -- END evalPLit
 
-evalPAsPat :: Show l =>
-  Exts.Name l -> SimpPat l -> State IDState (GraphAndRef, Maybe String)
+evalPAsPat ::
+  Show l =>
+  Exts.Name l ->
+  SimpPat l ->
+  State IDState (GraphAndRef, Maybe String)
 evalPAsPat n p = do
   (GraphAndRef evaledPatGraph evaledPatRef, mInnerName) <- evalPattern p
-  let
-    outerName = nameToString n
+  let outerName = nameToString n
       asBindGraph = makeAsBindGraph (Left outerName) [mInnerName]
-  pure (GraphAndRef (asBindGraph <> evaledPatGraph) evaledPatRef
-       , Just outerName)
+  pure
+    ( GraphAndRef (asBindGraph <> evaledPatGraph) evaledPatRef,
+      Just outerName
+    )
 
-makePatternResult :: Functor f =>
-  f (SyntaxGraph, NameAndPort) -> f (GraphAndRef, Maybe String)
-makePatternResult
-  = fmap (\(graph, namePort) -> (GraphAndRef graph (Right namePort), Nothing))
+makePatternResult ::
+  Functor f =>
+  f (SyntaxGraph, NameAndPort) ->
+  f (GraphAndRef, Maybe String)
+makePatternResult =
+  fmap (\(graph, namePort) -> (GraphAndRef graph (Right namePort), Nothing))
 
 evalPattern :: Show l => SimpPat l -> State IDState (GraphAndRef, Maybe String)
 evalPattern p = case p of
@@ -250,6 +301,7 @@ evalPattern p = case p of
   SpApp _ name patterns -> makePatternResult $ evalPApp name patterns
   SpAsPat _ name pat -> evalPAsPat name pat
   SpWildCard _ -> makePatternResult $ makeBox "_"
+
 -- _ -> error ("evalPattern todo: " <> show p)
 
 -- END evalPattern
@@ -258,8 +310,10 @@ evalPattern p = case p of
 
 -- strToGraphRef is not in TranslateCore, since it is only used by evalQName.
 strToGraphRef :: EvalContext -> String -> State IDState GraphAndRef
-strToGraphRef c str = fmap mapper (makeBox str) where
-  mapper gr = if str `elem` c
+strToGraphRef c str = fmap mapper (makeBox str)
+  where
+    mapper gr =
+      if str `elem` c
         then GraphAndRef mempty (Left str)
         else grNamePortToGrRef gr
 
@@ -267,28 +321,33 @@ strToGraphRef c str = fmap mapper (makeBox str) where
 
 -- BEGIN apply and compose helper functions
 
-evalFunExpAndArgs :: Show l =>
-  EvalContext
-  -> LikeApplyFlavor
-  -> (SimpExp l, [SimpExp l])
-  -> State IDState (SyntaxGraph, NameAndPort)
+evalFunExpAndArgs ::
+  Show l =>
+  EvalContext ->
+  LikeApplyFlavor ->
+  (SimpExp l, [SimpExp l]) ->
+  State IDState (SyntaxGraph, NameAndPort)
 evalFunExpAndArgs c flavor (funExp, argExps) = do
   funVal <- evalExp c funExp
   argVals <- mapM (evalExp c) argExps
   applyIconName <- getUniqueName
-  pure
-    $ makeApplyGraph (length argExps) flavor False applyIconName funVal argVals
+  pure $
+    makeApplyGraph (length argExps) flavor False applyIconName funVal argVals
 
 -- END apply and compose helper functions
 
-evalFunctionComposition :: Show l =>
-  EvalContext -> [SimpExp l] -> State IDState (SyntaxGraph, NameAndPort)
+evalFunctionComposition ::
+  Show l =>
+  EvalContext ->
+  [SimpExp l] ->
+  State IDState (SyntaxGraph, NameAndPort)
 evalFunctionComposition c functions = do
   let reversedFunctios = reverse functions
   evaluatedFunctions <- mapM (evalExp c) reversedFunctios
   neverUsedPort <- Left <$> getUniqueString "unusedArgument"
   applyIconName <- getUniqueName
-  pure $ makeApplyGraph
+  pure $
+    makeApplyGraph
       (length evaluatedFunctions)
       ComposeNodeFlavor
       False
@@ -299,8 +358,8 @@ evalFunctionComposition c functions = do
 -- | Turn (a . b . c) into [a, b, c]
 compositionToList :: SimpExp l -> [SimpExp l]
 compositionToList e = case e of
-  (SeApp _ (SeApp _ (SeName  _ ".") f1) f2)
-    -> f1 : compositionToList f2
+  (SeApp _ (SeApp _ (SeName _ ".") f1) f2) ->
+    f1 : compositionToList f2
   x -> [x]
 
 -- BEGIN evaluateAppExpression
@@ -309,7 +368,8 @@ compositionToList e = case e of
 -- return the nesting depth if (f x) is rendered with
 -- the (normal apply icon, compose apply icon)
 applyComposeScoreHelper :: SimpExp l -> SimpExp l -> (Int, Int)
-applyComposeScoreHelper exp1 exp2 = (appScore, compScore) where
+applyComposeScoreHelper exp1 exp2 = (appScore, compScore)
+  where
     (e1App, e1Comp) = applyComposeScore exp1
     (e2App, e2Comp) = applyComposeScore exp2
 
@@ -323,8 +383,8 @@ applyComposeScoreHelper exp1 exp2 = (appScore, compScore) where
 
     compScore = max leftComp rightComp
 
-
 -- TODO Consider putting this logic in a separate "simplifyExpression" function.
+
 -- | Returns the amount of nesting if the App is converted to
 -- (applyNode, composeNode)
 applyComposeScore :: SimpExp l -> (Int, Int)
@@ -333,6 +393,7 @@ applyComposeScore e = case e of
   _ -> (0, 0)
 
 -- Todo add test for this function
+
 -- | Given an App expression, return
 -- (function, list of arguments)
 appExpToFuncArgs :: SimpExp l -> (SimpExp l, [SimpExp l])
@@ -351,16 +412,18 @@ appExpToArgFuncs e = case e of
       (argExp, funcs) = appExpToArgFuncs exp2
   simpleExp -> (simpleExp, [])
 
-
 -- TODO Refactor this and all sub-expressions
-evalApp :: Show l =>
-  EvalContext -> SimpExp l
-  -> State IDState (SyntaxGraph, NameAndPort)
+evalApp ::
+  Show l =>
+  EvalContext ->
+  SimpExp l ->
+  State IDState (SyntaxGraph, NameAndPort)
 evalApp c expr = case expr of
   -- TODO This pattern for "." appears at least twice in this file. Refactor?
-  (SeApp _ (SeApp _ (SeName  _ ".") _) _)
-    -> evalFunctionComposition c (compositionToList expr)
-  _ -> if appScore <= compScore
+  (SeApp _ (SeApp _ (SeName _ ".") _) _) ->
+    evalFunctionComposition c (compositionToList expr)
+  _ ->
+    if appScore <= compScore
       then evalFunExpAndArgs c ApplyNodeFlavor (appExpToFuncArgs expr)
       else evalFunExpAndArgs c ComposeNodeFlavor (appExpToArgFuncs expr)
     where
@@ -372,93 +435,104 @@ evalApp c expr = case expr of
 
 getBoundVarName :: Show l => SimpDecl l -> [String]
 getBoundVarName d = case d of
-  SdPatBind _ pat _ -> namesInPattern
+  SdPatBind _ pat _ ->
+    namesInPattern
     -- TODO Should evalState be used here?
-                     $ evalState (evalPattern pat) initialIdState
+    $
+      evalState (evalPattern pat) initialIdState
   SdTypeSig _ _ _ -> []
   SdCatchAll _ -> []
 
-evalDecls :: Show l =>
-  EvalContext -> [SimpDecl l] -> State IDState (SyntaxGraph, EvalContext)
+evalDecls ::
+  Show l =>
+  EvalContext ->
+  [SimpDecl l] ->
+  State IDState (SyntaxGraph, EvalContext)
 evalDecls c decls =
-  let
-    boundNames = concatMap getBoundVarName decls
+  let boundNames = concatMap getBoundVarName decls
       augmentedContext = boundNames <> c
-  in
-    (,augmentedContext) . mconcat <$> mapM (evalDecl augmentedContext) decls
+   in (,augmentedContext) . mconcat <$> mapM (evalDecl augmentedContext) decls
 
-evalLet :: Show l =>
-  EvalContext
-  -> [SimpDecl l]
-  -> SimpExp l
-  -> State IDState GraphAndRef
+evalLet ::
+  Show l =>
+  EvalContext ->
+  [SimpDecl l] ->
+  SimpExp l ->
+  State IDState GraphAndRef
 evalLet c decls expr = do
   (bindGraph, bindContext) <- evalDecls c decls
   expVal <- evalExp bindContext expr
-  let
-    GraphAndRef expGraph expResult = expVal
+  let GraphAndRef expGraph expResult = expVal
       newGraph = deleteBindings . makeEdges $ expGraph <> bindGraph
       bindings = sgBinds bindGraph
   pure $ GraphAndRef newGraph (lookupReference bindings expResult)
 
 -- END evalGeneralLet
 
-evalSelectorAndVal :: Show l =>
-  EvalContext -> SelectorAndVal l -> State IDState (GraphAndRef, GraphAndRef)
-evalSelectorAndVal c SelectorAndVal{svSelector=sel, svVal=val}
-  = (,) <$> evalExp c sel <*> evalExp c val
+evalSelectorAndVal ::
+  Show l =>
+  EvalContext ->
+  SelectorAndVal l ->
+  State IDState (GraphAndRef, GraphAndRef)
+evalSelectorAndVal c SelectorAndVal {svSelector = sel, svVal = val} =
+  (,) <$> evalExp c sel <*> evalExp c val
 
-evalMultiIf :: Show l =>
-  EvalContext -> [SelectorAndVal l] -> State IDState (SyntaxGraph, NameAndPort)
-evalMultiIf c selectorsAndVals = let
-  evaledRhss = unzip <$> mapM (evalSelectorAndVal c) selectorsAndVals
-  in
-  makeMultiIfGraph (length selectorsAndVals)
-  <$>
-  getUniqueName
-  <*>
-  fmap fst evaledRhss
-  <*>
-  fmap snd evaledRhss
+evalMultiIf ::
+  Show l =>
+  EvalContext ->
+  [SelectorAndVal l] ->
+  State IDState (SyntaxGraph, NameAndPort)
+evalMultiIf c selectorsAndVals =
+  let evaledRhss = unzip <$> mapM (evalSelectorAndVal c) selectorsAndVals
+   in makeMultiIfGraph (length selectorsAndVals)
+        <$> getUniqueName
+        <*> fmap fst evaledRhss
+        <*> fmap snd evaledRhss
 
 -- BEGIN evalCase
 
 -- TODO patRhsAreConnected is sometimes incorrectly true if the pat is just a
 -- name
 -- returns (combined graph, pattern reference, rhs reference)
-evalAlt :: Show l =>
-  EvalContext
-  -> SimpAlt l
-  -> State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
+evalAlt ::
+  Show l =>
+  EvalContext ->
+  SimpAlt l ->
+  State IDState (Bool, SyntaxGraph, Reference, Reference, Maybe String)
 evalAlt c (SimpAlt pat rhs) = do
   ((GraphAndRef patGraph patRef, mPatAsName), GraphAndRef rhsGraph rhsRef) <-
     bindOrAltHelper c pat rhs
-  let
-    grWithEdges = makeEdges (rhsGraph <> patGraph)
+  let grWithEdges = makeEdges (rhsGraph <> patGraph)
       lookedUpRhsRef = lookupReference (sgBinds grWithEdges) rhsRef
       -- The pattern and rhs are conneted if makeEdges added extra edges, or if
       -- the rhsRef refers to a source in the pattern.
-    patRhsAreConnected
-      = (rhsRef /= lookedUpRhsRef)
+      patRhsAreConnected =
+        (rhsRef /= lookedUpRhsRef)
           || ( length (sgEdges grWithEdges)
-             >
-             (length (sgEdges rhsGraph) + length (sgEdges patGraph)))
-  pure (patRhsAreConnected
-       , deleteBindings grWithEdges
-       , patRef
-       , lookedUpRhsRef
-       , mPatAsName)
+                 > (length (sgEdges rhsGraph) + length (sgEdges patGraph))
+             )
+  pure
+    ( patRhsAreConnected,
+      deleteBindings grWithEdges,
+      patRef,
+      lookedUpRhsRef,
+      mPatAsName
+    )
 
 evalCaseHelper ::
-  Int
-  -> NodeName
-  -> [NodeName]
-  -> GraphAndRef
-  -> [(Bool, SyntaxGraph, Reference, Reference, Maybe String)]
-  -> (SyntaxGraph, NameAndPort)
-evalCaseHelper numAlts caseIconName resultIconNames
-  (GraphAndRef expGraph expRef) evaledAlts
-  = result
+  Int ->
+  NodeName ->
+  [NodeName] ->
+  GraphAndRef ->
+  [(Bool, SyntaxGraph, Reference, Reference, Maybe String)] ->
+  (SyntaxGraph, NameAndPort)
+evalCaseHelper
+  numAlts
+  caseIconName
+  resultIconNames
+  (GraphAndRef expGraph expRef)
+  evaledAlts =
+    result
     where
       (patRhsConnected, altGraphs, patRefs, rhsRefs, asNames) = unzip5 evaledAlts
       combindedAltGraph = mconcat altGraphs
@@ -467,8 +541,10 @@ evalCaseHelper numAlts caseIconName resultIconNames
       caseGraph = syntaxGraphFromNodes icons
       expEdge = (expRef, nameAndPort caseIconName (inputPort caseNode))
       patEdges = zip patRefs $ map (nameAndPort caseIconName) casePatternPorts
-    rhsEdges = zip patRhsConnected $ zip rhsRefs
-               $ map (nameAndPort caseIconName) caseRhsPorts
+      rhsEdges =
+        zip patRhsConnected $
+          zip rhsRefs $
+            map (nameAndPort caseIconName) caseRhsPorts
       (connectedRhss, unConnectedRhss) = partition fst rhsEdges
 
       makeCaseResult :: NodeName -> Reference -> SyntaxGraph
@@ -480,40 +556,41 @@ evalCaseHelper numAlts caseIconName resultIconNames
             rhsNewEdges = [makeSimpleEdge (rhsPort, justName resultIconName)]
 
       caseResultGraphs =
-      mconcat
-      $ zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
+        mconcat $
+          zipWith makeCaseResult resultIconNames (fmap (fst . snd) connectedRhss)
       filteredRhsEdges = fmap snd unConnectedRhss
       patternEdgesGraph = edgesForRefPortList True patEdges
       caseEdgeGraph = edgesForRefPortList False (expEdge : filteredRhsEdges)
 
       bindGraph = makeAsBindGraph expRef asNames
 
-    finalGraph = deleteBindings $ makeEdges $ mconcat [bindGraph
-                                                      , patternEdgesGraph
-                                                      , caseResultGraphs
-                                                      , expGraph
-                                                      , caseEdgeGraph
-                                                      , caseGraph
-                                                      , combindedAltGraph]
+      finalGraph =
+        deleteBindings $
+          makeEdges $
+            mconcat
+              [ bindGraph,
+                patternEdgesGraph,
+                caseResultGraphs,
+                expGraph,
+                caseEdgeGraph,
+                caseGraph,
+                combindedAltGraph
+              ]
       result = (finalGraph, nameAndPort caseIconName (resultPort caseNode))
 
-
-evalCase :: Show l =>
-  EvalContext -> SimpExp l -> [SimpAlt l]
-  -> State IDState (SyntaxGraph, NameAndPort)
+evalCase ::
+  Show l =>
+  EvalContext ->
+  SimpExp l ->
+  [SimpAlt l] ->
+  State IDState (SyntaxGraph, NameAndPort)
 evalCase c e alts =
-  let
-    numAlts = length alts
-  in
-    evalCaseHelper (length alts)
-    <$>
-    getUniqueName
-    <*>
-    replicateM numAlts getUniqueName
-    <*>
-    evalExp c e
-    <*>
-    mapM (evalAlt c) alts
+  let numAlts = length alts
+   in evalCaseHelper (length alts)
+        <$> getUniqueName
+        <*> replicateM numAlts getUniqueName
+        <*> evalExp c e
+        <*> mapM (evalAlt c) alts
 
 -- END evalCase
 
@@ -524,22 +601,21 @@ asBindGraphZipper :: Maybe String -> NameAndPort -> SyntaxGraph
 asBindGraphZipper asName nameNPort = makeAsBindGraph (Right nameNPort) [asName]
 
 -- TODO Refactor evalLambda
-evalLambda :: Show l
-  => l
-  -> EvalContext
-  -> [SimpPat l]
-  -> SimpExp l
-  -> State IDState (SyntaxGraph, NameAndPort)
+evalLambda ::
+  Show l =>
+  l ->
+  EvalContext ->
+  [SimpPat l] ->
+  SimpExp l ->
+  State IDState (SyntaxGraph, NameAndPort)
 evalLambda _ context patterns expr = do
   lambdaName <- getUniqueName
   patternValsWithAsNames <- mapM evalPattern patterns
-  let
-    patternVals = fmap fst patternValsWithAsNames
+  let patternVals = fmap fst patternValsWithAsNames
       patternStrings = concatMap namesInPattern patternValsWithAsNames
       rhsContext = patternStrings <> context
   GraphAndRef rhsRawGraph rhsRef <- evalExp rhsContext expr
-  let
-    paramNames = fmap patternName patternValsWithAsNames
+  let paramNames = fmap patternName patternValsWithAsNames
       enclosedNodeNames = Set.fromList $ naName <$> sgNodes combinedGraph
       lambdaNode = FunctionDefNode paramNames enclosedNodeNames
       lambdaPorts = map (nameAndPort lambdaName) $ argumentPorts lambdaNode
@@ -556,12 +632,15 @@ evalLambda _ context patterns expr = do
           (makeSimpleEdge (rhsPort, returnPort) : patternEdges, mempty)
       finalGraph = SyntaxGraph icons newEdges newSinks newBinds mempty
 
-    asBindGraph = mconcat $ zipWith
+      asBindGraph =
+        mconcat $
+          zipWith
             asBindGraphZipper
             (fmap snd patternValsWithAsNames)
             lambdaPorts
-    combinedGraph = deleteBindings . makeEdges
-                    $ (asBindGraph <> rhsRawGraph <> patternGraph <> finalGraph)
+      combinedGraph =
+        deleteBindings . makeEdges $
+          (asBindGraph <> rhsRawGraph <> patternGraph <> finalGraph)
 
   pure (combinedGraph, nameAndPort lambdaName (resultPort lambdaNode))
   where
@@ -584,18 +663,22 @@ evalExp c x = case x of
   SeLambda l patterns e -> grNamePortToGrRef <$> evalLambda l c patterns e
   SeLet _ decls expr -> evalLet c decls expr
   SeCase _ expr alts -> grNamePortToGrRef <$> evalCase c expr alts
-  SeMultiIf _ selectorsAndVals
-    -> grNamePortToGrRef <$> evalMultiIf c selectorsAndVals
+  SeMultiIf _ selectorsAndVals ->
+    grNamePortToGrRef <$> evalMultiIf c selectorsAndVals
 
 -- BEGIN evalDecl
 
-evalPatBind :: Show l =>
-  l -> EvalContext -> SimpPat l -> SimpExp l -> State IDState SyntaxGraph
+evalPatBind ::
+  Show l =>
+  l ->
+  EvalContext ->
+  SimpPat l ->
+  SimpExp l ->
+  State IDState SyntaxGraph
 evalPatBind _ c pat e = do
   ((GraphAndRef patGraph patRef, mPatAsName), GraphAndRef rhsGraph rhsRef) <-
     bindOrAltHelper c pat e
-  let
-    (newEdges, newSinks, bindings) = case patRef of
+  let (newEdges, newSinks, bindings) = case patRef of
         (Left s) -> (mempty, mempty, [SgBind s rhsRef])
         (Right patPort) -> case rhsRef of
           (Left rhsStr) -> (mempty, [SgSink rhsStr patPort], mempty)
@@ -606,13 +689,17 @@ evalPatBind _ c pat e = do
 
 -- Pretty printing the entire type sig results in extra whitespace in the middle
 -- TODO May want to trim whitespace from (prettyPrint typeForNames)
-evalTypeSig :: Show l =>
-  [Exts.Name l] -> Exts.Type l
-  -> State IDState (SyntaxGraph, NameAndPort)
-evalTypeSig names typeForNames = makeBox
+evalTypeSig ::
+  Show l =>
+  [Exts.Name l] ->
+  Exts.Type l ->
+  State IDState (SyntaxGraph, NameAndPort)
+evalTypeSig names typeForNames =
+  makeBox
     ( intercalate "," (fmap prettyPrintWithoutNewlines names)
         ++ " :: "
-   ++ prettyPrintWithoutNewlines typeForNames)
+        ++ prettyPrintWithoutNewlines typeForNames
+    )
   where
     -- TODO Make custom version of prettyPrint for type signitures.
     -- Use (unwords . words) to convert consecutive whitspace characters to one
@@ -631,13 +718,11 @@ evalDecl c d = case d of
 
 showTopLevelBinds :: SyntaxGraph -> State IDState SyntaxGraph
 showTopLevelBinds gr = do
-  let
-    binds = sgBinds gr
+  let binds = sgBinds gr
       addBind (SgBind _ (Left _)) = pure mempty
       addBind (SgBind patName (Right port)) = do
         uniquePatName <- getUniqueName
-      let
-        icons = [Named uniquePatName $ mkEmbedder (BindNameNode patName)]
+        let icons = [Named uniquePatName $ mkEmbedder (BindNameNode patName)]
             edges = [makeSimpleEdge (port, justName uniquePatName)]
             edgeGraph = syntaxGraphFromNodesEdges icons edges
         pure edgeGraph
@@ -645,7 +730,8 @@ showTopLevelBinds gr = do
   pure $ newGraph <> gr
 
 translateDeclToSyntaxGraph :: Show l => SimpDecl l -> SyntaxGraph
-translateDeclToSyntaxGraph d = graph where
+translateDeclToSyntaxGraph d = graph
+  where
     evaluatedDecl = evalDecl mempty d >>= showTopLevelBinds
     graph = evalState evaluatedDecl initialIdState
 
@@ -654,27 +740,32 @@ translateStringToSyntaxGraph :: String -> SyntaxGraph
 translateStringToSyntaxGraph = translateDeclToSyntaxGraph . stringToSimpDecl
 
 syntaxGraphToCollapsedGraph :: SyntaxGraph -> AnnotatedGraph FGR.Gr
-syntaxGraphToCollapsedGraph
-  = collapseAnnotatedGraph . annotateGraph . syntaxGraphToFglGraph
+syntaxGraphToCollapsedGraph =
+  collapseAnnotatedGraph . annotateGraph . syntaxGraphToFglGraph
+
 -- = annotateGraph . syntaxGraphToFglGraph
 
 translateDeclToCollapsedGraph :: Show l => Exts.Decl l -> AnnotatedGraph FGR.Gr
-translateDeclToCollapsedGraph
-  = syntaxGraphToCollapsedGraph . translateDeclToSyntaxGraph . hsDeclToSimpDecl
+translateDeclToCollapsedGraph =
+  syntaxGraphToCollapsedGraph . translateDeclToSyntaxGraph . hsDeclToSimpDecl
 
 -- Profiling: At one point, this was about 1.5% of total time.
 translateStringToCollapsedGraphAndDecl ::
   String -> (AnnotatedGraph FGR.Gr, Exts.Decl Exts.SrcSpanInfo)
-translateStringToCollapsedGraphAndDecl s = (drawing, decl) where
+translateStringToCollapsedGraphAndDecl s = (drawing, decl)
+  where
     decl = customParseDecl s -- :: ParseResult Module
     drawing = translateDeclToCollapsedGraph decl
 
-translateModuleToCollapsedGraphs :: Show l =>
-  Exts.Module l -> [AnnotatedGraph FGR.Gr]
-translateModuleToCollapsedGraphs (Exts.Module _ _ _ _ decls)
-  = fmap translateDeclToCollapsedGraph decls
-translateModuleToCollapsedGraphs moduleSyntax
-  = error $ "Unsupported syntax in translateModuleToCollapsedGraphs: "
+translateModuleToCollapsedGraphs ::
+  Show l =>
+  Exts.Module l ->
+  [AnnotatedGraph FGR.Gr]
+translateModuleToCollapsedGraphs (Exts.Module _ _ _ _ decls) =
+  fmap translateDeclToCollapsedGraph decls
+translateModuleToCollapsedGraphs moduleSyntax =
+  error $
+    "Unsupported syntax in translateModuleToCollapsedGraphs: "
       <> show moduleSyntax
 
 -- END Exported functions

app/TranslateCore.hs

@@ -1,5 +1,6 @@
-module TranslateCore(
-  Reference,
+-- This file is formatted with Ormolu
+module TranslateCore
+  ( Reference,
     SyntaxGraph (..),
     EvalContext,
     GraphAndRef (..),
@@ -25,8 +26,9 @@ module TranslateCore(
     nListString,
     syntaxGraphToFglGraph,
     nodeToIcon,
-  initialIdState
-) where
+    initialIdState,
+  )
+where
 
 import Control.Monad.State (State, state)
 import Data.Either (partitionEithers)
@@ -34,18 +36,39 @@ import qualified Data.Graph.Inductive.Graph as ING
 import qualified Data.Graph.Inductive.PatriciaTree as FGR
 import Data.List (find)
 import qualified Data.Map as Map
-import Data.Semigroup(Semigroup, (<>))
 import qualified Data.Set as Set
-
-import Icons(inputPort, resultPort, argumentPorts, multiIfRhsPorts
-            , multiIfBoolPorts)
-import Types(Labeled(..), Icon(..), SyntaxNode(..), Edge(..), EdgeOption(..)
-            , NameAndPort(..), IDState, SgNamedNode, NodeName(..), Port
-            , LikeApplyFlavor(..), CaseOrMultiIfTag(..), IDState(..)
-            , Embedder(..), mkEmbedder, Named(..)
-            , EmbedderSyntaxNode)
-import Util(nameAndPort, makeSimpleEdge, justName, maybeBoolToBool
-           , nodeNameToInt)
+import Icons
+  ( argumentPorts,
+    inputPort,
+    multiIfBoolPorts,
+    multiIfRhsPorts,
+    resultPort,
+  )
+import Types
+  ( CaseOrMultiIfTag (..),
+    Edge (..),
+    EdgeOption (..),
+    Embedder (..),
+    EmbedderSyntaxNode,
+    IDState (..),
+    Icon (..),
+    Labeled (..),
+    LikeApplyFlavor (..),
+    NameAndPort (..),
+    Named (..),
+    NodeName (..),
+    Port,
+    SgNamedNode,
+    SyntaxNode (..),
+    mkEmbedder,
+  )
+import Util
+  ( justName,
+    makeSimpleEdge,
+    maybeBoolToBool,
+    nameAndPort,
+    nodeNameToInt,
+  )
 
 {-# ANN module "HLint: ignore Use list comprehension" #-}
 
@@ -63,23 +86,25 @@ data SgBind = SgBind String Reference deriving (Eq, Show, Ord)
 data SgSink = SgSink String NameAndPort deriving (Eq, Ord, Show)
 
 -- TODO Replace lists with sets
+
 -- | A SyntaxGraph is an abstract representation of Haskell syntax. SyntaxGraphs
 -- are generated from the Haskell syntax tree and are used to generate Drawings.
-data SyntaxGraph = SyntaxGraph {
-  sgNodes :: [SgNamedNode],
+data SyntaxGraph = SyntaxGraph
+  { sgNodes :: [SgNamedNode],
     sgEdges :: [Edge],
     sgSinks :: [SgSink],
     sgBinds :: [SgBind],
     -- sgEmbedMap keeps track of nodes embedded in other nodes. If (child, parent)
     -- is in the Map, then child is embedded inside parent.
     sgEmbedMap :: Map.Map NodeName NodeName
-  } deriving (Show, Eq)
+  }
+  deriving (Show, Eq)
 
 instance Semigroup SyntaxGraph where
   (<>)
     (SyntaxGraph icons1 edges1 sinks1 sources1 map1)
-    (SyntaxGraph icons2 edges2 sinks2 sources2 map2)
-    = SyntaxGraph
+    (SyntaxGraph icons2 edges2 sinks2 sources2 map2) =
+      SyntaxGraph
         (icons1 <> icons2)
         (edges1 <> edges2)
         (sinks1 <> sinks2)
@@ -104,8 +129,8 @@ syntaxGraphFromNodes :: [SgNamedNode] -> SyntaxGraph
 syntaxGraphFromNodes icons = SyntaxGraph icons mempty mempty mempty mempty
 
 syntaxGraphFromNodesEdges :: [SgNamedNode] -> [Edge] -> SyntaxGraph
-syntaxGraphFromNodesEdges icons edges
-  = SyntaxGraph icons edges mempty mempty mempty
+syntaxGraphFromNodesEdges icons edges =
+  SyntaxGraph icons edges mempty mempty mempty
 
 bindsToSyntaxGraph :: [SgBind] -> SyntaxGraph
 bindsToSyntaxGraph binds = SyntaxGraph mempty mempty mempty binds mempty
@@ -127,10 +152,13 @@ initialIdState :: IDState
 initialIdState = IDState 0
 
 getId :: State IDState Int
-getId = state incrementer where
-  incrementer (IDState x) = (x, IDState checkedIncrement) where
+getId = state incrementer
+  where
+    incrementer (IDState x) = (x, IDState checkedIncrement)
+      where
         xPlusOne = x + 1
-    checkedIncrement = if xPlusOne > x
+        checkedIncrement =
+          if xPlusOne > x
             then xPlusOne
             else error "getId: the ID state has overflowed."
 
@@ -145,63 +173,68 @@ getUniqueString base = fmap ((base ++). show) getId
 
 -- TODO: Refactor with combineExpressions
 edgesForRefPortList :: Bool -> [(Reference, NameAndPort)] -> SyntaxGraph
-edgesForRefPortList inPattern portExpPairs
-  = mconcat $ fmap makeGraph portExpPairs
+edgesForRefPortList inPattern portExpPairs =
+  mconcat $ fmap makeGraph portExpPairs
   where
     edgeOpts = if inPattern then [EdgeInPattern] else []
     makeGraph (ref, port) = case ref of
-      Left str -> if inPattern
+      Left str ->
+        if inPattern
           then bindsToSyntaxGraph [SgBind str (Right port)]
           else sinksToSyntaxGraph [SgSink str port]
       Right resPort -> edgesToSyntaxGraph [Edge edgeOpts connection]
         where
-          connection = if inPattern
-                          -- If in a pattern, then the port on the case icon is
+          connection =
+            if inPattern
+              then -- If in a pattern, then the port on the case icon is
               -- the data source.
-                       then (port, resPort)
+                (port, resPort)
               else (resPort, port)
 
 combineExpressions :: Bool -> [(GraphAndRef, NameAndPort)] -> SyntaxGraph
-combineExpressions inPattern portExpPairs
-  = mconcat $ fmap makeGraph portExpPairs
+combineExpressions inPattern portExpPairs =
+  mconcat $ fmap makeGraph portExpPairs
   where
     edgeOpts = if inPattern then [EdgeInPattern] else []
-    makeGraph (GraphAndRef graph ref, port) = graph <> case ref of
-      Left str -> if inPattern
+    makeGraph (GraphAndRef graph ref, port) =
+      graph <> case ref of
+        Left str ->
+          if inPattern
             then bindsToSyntaxGraph [SgBind str (Right port)]
             else sinksToSyntaxGraph [SgSink str port]
         Right resPort -> edgesToSyntaxGraph [Edge edgeOpts (resPort, port)]
 
 makeApplyGraph ::
-  Int
-  -> LikeApplyFlavor
-  -> Bool
-  -> NodeName
-  -> GraphAndRef
-  -> [GraphAndRef]
-  -> (SyntaxGraph, NameAndPort)
-makeApplyGraph numArgs applyFlavor inPattern applyIconName funVal argVals
-  = (newGraph <> combinedGraph
-    , nameAndPort applyIconName (resultPort applyNode)
+  Int ->
+  LikeApplyFlavor ->
+  Bool ->
+  NodeName ->
+  GraphAndRef ->
+  [GraphAndRef] ->
+  (SyntaxGraph, NameAndPort)
+makeApplyGraph numArgs applyFlavor inPattern applyIconName funVal argVals =
+  ( newGraph <> combinedGraph,
+    nameAndPort applyIconName (resultPort applyNode)
   )
   where
     applyNode = ApplyNode applyFlavor numArgs
-    argumentNamePorts
-      = map (nameAndPort applyIconName) (argumentPorts applyNode)
+    argumentNamePorts =
+      map (nameAndPort applyIconName) (argumentPorts applyNode)
     functionPort = nameAndPort applyIconName (inputPort applyNode)
-    combinedGraph = combineExpressions inPattern
-                    $ zip (funVal:argVals) (functionPort:argumentNamePorts)
+    combinedGraph =
+      combineExpressions inPattern $
+        zip (funVal : argVals) (functionPort : argumentNamePorts)
     icons = [Named applyIconName (mkEmbedder applyNode)]
     newGraph = syntaxGraphFromNodes icons
 
 makeMultiIfGraph ::
-  Int
-  -> NodeName
-  -> [GraphAndRef]
-  -> [GraphAndRef]
-  -> (SyntaxGraph, NameAndPort)
-makeMultiIfGraph numPairs multiIfName bools exps
-  = (newGraph, nameAndPort multiIfName (resultPort multiIfNode))
+  Int ->
+  NodeName ->
+  [GraphAndRef] ->
+  [GraphAndRef] ->
+  (SyntaxGraph, NameAndPort)
+makeMultiIfGraph numPairs multiIfName bools exps =
+  (newGraph, nameAndPort multiIfName (resultPort multiIfNode))
   where
     multiIfNode = CaseOrMultiIfNode MultiIfTag numPairs
     expsWithPorts = zip exps $ map (nameAndPort multiIfName) multiIfRhsPorts
@@ -226,7 +259,8 @@ namesInPattern (graphAndRef, mName) = case mName of
 -- TODO: Might want to present some indication if there is a reference cycle.
 lookupReference :: [SgBind] -> Reference -> Reference
 lookupReference _ ref@(Right _) = ref
-lookupReference bindings ref@(Left originalS) = lookupHelper ref where
+lookupReference bindings ref@(Left originalS) = lookupHelper ref
+  where
     lookupHelper newRef@(Right _) = newRef
     lookupHelper newRef@(Left s) = case lookup s (fmap sgBindToTuple bindings) of
       Just r -> failIfCycle r $ lookupHelper r
@@ -242,23 +276,24 @@ makeEdgesCore :: [SgSink] -> [SgBind] -> ([SgSink], [Edge])
 makeEdgesCore sinks bindings = partitionEithers $ fmap renameOrMakeEdge sinks
   where
     renameOrMakeEdge :: SgSink -> Either SgSink Edge
-    renameOrMakeEdge orig@(SgSink s destPort)
-      = case lookup s (fmap sgBindToTuple bindings) of
+    renameOrMakeEdge orig@(SgSink s destPort) =
+      case lookup s (fmap sgBindToTuple bindings) of
         Just ref -> case lookupReference bindings ref of
           Right sourcePort -> Right $ makeSimpleEdge (sourcePort, destPort)
           Left newStr -> Left $ SgSink newStr destPort
         Nothing -> Left orig
 
 makeEdges :: SyntaxGraph -> SyntaxGraph
-makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph where
+makeEdges (SyntaxGraph icons edges sinks bindings eMap) = newGraph
+  where
     (newSinks, newEdges) = makeEdgesCore sinks bindings
     newGraph = SyntaxGraph icons (newEdges <> edges) newSinks bindings eMap
 
 makeBox :: String -> State IDState (SyntaxGraph, NameAndPort)
 makeBox str = do
   name <- getUniqueName
-  let graph
-        = syntaxGraphFromNodes [Named name (mkEmbedder (LiteralNode str))]
+  let graph =
+        syntaxGraphFromNodes [Named name (mkEmbedder (LiteralNode str))]
   pure (graph, justName name)
 
 nTupleString :: Int -> String
@@ -266,16 +301,17 @@ nTupleString n = '(' : replicate (n -1) ',' ++ ")"
 
 -- TODO Unit tests for this
 nTupleSectionString :: [Bool] -> String
-nTupleSectionString bools = '(' : (commas ++ ")") where
+nTupleSectionString bools = '(' : (commas ++ ")")
+  where
     commas = case concatMap trueToUnderscore bools of
       [] -> []
       (_ : xs) -> xs
 
-  trueToUnderscore x = if x
+    trueToUnderscore x =
+      if x
         then ",_"
         else ","
 
-
 nListString :: Int -> String
 -- TODO: Use something better than [_]
 nListString 1 = "[_]"
@@ -283,24 +319,26 @@ nListString n = '[' : replicate (n -1) ',' ++ "]"
 
 nodeToIcon :: EmbedderSyntaxNode -> Icon
 nodeToIcon (Embedder embeddedNodes node) = case node of
-  (ApplyNode flavor x)
-    -> nestedApplySyntaxNodeToIcon flavor x embeddedNodes
-  (PatternApplyNode s children)
-    -> nestedPatternNodeToIcon s children
+  (ApplyNode flavor x) ->
+    nestedApplySyntaxNodeToIcon flavor x embeddedNodes
+  (PatternApplyNode s children) ->
+    nestedPatternNodeToIcon s children
   (NameNode s) -> TextBoxIcon s
   (BindNameNode s) -> BindTextBoxIcon s
   (LiteralNode s) -> TextBoxIcon s
-  (FunctionDefNode labels bodyNodes)
-    -> nestedLambdaToIcon labels embeddedNodes bodyNodes
+  (FunctionDefNode labels bodyNodes) ->
+    nestedLambdaToIcon labels embeddedNodes bodyNodes
   CaseResultNode -> CaseResultIcon
-  (CaseOrMultiIfNode tag x)
-    -> nestedCaseOrMultiIfNodeToIcon tag x embeddedNodes
+  (CaseOrMultiIfNode tag x) ->
+    nestedCaseOrMultiIfNodeToIcon tag x embeddedNodes
 
 -- | Helper for makeArg
 findArg :: Port -> (NodeName, Edge) -> Bool
-findArg currentPort
-  (argName
-  , Edge _ (NameAndPort fromName fromPort, NameAndPort toName toPort))
+findArg
+  currentPort
+  ( argName,
+    Edge _ (NameAndPort fromName fromPort, NameAndPort toName toPort)
+    )
     | argName == fromName = maybeBoolToBool $ fmap (== currentPort) toPort
     | argName == toName = maybeBoolToBool $ fmap (== currentPort) fromPort
     | otherwise = False -- This case should never happen
@@ -308,10 +346,11 @@ findArg currentPort
 makeArg :: Set.Set (NodeName, Edge) -> Port -> Maybe NodeName
 makeArg args port = fst <$> find (findArg port) args
 
-nestedApplySyntaxNodeToIcon :: LikeApplyFlavor
-                            -> Int
-                            -> Set.Set (NodeName, Edge)
-                            -> Icon
+nestedApplySyntaxNodeToIcon ::
+  LikeApplyFlavor ->
+  Int ->
+  Set.Set (NodeName, Edge) ->
+  Icon
 nestedApplySyntaxNodeToIcon flavor numArgs args =
   NestedApply flavor headIcon argList
   where
@@ -320,10 +359,11 @@ nestedApplySyntaxNodeToIcon flavor numArgs args =
     headIcon = makeArg args (inputPort dummyNode)
     argList = fmap (makeArg args) argPorts
 
-nestedLambdaToIcon :: [String]  -- labels
-                   -> Set.Set (NodeName, Edge)  -- embedded icons
-                   -> Set.Set NodeName  -- body nodes
-                   -> Icon
+nestedLambdaToIcon ::
+  [String] -> -- labels
+  Set.Set (NodeName, Edge) -> -- embedded icons
+  Set.Set NodeName -> -- body nodes
+  Icon
 nestedLambdaToIcon labels embeddedNodes =
   LambdaIcon labels embeddedBodyNode
   where
@@ -331,10 +371,10 @@ nestedLambdaToIcon labels embeddedNodes =
     embeddedBodyNode = makeArg embeddedNodes (inputPort dummyNode)
 
 nestedCaseOrMultiIfNodeToIcon ::
-  CaseOrMultiIfTag
-  -> Int
-  -> Set.Set (NodeName, Edge)
-  -> Icon
+  CaseOrMultiIfTag ->
+  Int ->
+  Set.Set (NodeName, Edge) ->
+  Icon
 nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
   CaseTag -> NestedCaseIcon argList
   MultiIfTag -> NestedMultiIfIcon argList
@@ -344,7 +384,8 @@ nestedCaseOrMultiIfNodeToIcon tag numArgs args = case tag of
     argList = fmap (makeArg args) (inputPort dummyNode : argPorts)
 
 nestedPatternNodeToIcon :: String -> [Labeled (Maybe SgNamedNode)] -> Icon
-nestedPatternNodeToIcon str children = NestedPApp
+nestedPatternNodeToIcon str children =
+  NestedPApp
     (pure (Just (Named (NodeName (-1)) (TextBoxIcon str))))
     -- Why so many fmaps?
     ((fmap . fmap . fmap . fmap) nodeToIcon children)
@@ -353,20 +394,28 @@ makeLNode :: SgNamedNode -> ING.LNode SgNamedNode
 makeLNode namedNode@(Named (NodeName name) _) = (name, namedNode)
 
 lookupInEmbeddingMap :: NodeName -> Map.Map NodeName NodeName -> NodeName
-lookupInEmbeddingMap origName eMap = lookupHelper origName where
+lookupInEmbeddingMap origName eMap = lookupHelper origName
+  where
     lookupHelper name = case Map.lookup name eMap of
       Nothing -> name
-    Just parent -> if parent == origName
-      then error $ "lookupInEmbeddingMap: Found cycle. Node = "
-           ++ show origName ++ "\nEmbedding Map = " ++ show eMap
+      Just parent ->
+        if parent == origName
+          then
+            error $
+              "lookupInEmbeddingMap: Found cycle. Node = "
+                ++ show origName
+                ++ "\nEmbedding Map = "
+                ++ show eMap
           else lookupHelper parent
 
 syntaxGraphToFglGraph :: SyntaxGraph -> FGR.Gr SgNamedNode Edge
 syntaxGraphToFglGraph (SyntaxGraph nodes edges _ _ eMap) =
-  ING.mkGraph (fmap makeLNode nodes) labeledEdges where
+  ING.mkGraph (fmap makeLNode nodes) labeledEdges
+  where
     labeledEdges = fmap makeLabeledEdge edges
 
     makeLabeledEdge e@(Edge _ (NameAndPort name1 _, NameAndPort name2 _)) =
-      (nodeNameToInt $ lookupInEmbeddingMap name1 eMap
-      , nodeNameToInt $ lookupInEmbeddingMap name2 eMap
-      , e)
+      ( nodeNameToInt $ lookupInEmbeddingMap name1 eMap,
+        nodeNameToInt $ lookupInEmbeddingMap name2 eMap,
+        e
+      )

app/Types.hs

@@ -1,8 +1,11 @@
-{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, ConstraintKinds #-}
+-- This file is formatted with Ormolu
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
-module Types (
-  Named(..),
+module Types
+  ( Named (..),
     NamedIcon,
     IconInfo,
     Icon (..),
@@ -30,18 +33,18 @@ module Types (
     Embedder (..),
     mkEmbedder,
     EmbedderSyntaxNode,
-) where
+  )
+where
 
-import Diagrams.Prelude(QDiagram, V2, Any, Renderable, Path, IsName)
-import Diagrams.TwoD.Text(Text)
-
-import Control.Applicative(Applicative(..))
 import qualified Data.Graph.Inductive as ING
 import qualified Data.IntMap as IM
 import Data.Set (Set, empty)
 import Data.Typeable (Typeable)
+import Diagrams.Prelude (Any, IsName, Path, QDiagram, Renderable, V2)
+import Diagrams.TwoD.Text (Text)
 
 newtype NodeName = NodeName Int deriving (Typeable, Eq, Ord, Show)
+
 instance IsName NodeName
 
 data Named a = Named {naName :: NodeName, naVal :: a}
@@ -63,7 +66,8 @@ type IconInfo = IM.IntMap Icon
 
 -- | A datatype that represents an icon.
 -- The TextBoxIcon's data is the text that appears in the text box.
-data Icon = TextBoxIcon String
+data Icon
+  = TextBoxIcon String
   | MultiIfIcon
       Int -- Number of alternatives
   | LambdaIcon
@@ -90,9 +94,10 @@ data LikeApplyFlavor = ApplyNodeFlavor | ComposeNodeFlavor
 data CaseOrMultiIfTag = CaseTag | MultiIfTag deriving (Show, Eq, Ord)
 
 -- TODO The full edge does not need to be included, just the port.
-data Embedder a = Embedder {
-  emEmbedded :: Set (NodeName, Edge)  -- ^ Set of embedded nodes
-  , emNode :: a
+data Embedder a = Embedder
+  { -- | Set of embedded nodes
+    emEmbedded :: Set (NodeName, Edge),
+    emNode :: a
   }
   deriving (Show, Eq, Ord, Functor)
 
@@ -104,8 +109,8 @@ type EmbedderSyntaxNode = Embedder SyntaxNode
 type SgNamedNode = Named EmbedderSyntaxNode
 
 -- TODO remove Ints from SyntaxNode data constructors.
-data SyntaxNode =
-  -- Function application, composition, and applying to a composition
+data SyntaxNode
+  = -- Function application, composition, and applying to a composition
     -- The list of nodes is unordered (replace with a map?)
     ApplyNode LikeApplyFlavor Int
   | PatternApplyNode String [Labeled (Maybe SgNamedNode)]
@@ -120,6 +125,7 @@ data SyntaxNode =
   deriving (Show, Eq, Ord)
 
 newtype Port = Port Int deriving (Typeable, Eq, Ord, Show)
+
 instance IsName Port
 
 data NameAndPort = NameAndPort NodeName (Maybe Port) deriving (Show, Eq, Ord)
@@ -131,8 +137,10 @@ data EdgeOption = EdgeInPattern deriving (Show, Eq, Ord)
 
 -- | An Edge has an name of the source icon, and its optional port number,
 -- and the name of the destination icon, and its optional port number.
-data Edge = Edge { edgeOptions :: [EdgeOption]
-                 , edgeConnection :: Connection}
+data Edge = Edge
+  { edgeOptions :: [EdgeOption],
+    edgeConnection :: Connection
+  }
   deriving (Show, Eq, Ord)
 
 -- | A drawing is a map from names to Icons, a list of edges,
@@ -143,19 +151,19 @@ data Drawing = Drawing [NamedIcon] [Edge] deriving (Show, Eq)
 -- unique id.
 newtype IDState = IDState Int deriving (Eq, Show)
 
-type SpecialNum n
-  = (Floating n, RealFrac n, RealFloat n, Typeable n, Show n, Enum n)
+type SpecialNum n =
+  (Floating n, RealFrac n, RealFloat n, Typeable n, Show n, Enum n)
 
 -- Note that SpecialBackend is a constraint synonym, not a type synonym.
-type SpecialBackend b n
-  = (SpecialNum n, Renderable (Path V2 n) b, Renderable (Text n) b)
+type SpecialBackend b n =
+  (SpecialNum n, Renderable (Path V2 n) b, Renderable (Text n) b)
 
 type SpecialQDiagram b n = QDiagram b V2 n Any
 
 type IngSyntaxGraph gr = gr SgNamedNode Edge
 
-data EmbedDirection =
-  EdEmbedFrom -- The tail
+data EmbedDirection
+  = EdEmbedFrom -- The tail
   | EdEmbedTo -- The head
   deriving (Show, Eq)
 
@@ -165,8 +173,8 @@ data EmbedInfo a = EmbedInfo {eiEmbedDir :: Maybe EmbedDirection, eiVal :: a}
 
 type AnnotatedGraph gr = gr (NodeInfo SgNamedNode) (EmbedInfo Edge)
 
-data NodeInfo a = NodeInfo {
-  niParent :: Maybe ING.Node
-  , niVal :: a
+data NodeInfo a = NodeInfo
+  { niParent :: Maybe ING.Node,
+    niVal :: a
   }
   deriving (Show, Eq, Functor, Ord)

stack.yaml

@@ -1,7 +1,7 @@
 # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-16.18
+resolver: lts-16.27
 
 # Local packages, usually specified by relative directory name
 packages: