Refactored newVertexTree (#142)

- Replace nested case expressions in `newVertexTree` with `runExcept`
- Moved "invalid breakpoint" error message to `determineGroup`

Author: webdevred

jbeam-edit.cabal

@@ -157,6 +157,7 @@ library jbeam-edit-transformation
         build-depends:
             extra,
             ordered-containers,
+            transformers,
             yaml
 
     else

package.yaml

@@ -83,7 +83,7 @@ internal-libraries:
     when:
       condition: flag(transformation)
       then:
-        dependencies: [yaml, extra, ordered-containers]
+        dependencies: [yaml, extra, transformers, ordered-containers]
       else:
         buildable: false
     source-dirs: src-extra/transformation

src-extra/transformation/JbeamEdit/Transformation.hs

@@ -131,7 +131,7 @@ addVertexTreeToForest newNames tf grouped forest forestAcc t =
 groupAnnotatedVertices
   :: XGroupBreakpoints
   -> AnnotatedVertex
-  -> Maybe (VertexTreeType, [AnnotatedVertex])
+  -> Either Text (VertexTreeType, [AnnotatedVertex])
 groupAnnotatedVertices brks g = (,[g]) <$> determineGroup' brks (aVertex g)
 
 updateSupportVertexName
@@ -212,7 +212,7 @@ moveVerticesInVertexForest topNode newNames tfCfg vertexTrees =
           vertexTrees
       brks = xGroupBreakpoints tfCfg
    in case mapM (groupAnnotatedVertices brks) allVertices of
-        Just movableVertices' -> do
+        Right movableVertices' -> do
           let groupedVertices = M.fromListWith (++) movableVertices'
           (badBeamNodes, conns) <-
             vertexConns (maxSupportCoordinates tfCfg) topNode groupedVertices
@@ -228,7 +228,7 @@ moveVerticesInVertexForest topNode newNames tfCfg vertexTrees =
               supportForest
               treesOrder
           Right (badBeamNodes, newForest)
-        Nothing -> Left "invalid breakpoint"
+        Left err -> Left err
 
 getVertexNamesInForest
   :: VertexForest -> M.Map (Scientific, Scientific, Scientific) Text
@@ -356,7 +356,7 @@ assignNames newNames brks treeType prefixMap av =
   let v = aVertex av
       updatedPrefix cleanPrefix' = M.findWithDefault cleanPrefix' cleanPrefix' newNames
       prefix = dropIndex (vName v)
-      typeSpecific = maybe "" prefixForType (determineGroup brks v)
+      typeSpecific = either (const "") prefixForType (determineGroup brks v)
       (prefix', lastChar) = fromMaybe (error "unreachable") (T.unsnoc prefix)
       isLmr = lastChar `elem` ['l', 'm', 'r']
       supportPrefixChar = T.singleton 's' <> bool typeSpecific (T.singleton lastChar) isLmr

src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs

@@ -7,6 +7,8 @@ module JbeamEdit.Transformation.VertexExtraction (
 ) where
 
 import Control.Monad (guard)
+import Control.Monad.Except (runExcept)
+import Control.Monad.Trans.Except (except)
 import Data.Char (isDigit)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
@@ -201,30 +203,28 @@ newVertexTree brks vertexNames badAcc vertexForest nodes =
       topComments = mapMaybe toInternalComment topNodes
       topMeta = M.unions . map metaMapFromObject $ topNodes
       vertexPrefix = getVertexPrefix' nodes'
-   in case breakVertices vertexPrefix vertexNames nodes' of
-        Left err -> Left err
-        Right (vertexNames', vertexNodes, rest') ->
-          case nodesToAnnotatedVertices topMeta vertexNodes of
-            Left err -> Left err
-            Right (badNodes, avNE) ->
-              let firstAV = NE.head avNE
-                  vertexTree = VertexTree topComments avNE
-               in case determineGroup brks (aVertex firstAV) of
-                    Just treeType ->
-                      let updatedForest = insertTreeInForest treeType vertexTree vertexForest
-                       in Right
-                            (vertexNames', badAcc <> badNodes, treeType, vertexTree, updatedForest, rest')
-                    Nothing -> Left "invalid breakpoint"
-
-determineGroup :: XGroupBreakpoints -> Vertex -> Maybe VertexTreeType
+   in runExcept
+        ( do
+            (vertexNames', vertexNodes, rest') <-
+              except (breakVertices vertexPrefix vertexNames nodes')
+            (badNodes, avNE) <- except (nodesToAnnotatedVertices topMeta vertexNodes)
+            let firstAV = NE.head avNE
+                vertexTree = VertexTree topComments avNE
+            treeType <- except . determineGroup brks . aVertex $ firstAV
+            let updatedForest = insertTreeInForest treeType vertexTree vertexForest
+            pure
+              (vertexNames', badAcc <> badNodes, treeType, vertexTree, updatedForest, rest')
+        )
+
+determineGroup :: XGroupBreakpoints -> Vertex -> Either Text VertexTreeType
 determineGroup (XGroupBreakpoints brks) v =
   case [vtype | (XGroupBreakpoint f brk, vtype) <- brks, applyOperator f (vX v) brk] of
-    (vtype : _) -> Just vtype
-    [] -> Nothing
+    (vtype : _) -> Right vtype
+    [] -> Left "invalid breakpoint"
 
-determineGroup' :: XGroupBreakpoints -> Vertex -> Maybe VertexTreeType
+determineGroup' :: XGroupBreakpoints -> Vertex -> Either Text VertexTreeType
 determineGroup' brks v
-  | isSupportVertex v = Just SupportTree
+  | isSupportVertex v = Right SupportTree
   | otherwise = determineGroup brks v
 
 nodesListToTree