diff --git a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs index 026760ba..c547de8a 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs @@ -12,6 +12,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding (encodeUtf8) +import Data.Text.Lazy qualified as TL import GHC.Generics (Generic) import JbeamEdit.Core.Node (Node) import JbeamEdit.Formatting qualified as Fmt @@ -76,7 +77,7 @@ handleParams rs logger params responder = do runFormatNode :: RuleSet -> T.Text -> Node -> Maybe J.TextEdit runFormatNode ruleSet txt node = - let newText = Fmt.formatNode ruleSet node + let newText = TL.toStrict $ Fmt.formatNode ruleSet node edit = J.TextEdit { J._range = wholeRange txt diff --git a/src-extra/transformation/JbeamEdit/Transformation.hs b/src-extra/transformation/JbeamEdit/Transformation.hs index b49574ca..66d02576 100644 --- a/src-extra/transformation/JbeamEdit/Transformation.hs +++ b/src-extra/transformation/JbeamEdit/Transformation.hs @@ -71,7 +71,7 @@ addPrefixComments SupportTree trees = trees addPrefixComments _ trees = bool trees (fmap addToAnnotatedVertex trees) (length trees > 1) where addToAnnotatedVertex (VertexTree [] namedVertexGroups) = - let commentName = dropIndex . vName . aVertex . NE.head $ namedVertexGroups + let commentName = dropIndex . anVertexName . NE.head $ namedVertexGroups newComment = InternalComment ("prefix group " <> commentName) False NextNode in VertexTree [newComment] namedVertexGroups addToAnnotatedVertex (VertexTree comments namedVertexGroups) = VertexTree comments namedVertexGroups @@ -107,7 +107,7 @@ groupByPrefix origTree = OMap1.fromNEList . sortByKeyOrderNE origTree . NE.map (prefixForVertexKey origTree) - . NE.groupWith1 (dropIndex . vName . aVertex) + . NE.groupWith1 (dropIndex . anVertexName) commentsExists :: Maybe (OMap1 VertexTreeKey VertexTree) -> Bool commentsExists = any (notNull . tComments . OMap1.head) @@ -159,7 +159,7 @@ moveSupportVertices newNames tfCfg connMap vsPerType = [ (vType, av) | (vType, vs) <- M.toList vsPerType , av <- vs - , let name = vName (aVertex av) + , let name = anVertexName av , let vertexCount = length vs thrCount = max 1 (round $ supportThreshold tfCfg / 100 * fromIntegral vertexCount) @@ -317,7 +317,7 @@ vertexForestToNodeVector initialMeta vf = oMap (_, listsOfNodes) = mapAccumL stepType initialMeta treesOrder - in V.fromList (concat listsOfNodes) + in foldMap V.fromList listsOfNodes treesOrder :: [VertexTreeType] treesOrder = [LeftTree, MiddleTree, RightTree, SupportTree] @@ -328,7 +328,7 @@ compareAV thr treeType vertex1 vertex2 = let supportNameCompare = bool EQ - (on compare (dropIndex . vName . aVertex) vertex1 vertex2) + (on compare (dropIndex . anVertexName) vertex1 vertex2) (treeType == SupportTree) y1 = vY . aVertex $ vertex1 y2 = vY . aVertex $ vertex2 diff --git a/src-extra/transformation/JbeamEdit/Transformation/Types.hs b/src-extra/transformation/JbeamEdit/Transformation/Types.hs index c490784e..97ab85d4 100644 --- a/src-extra/transformation/JbeamEdit/Transformation/Types.hs +++ b/src-extra/transformation/JbeamEdit/Transformation/Types.hs @@ -63,6 +63,7 @@ data AnnotatedVertex = AnnotatedVertex } deriving (Eq, Show) +{-# INLINE anVertexName #-} anVertexName :: AnnotatedVertex -> Text anVertexName = vName . aVertex diff --git a/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs b/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs index 1ac9902b..e3e4b74c 100644 --- a/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs +++ b/src-extra/transformation/JbeamEdit/Transformation/VertexExtraction.hs @@ -34,14 +34,21 @@ import JbeamEdit.Transformation.Types verticesQuery :: NP.NodePath verticesQuery = fromList [NP.ObjectIndex 0, NP.ObjectKey "nodes"] +{-# INLINE newVertex #-} newVertex :: Node -> Maybe Vertex -newVertex (Array ns) = f . V.toList $ ns - where - f [String name, Number x, Number y, Number z, Object m] = - Just (Vertex {vName = name, vX = x, vY = y, vZ = z, vMeta = Just m}) - f [String name, Number x, Number y, Number z] = - Just (Vertex {vName = name, vX = x, vY = y, vZ = z, vMeta = Nothing}) - f _ = Nothing +newVertex (Array ns) = + case V.length ns of + 4 -> + case (ns V.! 0, ns V.! 1, ns V.! 2, ns V.! 3) of + (String name, Number x, Number y, Number z) -> + Just (Vertex name x y z Nothing) + _ -> Nothing + 5 -> + case (ns V.! 0, ns V.! 1, ns V.! 2, ns V.! 3, ns V.! 4) of + (String name, Number x, Number y, Number z, Object m) -> + Just (Vertex name x y z (Just m)) + _ -> Nothing + _ -> Nothing newVertex _ = Nothing isNonVertex :: Node -> Bool diff --git a/src/JbeamEdit/Core/Node.hs b/src/JbeamEdit/Core/Node.hs index dca96190..8a7e0bbd 100644 --- a/src/JbeamEdit/Core/Node.hs +++ b/src/JbeamEdit/Core/Node.hs @@ -121,7 +121,7 @@ possiblyChildren n = expectArray n <|> expectObject n moreNodesThanOne :: Vector Node -> Bool moreNodesThanOne v - | len == 1 = any moreNodesThanOne . possiblyChildren $ V.head v + | len == 1 = any moreNodesThanOne . possiblyChildren $ V.unsafeHead v | len > 1 = True | otherwise = False where diff --git a/src/JbeamEdit/Formatting.hs b/src/JbeamEdit/Formatting.hs index 22c22a95..a6a4bea9 100644 --- a/src/JbeamEdit/Formatting.hs +++ b/src/JbeamEdit/Formatting.hs @@ -9,15 +9,16 @@ module JbeamEdit.Formatting ( ) where import Data.Bool (bool) -import Data.ByteString.Lazy qualified as LBS (fromStrict) import Data.Char (isSpace) import Data.Foldable.Extra (notNull) +import Data.Int import Data.Maybe (fromMaybe) import Data.Monoid.Extra -import Data.Scientific (FPFormat (Fixed), formatScientific) -import Data.Text (Text) import Data.Text qualified as T -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.Builder qualified as TLB (toLazyText) +import Data.Text.Lazy.Builder.Scientific +import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Vector (Vector) import Data.Vector qualified as V import JbeamEdit.Core.Node ( @@ -46,22 +47,22 @@ import JbeamEdit.Formatting.Rules ( import System.File.OsPath qualified as OS (writeFile) import System.OsPath (OsPath) -splitTrailing :: Bool -> Text -> (Text, Text) +splitTrailing :: Bool -> TL.Text -> (TL.Text, TL.Text) splitTrailing comma txt = - let trailing = T.length (T.takeWhileEnd (== ' ') txt) + let trailing = TL.length (TL.takeWhileEnd (== ' ') txt) trailing' = trailing - bool 0 1 comma - in ( T.dropEnd trailing txt - , T.replicate trailing' " " + in ( TL.dropEnd trailing txt + , TL.replicate trailing' " " ) normalizeCommentNode :: Bool -> Node -> Node normalizeCommentNode False (Comment (InternalComment txt False dir)) = Comment (InternalComment txt True dir) normalizeCommentNode _ node = node -singleCharIf :: Char -> Bool -> Text -singleCharIf a b = mwhen b (T.singleton a) +singleCharIf :: Char -> Bool -> TL.Text +singleCharIf a b = mwhen b (TL.singleton a) -singleCharIfNot :: Char -> Bool -> Text +singleCharIfNot :: Char -> Bool -> TL.Text singleCharIfNot a b = singleCharIf a (not b) addDelimiters @@ -69,10 +70,10 @@ addDelimiters -> Int -> NC.NodeCursor -> Bool - -> (Bool, Vector Int) -- (usePad, columnWidths) - -> [Text] + -> (Bool, Vector Int64) -- (usePad, columnWidths) + -> [TL.Text] -> [Node] - -> [Text] + -> [TL.Text] addDelimiters _ _ _ _ _ acc [] = acc addDelimiters rs index c complexChildren (usePad, colWidths) acc ns@(node : rest) | complexChildren && null acc = @@ -115,36 +116,35 @@ addDelimiters rs index c complexChildren (usePad, colWidths) acc ns@(node : rest if usePad && not (isCommentNode node) && comma then let width = sum (colWidths V.!? index) - in T.justifyLeft (width + 1) ' ' baseTxt + in TL.justifyLeft (width + 1) ' ' baseTxt else baseTxt comma = notNull rest space = notNull rest && not complexChildren newline = complexChildren -applyIndentation :: Int -> Text -> Text +applyIndentation :: Int64 -> TL.Text -> TL.Text applyIndentation n s - | T.all isSpace s = s - | otherwise = T.replicate n " " <> s + | TL.all isSpace s = s + | otherwise = TL.replicate n " " <> s skipHeaderRow :: Vector (Vector Node) -> Vector (Vector Node) -skipHeaderRow nodes = - case V.uncons nodes of - Just (headerRow, rest) -> - bool nodes rest (all isStringNode headerRow) - Nothing -> nodes +skipHeaderRow nodes + | V.length nodes > 1 = + bool nodes (V.unsafeTail nodes) (all isStringNode $ V.unsafeHead nodes) + | otherwise = nodes maxColumnLengths - :: RuleSet -> NC.NodeCursor -> Vector (Vector Node) -> Vector Int + :: RuleSet -> NC.NodeCursor -> Vector (Vector Node) -> Vector Int64 maxColumnLengths rs cursor rows | V.null rows = V.empty | otherwise = V.map - (V.maximum . V.map T.length) + (V.maximum . V.map TL.length) (transposeWithPadding rs cursor $ skipHeaderRow rows) transposeWithPadding - :: RuleSet -> NC.NodeCursor -> Vector (Vector Node) -> Vector (Vector T.Text) + :: RuleSet -> NC.NodeCursor -> Vector (Vector Node) -> Vector (Vector TL.Text) transposeWithPadding rs cursor vvs = let numCols = V.maximum (V.map V.length vvs) in V.generate numCols $ \j -> @@ -159,9 +159,9 @@ transposeWithPadding rs cursor vvs = doFormatNode :: RuleSet -> NC.NodeCursor - -> (Bool, Vector Int) + -> (Bool, Vector Int64) -> Vector Node - -> Text + -> TL.Text doFormatNode rs cursor padAmounts nodes = let autoPadEnabled = lookupPropertyForCursor ExactMatch AutoPad rs cursor == Just True @@ -181,74 +181,68 @@ doFormatNode rs cursor padAmounts nodes = fromMaybe 2 (lookupPropertyForCursor PrefixMatch Indent rs cursor) in if complexChildren then - T.unlines + TL.unlines . map (applyIndentation indentationAmount) - . concatMap T.lines + . concatMap TL.lines $ formatted - else T.concat formatted + else TL.concat formatted where complexChildren = forceComplexNewLine rs cursor || any (liftA2 (||) isSinglelineComment isComplexNode) nodes && not (noComplexNewLine rs cursor) -formatComment :: InternalComment -> Text -formatComment (InternalComment {cMultiline = False, cText = c}) = "// " <> c +formatComment :: InternalComment -> TL.Text +formatComment (InternalComment {cMultiline = False, cText = c}) = "// " <> TL.fromStrict c formatComment (InternalComment {cMultiline = True, cText = c}) = "/*" <> leadingSpace - <> c + <> TL.fromStrict c <> trailingSpace <> "*/" where leadingSpace = singleCharIfNot ' ' (T.isPrefixOf "\n" c) trailingSpace = singleCharIfNot ' ' (T.isSuffixOf "\n" c) -formatScalarNode :: Node -> Text -formatScalarNode (String s) = T.concat ["\"", s, "\""] -formatScalarNode (Number n) = T.pack (formatScientific Fixed Nothing n) +formatScalarNode :: Node -> TL.Text +formatScalarNode (String s) = "\"" <> TL.fromStrict s <> "\"" +formatScalarNode (Number n) = TLB.toLazyText $ formatScientificBuilder Fixed Nothing n formatScalarNode (Bool True) = "true" formatScalarNode (Bool _) = "false" formatScalarNode Null = "null" formatScalarNode _ = error "Unhandled scalar node" formatWithCursor - :: RuleSet -> (Bool, Vector Int) -> NC.NodeCursor -> Node -> Text + :: RuleSet -> (Bool, Vector Int64) -> NC.NodeCursor -> Node -> TL.Text formatWithCursor rs (_, maybePadAmounts) cursor (Array a) | V.null a = "[]" | otherwise = - T.concat - [ "[" - , doFormatNode rs cursor (notNull maybePadAmounts, maybePadAmounts) a - , "]" - ] + "[" + <> doFormatNode rs cursor (notNull maybePadAmounts, maybePadAmounts) a + <> "]" formatWithCursor rs (_, maybePadAmounts) cursor (Object o) | V.null o = "{}" | otherwise = - T.concat - [ "{" - , doFormatNode rs cursor (notNull maybePadAmounts, maybePadAmounts) o - , "}" - ] + "{" + <> doFormatNode rs cursor (notNull maybePadAmounts, maybePadAmounts) o + <> "}" formatWithCursor rs (_, maybePadAmounts) cursor (ObjectKey (k, v)) = - T.concat - [ formatWithCursor rs (notNull maybePadAmounts, maybePadAmounts) cursor k - , " : " - , formatWithCursor rs (notNull maybePadAmounts, maybePadAmounts) cursor v - ] + formatWithCursor rs (notNull maybePadAmounts, maybePadAmounts) cursor k + <> " : " + <> formatWithCursor rs (notNull maybePadAmounts, maybePadAmounts) cursor v formatWithCursor _ _ _ (Comment comment) = formatComment comment formatWithCursor rs _ cursor n = let ps = findPropertiesForCursor PrefixMatch cursor rs in applyPadLogic formatScalarNode ps n -formatNode :: RuleSet -> Node -> Text -formatNode rs node = formatWithCursor rs (False, V.empty) newCursor node <> T.singleton '\n' +formatNode :: RuleSet -> Node -> TL.Text +formatNode rs node = formatWithCursor rs (False, V.empty) newCursor node <> TL.singleton '\n' #ifdef ENABLE_WINDOWS_NEWLINES -replaceNewlines :: Text -> Text -replaceNewlines = T.replace "\n" "\r\n" +replaceNewlines :: TL.Text -> TL.Text +replaceNewlines = TL.replace "\n" "\r\n" #else -replaceNewlines :: Text -> Text +replaceNewlines :: TL.Text -> TL.Text replaceNewlines = id #endif @@ -259,7 +253,6 @@ formatNodeAndWrite -> IO () formatNodeAndWrite rs outFile = OS.writeFile outFile - . LBS.fromStrict . encodeUtf8 . replaceNewlines . formatNode rs diff --git a/src/JbeamEdit/Formatting/Rules.hs b/src/JbeamEdit/Formatting/Rules.hs index e2289d64..6bd9c942 100644 --- a/src/JbeamEdit/Formatting/Rules.hs +++ b/src/JbeamEdit/Formatting/Rules.hs @@ -25,6 +25,7 @@ module JbeamEdit.Formatting.Rules ( import Data.Bool (bool) import Data.Foldable (fold) import Data.Function (on) +import Data.Int import Data.List (find) import Data.Map (Map) import Data.Map qualified as M @@ -33,6 +34,7 @@ import Data.Sequence (Seq (..)) import Data.Sequence qualified as Seq (length, null) import Data.Text (Text) import Data.Text qualified as T +import Data.Text.Lazy qualified as TL import Data.Type.Equality ((:~:) (Refl)) import JbeamEdit.Core.Node import JbeamEdit.Core.NodeCursor qualified as NC @@ -73,9 +75,9 @@ data PropertyKey a where AutoPad :: PropertyKey Bool NoComplexNewLine :: PropertyKey Bool ForceComplexNewLine :: PropertyKey Bool - PadAmount :: PropertyKey Int - PadDecimals :: PropertyKey Int - Indent :: PropertyKey Int + PadAmount :: PropertyKey Int64 + PadDecimals :: PropertyKey Int64 + Indent :: PropertyKey Int64 data SomeKey = forall a. @@ -179,23 +181,23 @@ lookupProp targetKey m = Nothing -> Nothing Nothing -> Nothing -applyDecimalPadding :: Int -> Text -> Text +applyDecimalPadding :: Int64 -> TL.Text -> TL.Text applyDecimalPadding padDecimals node | padDecimals /= 0 = - let (int, frac) = T.breakOnEnd "." node - paddedFrac = T.justifyLeft padDecimals '0' frac + let (int, frac) = TL.breakOnEnd "." node + paddedFrac = TL.justifyLeft padDecimals '0' frac in int <> paddedFrac - | T.isSuffixOf ".0" node = T.dropEnd 2 node + | TL.isSuffixOf ".0" node = TL.dropEnd 2 node | otherwise = node -applyPadLogic :: (Node -> Text) -> Rule -> Node -> Text +applyPadLogic :: (Node -> TL.Text) -> Rule -> Node -> TL.Text applyPadLogic f rs n = let padAmount = sum $ lookupProp PadAmount rs padDecimals = sum $ lookupProp PadDecimals rs decimalPaddedText | isNumberNode n = applyDecimalPadding padDecimals (f n) | otherwise = f n - in bool (T.justifyLeft padAmount ' ' decimalPaddedText) (f n) (isComplexNode n) + in bool (TL.justifyLeft padAmount ' ' decimalPaddedText) (f n) (isComplexNode n) forceComplexNewLine :: RuleSet -> NC.NodeCursor -> Bool forceComplexNewLine rs cursor = diff --git a/src/JbeamEdit/IOUtils.hs b/src/JbeamEdit/IOUtils.hs index cd1ada15..698d046b 100644 --- a/src/JbeamEdit/IOUtils.hs +++ b/src/JbeamEdit/IOUtils.hs @@ -39,7 +39,7 @@ reportInvalidNodes :: Text -> [Node] -> IO () reportInvalidNodes msg nodes = unless (null nodes) $ putErrorLine msg - >> mapM_ (putErrorLine . formatNode mempty) nodes + >> mapM_ (putErrorLine . TL.toStrict . formatNode mempty) nodes ioErrorMsg :: [IOErrorType] diff --git a/test-extra/transformation/Spec.hs b/test-extra/transformation/Spec.hs index fc721a67..817bbb14 100644 --- a/test-extra/transformation/Spec.hs +++ b/test-extra/transformation/Spec.hs @@ -4,7 +4,7 @@ module Spec ( import Data.List (isPrefixOf, isSuffixOf) import Data.Map qualified as M -import Data.Text qualified as T +import Data.Text.Lazy qualified as TL import JbeamEdit.Formatting import JbeamEdit.Transformation import JbeamEdit.Transformation.Config @@ -36,7 +36,8 @@ topNodeSpec rs cfName tfConfig inFilename outFilename = do do (_, _, _, node) <- transform M.empty tfConfig (read input) Right (formatNode rs node) - describe desc . it "works" $ transformAndFormat `shouldBe` Right (T.pack output) + describe desc . it "works" $ + transformAndFormat `shouldBe` Right (TL.pack output) main :: IO () main = hspec $ do diff --git a/test/FormattingSpec.hs b/test/FormattingSpec.hs index 989d3dfa..5a823340 100644 --- a/test/FormattingSpec.hs +++ b/test/FormattingSpec.hs @@ -5,6 +5,7 @@ module FormattingSpec ( import Control.Monad (forM, forM_) import Data.Text (Text) import Data.Text qualified as T +import Data.Text.Lazy qualified as TL import GHC.IsList (fromList) import JbeamEdit.Core.NodeCursor (newCursor) import JbeamEdit.Formatting @@ -72,7 +73,7 @@ dynamicJbflTests = do outFile = formattedDir (baseName ++ "-jbfl.jbeam") expected <- T.pack <$> readFile outFile - pure (outFile, formatted, expected) + pure (outFile, TL.toStrict formatted, expected) spec :: Spec spec = do @@ -88,7 +89,7 @@ spec = do descFun shouldBe (formatWithCursor mempty (False, mempty) newCursor node) - (T.pack jbeam) + (TL.pack jbeam) descFun jbeam node = "should format " ++ show node ++ " as " ++ jbeam specs = concat diff --git a/tools/dump_ast/Main.hs b/tools/dump_ast/Main.hs index 16025217..654b2071 100644 --- a/tools/dump_ast/Main.hs +++ b/tools/dump_ast/Main.hs @@ -6,7 +6,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.List (isPrefixOf, isSuffixOf) import Data.Map qualified as M import Data.Text qualified as T -import Data.Text.Lazy qualified as LT +import Data.Text.Lazy qualified as TL import JbeamEdit.Formatting import JbeamEdit.Parsing.DSL (parseDSL) import JbeamEdit.Parsing.Jbeam (parseNodes) @@ -83,7 +83,7 @@ dumpFormattedJbeam' jbflDir outDir ruleFile jbeamFile = do (Right rs) <- parseDSL <$> LBS.readFile ruleFile (Right rs') <- parseDSL <$> LBS.readFile (jbflDir "minimal.jbfl") let outFilename = takeBaseName jbeamFile ++ "-" ++ takeBaseName ruleFile ++ "-jbfl.jbeam" - in dump outFilename (T.unpack $ formatNode (rs <> rs') jbeam) + in dump outFilename (TL.unpack $ formatNode (rs <> rs') jbeam) where dump filename contents = let outFile = outDir filename @@ -103,7 +103,7 @@ saveAstDump outFile contents = pStringOpt defaultOutputOptionsNoColor {outputOptionsStringStyle = Literal} (show contents ++ "\n") - in saveDump outFile (LT.unpack formatted) + in saveDump outFile (TL.unpack formatted) dumpJbflAST :: FilePath -> String -> String -> IO FilePath dumpJbflAST dir outDir filename = do @@ -132,7 +132,7 @@ dumpFormattedJbeam outDir (jbeamFile, ruleFile) = do jbeam <- read <$> IO.readFile (dropExtension jbeamFile ++ ".hs") rs <- read <$> IO.readFile (dropExtension ruleFile ++ ".hs") let outFilename = takeBaseName jbeamFile ++ "-" ++ takeBaseName ruleFile ++ "-jbfl.jbeam" - in dump outFilename (T.unpack $ formatNode rs jbeam) + in dump outFilename (TL.unpack $ formatNode rs jbeam) where dump filename contents = let outFile = outDir filename @@ -184,7 +184,7 @@ dumpTransformedJbeam cfName tfConfig jbeamDir rsDirPath jbeamInputAstDir outDir outDir cfName >> pure jbeam' - dump outFilename (T.unpack $ formatNode rs transformedJbeam) + dump outFilename (TL.unpack $ formatNode rs transformedJbeam) where dump filename contents = let outFile = outDir filename