From 86706cdb4497a0188d176555ab5e5af566d094bc Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Mon, 22 Dec 2025 12:50:31 +0100 Subject: [PATCH 1/2] Refactored newVertexTree --- jbeam-edit.cabal | 1 + package.yaml | 2 +- .../JbeamEdit/Transformation.hs | 8 ++-- .../Transformation/VertexExtraction.hs | 41 ++++++++++--------- 4 files changed, 27 insertions(+), 25 deletions(-) diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index efec9fca..ec40ef0b 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -157,6 +157,7 @@ library jbeam-edit-transformation build-depends: extra, ordered-containers, + transformers, yaml else diff --git a/package.yaml b/package.yaml index 26219c53..c4260d6f 100644 --- a/package.yaml +++ b/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 diff --git a/src-extra/transformation/JbeamEdit/Transformation.hs b/src-extra/transformation/JbeamEdit/Transformation.hs index 035bc368..c197b61f 100644 --- a/src-extra/transformation/JbeamEdit/Transformation.hs +++ b/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 diff --git a/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs b/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs index 974638db..b691867d 100644 --- a/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs +++ b/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,29 @@ 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 From 6b81bdd9ecbc13627a845974250264093063fb14 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Mon, 22 Dec 2025 12:57:46 +0100 Subject: [PATCH 2/2] Ran formatter --- .../transformation/JbeamEdit/Transformation/VertexExtraction.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs b/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs index b691867d..c74b009a 100644 --- a/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs +++ b/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs @@ -216,7 +216,6 @@ newVertexTree brks vertexNames badAcc vertexForest nodes = (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