Optimizations

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

src-extra/transformation/JbeamEdit/Transformation.hs

@@ -4,7 +4,7 @@
 import Data.Bool (bool)
 import Data.Foldable.Extra (notNull)
 import Data.Function (on)
 import Data.List (foldl', partition)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Map (Map)
@@ -71,7 +71,7 @@
 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 @@
   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 @@
         [ (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 @@
               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 @@
   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

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
 

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

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

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,33 +47,33 @@ 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
   :: RuleSet
   -> 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

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 =