content: {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE NoMonomorphismRestriction #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  module Icons
      (
      TransformParams(..),
      TransformableDia,
      getPortAngles,
      iconToDiagram,
      inputPort,
      resultPort,
      argumentPorts,
      caseRhsPorts,
      casePatternPorts,
      multiIfRhsPorts,
      multiIfBoolPorts,
      textBox,
      multilineComment,
      defaultLineWidth,
      ColorStyle(..),
      colorScheme,
      coloredTextBox,
      circleRadius,
      findIconFromName
      ) where
  
  import Diagrams.Prelude hiding ((&), (#), Name)
  
  import qualified Control.Arrow as Arrow
  import Data.Either(partitionEithers)
  import qualified Data.IntMap as IM
  import Data.List(find)
  import Data.Maybe(listToMaybe, isJust, fromJust, mapMaybe)
  import Data.Typeable(Typeable)
  
  import Constants(pattern InputPortConst, pattern ResultPortConst)
  import DrawingColors(colorScheme, ColorStyle(..))
  import Types(Icon(..), SpecialQDiagram, SpecialBackend, SpecialNum
              , NodeName(..), Port(..), LikeApplyFlavor(..),
              SyntaxNode(..), NamedIcon, Labeled(..), IconInfo
              , Named(..))
  
  {-# ANN module "HLint: ignore Use record patterns" #-}
  {-# ANN module "HLint: ignore Unnecessary hiding" #-}
  
  -- TYPES --
  
  data TransformParams n = TransformParams {
    tpName :: NodeName  -- The icon's name
    , tpNestingDepth :: Int  -- The icon's nesting depth
    , tpIsReflected :: Bool  -- If the icon will be reflected
    , tpAngle :: Angle n  -- By what angle will the icon be rotated
    }
  
  -- | A TransformableDia is a function that returns a diagram for an icon when
  -- given the icon's name, its nesting depth, whether it will be reflected, and
  -- by what angle it will be rotated.
  type TransformableDia b n = TransformParams n -> SpecialQDiagram b n
  
  
  -- CONSTANTS --
  defaultLineWidth :: (Fractional a) => a
  defaultLineWidth = 0.15
  
  circleRadius :: (Fractional a) => a
  circleRadius = 0.5
  
  defaultOpacity :: (Fractional a) => a
  defaultOpacity = 0.4
  
  -- COLORS --
  lineCol :: Colour Double
  lineCol = lineC colorScheme
  
  
  -- BEGIN Exported icon functions --
  
  findIconFromName :: IconInfo -> NodeName -> NamedIcon
  findIconFromName icons name@(NodeName nameInt)
    = Named name $ IM.findWithDefault
      (error $ "findIconFromName: icon not found.\nicons="
        <> show icons <> "\nname=" <> show name)
      nameInt
      icons
  
  -- TODO Detect if we are in a loop (have called iconToDiagram on the same node
  -- before)
  iconToDiagram :: SpecialBackend b n
    => IconInfo
    -> Icon
    -> TransformableDia b n
  iconToDiagram iconInfo icon = case icon of
    TextBoxIcon s -> textBox s
    BindTextBoxIcon s -> identDiaFunc $ bindTextBox s
    MultiIfIcon n -> nestedMultiIfDia iconInfo $ replicate (1 + (2 * n)) Nothing
    CaseIcon n -> nestedCaseDia iconInfo $ replicate (1 + (2 * n)) Nothing
    CaseResultIcon -> identDiaFunc caseResult
    LambdaIcon x bodyExp _
      -> nestedLambda iconInfo x (findIconFromName iconInfo <$> bodyExp)
    NestedApply flavor headIcon args
      -> nestedApplyDia
         iconInfo
         flavor
         (fmap (findIconFromName iconInfo) headIcon)
         ((fmap . fmap) (findIconFromName iconInfo) args)
    NestedPApp constructor args
      -> nestedPAppDia iconInfo (repeat $ patternC colorScheme) constructor args
    NestedCaseIcon args -> nestedCaseDia
                           iconInfo
                           ((fmap . fmap) (findIconFromName iconInfo) args)
    NestedMultiIfIcon args -> nestedMultiIfDia
                              iconInfo
                              ((fmap . fmap) (findIconFromName iconInfo) args)
  
  -- BEGIN getPortAngles --
  
  applyPortAngles :: Floating n => Port -> [Angle n]
  applyPortAngles (Port x) = fmap (@@ turn) $ case x of
    0 -> [3/8, 1/2, 5/8] -- TODO Don't use angle of 1/2 for nested icons here
    --1 -> [1/8, 7/8, 0]
    1 -> [0]
    _ -> [1/4, 3/4]
  
  lambdaPortAngles :: Floating n => Bool -> Port -> [Angle n]
  lambdaPortAngles embedded (Port x) = fmap (@@ turn) $ case x of
    -- 0 == lambda return value Icon
    0 -> if embedded
         then [1/4, 3/4]
         else [3/8, 1/2, 5/8]
    -- 1 == value port
    --1 -> [1/8, 7/8, 0]
    1 -> [0]
    _ -> [1/4, 3/4]
  
  pAppPortAngles :: Floating n => Port -> [Angle n]
  pAppPortAngles (Port x) = fmap (@@ turn) $ case x of
    0 -> [1/4]
    1 -> [0]
    _ -> [1/2]
  
  multiIfPortAngles :: Floating n => Port -> [Angle n]
  multiIfPortAngles (Port port) = case port of
    0 -> [1/4 @@ turn]
    1 -> [3/4 @@ turn]
    _ -> otherAngles where otherAngles
                             | even port = [0 @@ turn]
                             | otherwise = [1/2 @@ turn]
  
  findNestedIcon :: IconInfo -> NodeName -> Icon -> Maybe Icon
  findNestedIcon iconInfo name icon = case icon of
    NestedApply _ headIcon args
      -> snd
         <$> findIcon
         iconInfo
         name
         ((fmap . fmap) (findIconFromName iconInfo) (headIcon : args))
    NestedPApp constructor args ->
      snd <$> findIcon iconInfo name (fmap laValue (constructor:args))
    _ -> Nothing
  
  findIcon :: IconInfo -> NodeName -> [Maybe NamedIcon] -> Maybe (Int, Icon)
  findIcon iconInfo name args = icon where
    numberedArgs = zip ([0,1..] :: [Int]) args
    filteredArgs = Arrow.second fromJust <$> filter (isJust . snd) numberedArgs
    nameMatches (_, Named n _) = n == name
    icon = case find nameMatches filteredArgs of
      Nothing -> listToMaybe $ mapMaybe findSubSubIcon filteredArgs
      Just (argNum, Named _ finalIcon) -> Just (argNum, finalIcon)
      where
        findSubSubIcon (argNum, Named _ subIcon)
          = case findNestedIcon iconInfo name subIcon of
              Nothing -> Nothing
              Just x -> Just (argNum, x)
  
  generalNestedPortAngles :: SpecialNum n
    => IconInfo
    -> (Port -> [Angle n])
    -> Maybe NamedIcon
    -> [Maybe NamedIcon]
    -> Port -> Maybe NodeName -> [Angle n]
  generalNestedPortAngles iconInfo defaultAngles headIcon args port maybeNodeName =
    case maybeNodeName of
      Nothing -> defaultAngles port
      Just name -> case findIcon iconInfo name (headIcon : args) of
        Nothing -> []
        Just (_, icon) -> getPortAnglesHelper True iconInfo icon port Nothing
  
  reflectXAngle :: SpecialNum n => Angle n -> Angle n
  reflectXAngle x = reflectedAngle where
    normalizedAngle = normalizeAngle x
    reflectedAngle = (-) <$> halfTurn <*> normalizedAngle
  
  -- TODO reflect the angles for the right side sub-icons
  nestedMultiIfPortAngles :: SpecialNum n
    => IconInfo
    -> [Maybe NamedIcon]
    -> Port
    -> Maybe NodeName
    -> [Angle n]
  nestedMultiIfPortAngles iconInfo args port maybeNodeName = case maybeNodeName of
    Nothing -> multiIfPortAngles port
    Just name -> case findIcon iconInfo name args of
      Nothing -> []
      -- TODO Don't use hardcoded numbers
      -- The arguments correspond to ports [0, 2, 3, 4 ...]
      Just (argNum, icon) -> if odd argNum && argNum >= 1
        -- The icon will be reflected
        then fmap reflectXAngle subAngles
        else subAngles
        where
          subAngles = getPortAnglesHelper True iconInfo icon port Nothing
  
  getPortAngles :: SpecialNum n
    => IconInfo -> Icon -> Port -> Maybe NodeName -> [Angle n]
  getPortAngles = getPortAnglesHelper False
  
  getPortAnglesHelper :: SpecialNum n
    => Bool -> IconInfo -> Icon -> Port -> Maybe NodeName -> [Angle n]
  getPortAnglesHelper embedded iconInfo icon port maybeNodeName = case icon of
    TextBoxIcon _ -> []
    BindTextBoxIcon _ -> []
    MultiIfIcon _ -> multiIfPortAngles port
    CaseIcon _ -> multiIfPortAngles port
    CaseResultIcon -> []
    LambdaIcon _ _ _ -> lambdaPortAngles embedded port
    NestedApply _ headIcon args
      -> generalNestedPortAngles
         iconInfo
         applyPortAngles
         -- TODO Refactor with iconToDiagram
         (fmap (findIconFromName iconInfo) headIcon)
         ((fmap . fmap) (findIconFromName iconInfo) args)
         port
         maybeNodeName
    NestedPApp headIcon args
      -> generalNestedPortAngles
         iconInfo
         pAppPortAngles
         (laValue headIcon)
         (fmap laValue args)
         port
         maybeNodeName
    NestedCaseIcon args
      -> nestedMultiIfPortAngles
         iconInfo
         ((fmap . fmap) (findIconFromName iconInfo) args)
         port
         maybeNodeName
    NestedMultiIfIcon args
      -> nestedMultiIfPortAngles
         iconInfo
         ((fmap . fmap) (findIconFromName iconInfo) args)
         port
         maybeNodeName
  
  -- END getPortAngles --
  
  -- BEGIN Port numbers
  
  argPortsConst :: [Port]
  argPortsConst = fmap Port [2,3..]
  
  -- TODO It's a bit strange that the parameter is a SyntaxNode, not an Icon.
  inputPort :: SyntaxNode -> Port
  inputPort = const InputPortConst
  
  resultPort :: SyntaxNode -> Port
  resultPort = const ResultPortConst
  
  caseRhsPorts :: [Port]
  caseRhsPorts = fmap Port [3,5..]
  
  casePatternPorts :: [Port]
  casePatternPorts = fmap Port [2,4..]
  
  multiIfRhsPorts :: [Port]
  multiIfRhsPorts = casePatternPorts
  
  multiIfBoolPorts :: [Port]
  multiIfBoolPorts = caseRhsPorts
  
  argumentPorts :: SyntaxNode -> [Port]
  argumentPorts n = case n of
    (ApplyNode _ _) -> defaultPorts
    PatternApplyNode _ _-> defaultPorts
    (FunctionDefNode _ _) -> defaultPorts
    CaseOrMultiIfNode _ _ -> defaultPorts
    NameNode _ -> []
    BindNameNode _ -> []
    LiteralNode _ -> []
    CaseResultNode -> []
    where
      defaultPorts = argPortsConst
  -- END Port numbers
  
  -- END Exported icon functions --
  
  -- BEGIN Diagram helper functions --
  
  -- | Make an identity TransformableDia
  identDiaFunc :: SpecialNum n => SpecialQDiagram b n -> TransformableDia b n
  identDiaFunc dia transformParams = nameDiagram (tpName transformParams) dia
  
  -- | Names the diagram and puts all sub-names in the namespace of the top level
  -- name.
  nameDiagram :: SpecialNum n =>
    NodeName
    -> SpecialQDiagram b n
    -> SpecialQDiagram b n
  nameDiagram name dia = named name (name .>> dia)
  
  -- | Make an port with an integer name. Always use <> to add a ports
  -- (not === or |||)  since mempty has no size and will not be placed where you
  -- want it.
  makePort :: SpecialNum n => Port -> SpecialQDiagram b n
  makePort x = named x mempty
  --makePort x = circle 0.2 # fc green # named x
  -- Note, the version of makePort below seems to have a different type.
  --makePort x = textBox (show x) # fc green # named x
  
  makeQualifiedPort :: SpecialNum n => NodeName -> Port -> SpecialQDiagram b n
  makeQualifiedPort n x = n .>> makePort x
  
  makeLabelledPort :: SpecialBackend b n =>
    NodeName -> Bool -> Angle n -> String -> Port -> SpecialQDiagram b n
  makeLabelledPort name reflect angle str portNum = case str of
    -- Don't display " tempvar" from Translate.hs/matchesToCase
    (' ':_) -> portAndCircle
    (_:_:_) -> portAndCircle ||| label
    _ -> portAndCircle
    where
      portAndCircle = makeQualifiedPort name portNum <> portCircle
      label = transformableBindTextBox str reflect angle
  
  -- END Diagram helper functions
  
  
  -- BEGIN Icons --
  
  -- BEGIN Sub-diagrams --
  
  apply0Triangle :: SpecialBackend b n => Colour Double -> SpecialQDiagram b n
  apply0Triangle col
    = fc col $ lw none $ rotateBy (-1/12) $ eqTriangle (2 * circleRadius)
  
  composeSemiCircle :: SpecialBackend b n => Colour Double -> SpecialQDiagram b n
  composeSemiCircle col
    = lc col $ lwG defaultLineWidth $ wedge circleRadius yDir halfTurn
  
  portCircle :: SpecialBackend b n => SpecialQDiagram b n
  portCircle = lw none $ fc lineCol $ circle (circleRadius * 0.5)
  
  resultIcon :: SpecialBackend b n => SpecialQDiagram b n
  resultIcon =  lw none $ fc (lamArgResC colorScheme) unitSquare
  
  -- END Sub-diagrams
  
  -- BEGIN Main icons
  
  -- BEGIN Apply like icons
  
  makeAppInnerIcon :: SpecialBackend b n =>
    IconInfo ->
    TransformParams n ->
    Bool ->  -- If False then add one to the nesting level.
    Port ->  -- Port number (if the NamedIcon is Nothing)
    Labeled (Maybe NamedIcon) ->  -- The icon
    SpecialQDiagram b n
  makeAppInnerIcon _iconInfo (TransformParams name _ reflect angle) _ portNum
    (Labeled Nothing str)
    = centerX $ makeLabelledPort name reflect angle str portNum
  makeAppInnerIcon iconInfo (TransformParams _ nestingLevel reflect angle) func _
    (Labeled (Just (Named iconNodeName icon)) _)
    = iconToDiagram
      iconInfo
      icon
      (TransformParams iconNodeName innerLevel reflect angle)
    where
      innerLevel = if func then nestingLevel else nestingLevel + 1
  
  makeTransformedText :: SpecialBackend b n
    => IconInfo
    -> TransformParams n
    -> Labeled (Maybe NamedIcon)
    -> SpecialQDiagram b n
  makeTransformedText iconInfo tp maybeFunText = case laValue maybeFunText of
    Just _ ->
      makeAppInnerIcon iconInfo tp True InputPortConst maybeFunText
    Nothing -> mempty
  
  appArgBox :: (HasStyle a, Typeable (N a)
               , TrailLike a, RealFloat (N a), V a ~ V2)
            => Colour Double -> N a -> N a -> a
  appArgBox borderCol topAndBottomLineWidth portHeight
    = lwG defaultLineWidth $ lcA (withOpacity borderCol defaultOpacity)
      $ roundedRect
      topAndBottomLineWidth
      (portHeight + verticalSeparation)
      (circleRadius * 0.5)
    where
      verticalSeparation = circleRadius
  
  nestedPAppDia :: SpecialBackend b n
    => IconInfo
    -> [Colour Double]
    -> Labeled (Maybe NamedIcon)
    -> [Labeled (Maybe NamedIcon)]
    -> TransformableDia b n
  nestedPAppDia
    iconInfo
    borderCols
    maybeFunText
    args
    tp@(TransformParams name nestingLevel _ _)
    = named name $ centerXY
      $ centerY finalDia ||| beside' unitX transformedText resultCircleAndPort
    where
      borderCol = borderCols !! nestingLevel
      transformedText = makeTransformedText iconInfo tp maybeFunText
      separation = circleRadius * 1.5
      resultCircleAndPort
        = makeQualifiedPort name ResultPortConst
          <> alignR
          (lc borderCol
            $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius)
      triangleAndPorts
        = vsep separation $
          rotate quarterTurn (apply0Triangle borderCol) :
          zipWith (makeAppInnerIcon iconInfo tp False) argPortsConst args
      allPorts
        = makeQualifiedPort name InputPortConst <> alignT triangleAndPorts
      argBox = alignT $ appArgBox
               borderCol
               (width allPorts)
               (height allPorts)
      finalDia = argBox <> allPorts
  
  
  -- | Like beside, but it puts the second dia atop the first dia
  beside' :: (Semigroup a, Juxtaposable a) => V a (N a) -> a -> a -> a
  beside' dir dia1 dia2 = juxtapose dir dia1 dia2 <> dia1
  
  -- | apply port locations:
  -- InputPortConst: Function
  -- ResultPortConst: Result
  -- Ports 2,3..: Arguments
  generalNestedDia :: SpecialBackend b n
    => IconInfo
    -> (Colour Double -> SpecialQDiagram b n)
    -> [Colour Double]
    -> Maybe NamedIcon
    -> [Maybe NamedIcon]
    -> TransformableDia b n
  generalNestedDia
    iconInfo
    dia
    borderCols
    maybeFunText
    args
    tp@(TransformParams name nestingLevel _ _)
    = named name $ centerXY $ beside' unitX transformedText finalDia
      where
        borderCol = borderCols !! nestingLevel
        transformedText = makeTransformedText iconInfo tp (pure maybeFunText)
        separation = circleRadius * 1.5
        trianglePortsCircle = hsep separation $
          reflectX (dia borderCol) :
          zipWith (makeAppInnerIcon iconInfo tp False) argPortsConst (fmap pure args) ++
          [makeQualifiedPort name ResultPortConst
           <> alignR
            (lc borderCol $ lwG defaultLineWidth $ fc borderCol
              $ circle circleRadius)
          ]
        allPorts
          = makeQualifiedPort name InputPortConst <> alignL trianglePortsCircle
        argBox = alignL $ appArgBox
                 borderCol
                 (width allPorts - circleRadius)
                 (height allPorts)
        finalDia = argBox <> allPorts
  
  
  nestedApplyDia :: SpecialBackend b n
    => IconInfo
    -> LikeApplyFlavor
    -> Maybe NamedIcon
    -> [Maybe NamedIcon]
    -> TransformableDia b n
  nestedApplyDia iconInfo flavor = case flavor of
    ApplyNodeFlavor
      -> generalNestedDia iconInfo apply0Triangle (nestingC colorScheme)
    ComposeNodeFlavor
      -> generalNestedDia iconInfo composeSemiCircle (repeat $ apply1C colorScheme)
  
  -- END Apply like diagrams
  
  -- BEGIN Text boxes and icons --
  
  -- Text constants --
  textBoxFontSize :: (Num a) => a
  textBoxFontSize = 1
  
  monoLetterWidthToHeightFraction :: (Fractional a) => a
  monoLetterWidthToHeightFraction = 0.61
  
  textBoxHeightFactor :: (Fractional a) => a
  textBoxHeightFactor = 1.4
  
  textFont :: String
  textFont = "monospace"
  
  -- BEGIN Text helper functions --
  
  -- This may be a faster implementation of normalizeAngle
  --Get the decimal part of a float
  -- reduceAngleRange :: SpecialNum a => a -> a
  -- reduceAngleRange x = x - fromInteger (floor x)
  
  -- | Given the number of letters in a textbox string, make a rectangle that will
  -- enclose the text box. Since the normal SVG text has no size, some hackery is
  -- needed to determine the size of the text's bounding box.
  rectForText :: (InSpace V2 n t, TrailLike t) => Int -> t
  rectForText n = rect rectangleWidth (textBoxFontSize * textBoxHeightFactor)
    where
      rectangleWidth
        = (fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction)
          + (textBoxFontSize * 0.3)
  
  -- END Text helper functions
  
  commentTextArea :: SpecialBackend b n =>
    Colour Double -> String -> SpecialQDiagram b n
  commentTextArea textColor t =
    alignL
    $ fontSize
    (local textBoxFontSize)
    (font textFont $ fc textColor $ topLeftText t)
    <>  alignTL (lw none $ rectForText (length t))
  
  multilineComment :: SpecialBackend b n =>
    Colour Double
    -> AlphaColour Double -> String -> SpecialQDiagram b n
  multilineComment textColor _boxColor t = lwG (0.6 * defaultLineWidth) textDia
    where
      textLines = lines t
      textAreas = map (commentTextArea textColor) textLines
      textDia = vcat textAreas
  
  coloredTextBox :: SpecialBackend b n =>
    Colour Double
    -> AlphaColour Double -> String -> SpecialQDiagram b n
  coloredTextBox textColor boxColor t =
    fontSize
    (local textBoxFontSize)
    (bold $ font textFont $ fc textColor $ text t)
    <> lwG
    (0.6 * defaultLineWidth)
    (lcA boxColor
      $ fcA (withOpacity (backgroundC colorScheme) 0.5)
      $ rectForText (length t))
  
  transformCorrectedTextBox :: SpecialBackend b n =>
    String
    -> Colour Double
    -> Colour Double
    -> Bool
    -> Angle n
    -> SpecialQDiagram b n
  transformCorrectedTextBox str textCol borderCol reflect angle =
    rotateBy
    textBoxRotation
    (reflectIfTrue reflect (coloredTextBox textCol (opaque borderCol) str))
    where
      -- If normalizeAngle is slow, the commented out function reduceAngleRange
      -- might be faster.
      reducedAngle = normalizeAngle angle ^. turn
      textBoxRotation
        = if (reducedAngle > (1/4)) && (reducedAngle < (3/4)) then 1 / 2 else 0
      reflectIfTrue shouldReflect dia
        = if shouldReflect then reflectX dia else dia
  
  transformableBindTextBox :: SpecialBackend b n =>
    String -> Bool -> Angle n -> SpecialQDiagram b n
  transformableBindTextBox str
    = transformCorrectedTextBox
      str
      (bindTextBoxTextC colorScheme)
      (bindTextBoxC colorScheme)
  
  bindTextBox :: SpecialBackend b n =>
    String -> SpecialQDiagram b n
  bindTextBox
    = coloredTextBox (bindTextBoxTextC colorScheme)
      $ opaque (bindTextBoxC colorScheme)
  
  textBox :: SpecialBackend b n =>
    String -> TransformableDia b n
  textBox t (TransformParams name _ reflect angle)
    = nameDiagram name $ transformCorrectedTextBox
      t (textBoxTextC colorScheme) (textBoxC colorScheme) reflect angle
  
  -- END Text boxes and icons
  
  -- BEGIN MultiIf and case icons --
  multiIfSize :: (Fractional a) => a
  multiIfSize = 0.7
  
  multiIfTriangle :: SpecialBackend b n =>
    SpecialQDiagram b n -> SpecialQDiagram b n
  multiIfTriangle portDia =
    alignL
    $ alignR (triangleAndPort ||| lwG defaultLineWidth (hrule (multiIfSize * 0.8)))
    <> portDia
    where
      triangleAndPort = alignR $ alignT $ lwG defaultLineWidth $ rotateBy (1/8) $
        polygon
        (polyType .~ PolySides [90 @@ deg, 45 @@ deg] [multiIfSize, multiIfSize]
         $ with)
  
  -- | generalNestedMultiIf port layout:
  -- 0 -> top
  -- 1 -> bottom
  -- odds -> left
  -- evens -> right
  generalNestedMultiIf :: SpecialBackend b n
                     => IconInfo
                     -> Colour Double
                     -> (SpecialQDiagram b n -> SpecialQDiagram b n)
                     -> SpecialQDiagram b n
                     -> [Maybe NamedIcon]
                     -> TransformableDia b n
  generalNestedMultiIf iconInfo triangleColor lBracket bottomDia inputAndArgs
    (TransformParams name nestingLevel reflect angle)
    = named name $ case inputAndArgs of
    [] -> mempty
    input : args -> centerXY finalDia where
      finalDia = alignT (bottomDia <> makeQualifiedPort name ResultPortConst)
                 <> alignB
                 (inputIcon === (bigVerticalLine
                                 <> multiIfDia
                                 <> makeQualifiedPort name InputPortConst))
  
      iconMapper (Port portNum) arg
        | even portNum = Right $ multiIfTriangle port ||| makeInnerIcon True arg
        | otherwise = Left $ makeInnerIcon False arg ||| lBracket port
        where
          port = makeQualifiedPort name (Port portNum)
  
      (lBrackets, trianglesWithPorts)
        = partitionEithers $ zipWith iconMapper argPortsConst args
  
      trianglesAndBrackets =
        zipWith zipper trianglesWithPorts lBrackets
  
      zipper thisTriangle lBrack
        = verticalLine
          ===
          (alignR (extrudeRight multiIfSize lBrack)
           <> lc triangleColor (alignL thisTriangle))
        where
          verticalLine = strutY 0.4
  
      inputIcon = makeInnerIcon False input
  
      multiIfDia = vcat (alignT trianglesAndBrackets)
      bigVerticalLine
        = alignT
          $ lwG defaultLineWidth $ lc triangleColor $ vrule (height multiIfDia)
  
      makeInnerIcon innerReflected mNameAndIcon = case mNameAndIcon of
        Nothing -> mempty
        Just (Named iconNodeName icon) -> if innerReflected
          then reflectX dia
          else dia
          where
            dia = iconToDiagram
                  iconInfo
                  icon
                  (TransformParams
                    iconNodeName
                    nestingLevel
                    (innerReflected /= reflect)
                    angle)
  
  multiIfLBracket :: SpecialBackend b n =>
    SpecialQDiagram b n -> SpecialQDiagram b n
  multiIfLBracket portDia = alignL (alignT ell) <> portDia
    where
      ellShape = fromOffsets $ map r2 [(0, multiIfSize), (-multiIfSize, 0)]
      ell
        = lineJoin LineJoinRound
        $ lwG defaultLineWidth $ lc (boolC colorScheme) (strokeLine ellShape)
  
  -- | The ports of the multiIf icon are as follows:
  -- InputPortConst: Top result port (not used)
  -- ResultPortConst: Bottom result port
  -- Ports 3,5...: The left ports for the booleans
  -- Ports 2,4...: The right ports for the values
  nestedMultiIfDia :: SpecialBackend b n =>
    IconInfo
    -> [Maybe NamedIcon]
    -> TransformableDia b n
  nestedMultiIfDia iconInfo = generalNestedMultiIf iconInfo lineCol multiIfLBracket mempty
  
  -- TODO Improve design to be more than a circle.
  caseResult :: SpecialBackend b n =>
    SpecialQDiagram b n
  caseResult = lw none $ lc caseCColor $ fc caseCColor $ circle circleRadius
    where
      caseCColor = caseRhsC colorScheme
  
  caseC :: SpecialBackend b n =>
    SpecialQDiagram b n -> SpecialQDiagram b n
  caseC portDia = caseResult <> portDia
  
  -- | The ports of the case icon are as follows:
  -- InputPortConst: Top input port
  -- ResultPortConst: Bottom result port
  -- Ports 3,5...: The left ports for the results
  -- Ports 2,4...: The right ports for the patterns
  nestedCaseDia :: SpecialBackend b n
    => IconInfo
    -> [Maybe NamedIcon]
    -> TransformableDia b n
  nestedCaseDia iconInfo
    = generalNestedMultiIf iconInfo (patternC colorScheme) caseC caseResult
  
  -- END MultiIf and case icons
  
  -- | The ports of flatLambdaIcon are:
  -- 0: Result icon
  -- 1: The lambda function value
  -- 2,3.. : The parameters
  nestedLambda :: SpecialBackend b n
             => IconInfo
             -> [String]
             -> Maybe NamedIcon
             -> TransformableDia b n
  nestedLambda iconInfo paramNames mBodyExp (TransformParams name level reflect angle)
    = centerXY $ bodyExpIcon ||| centerY (named name finalDia)
    where
    lambdaCircle
      = lwG defaultLineWidth
        $ lc (regionPerimC colorScheme)
        $ fc (regionPerimC colorScheme) $ circle (1.85 * circleRadius)
    lambdaParts
      = (makeQualifiedPort name InputPortConst <> resultIcon)
        :
        (portIcons
          ++ [makeQualifiedPort name ResultPortConst <> alignR lambdaCircle])
    bodyExpIcon = case mBodyExp of
      Nothing -> mempty
      Just (Named bodyNodeName bodyIcon)
        -> iconToDiagram
           iconInfo
           bodyIcon
           (TransformParams bodyNodeName level reflect angle)
  
    portIcons
      = zipWith (makeLabelledPort name reflect angle) paramNames argPortsConst
    middle = alignL (hsep 0.5 lambdaParts)
    topAndBottomLineWidth = width middle - (circleRadius + defaultLineWidth)
    topAndBottomLine
      = alignL
        $ lwG defaultLineWidth
        $ lcA (withOpacity (regionPerimC colorScheme) defaultOpacity)
        $ hrule topAndBottomLineWidth
    finalDia = vcat [topAndBottomLine, middle, topAndBottomLine]
  
  -- END Main icons
  -- END Icons
  