From d9373ec80ec925a07d34f9c6ae4d00146bf88334 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Sat, 18 Mar 2023 17:48:30 +0000
Subject: [PATCH] Implement extension support - OverloadedRecordDot

---
 data/11-extensions/overloadedrecorddot.blt    | 24 ++++++++++++
 .../Brittany/Internal/ToBriDoc/Expr.hs        | 37 ++++++++++++++++---
 2 files changed, 55 insertions(+), 6 deletions(-)
 create mode 100644 data/11-extensions/overloadedrecorddot.blt

diff --git a/data/11-extensions/overloadedrecorddot.blt b/data/11-extensions/overloadedrecorddot.blt
new file mode 100644
index 0000000..7586a9d
--- /dev/null
+++ b/data/11-extensions/overloadedrecorddot.blt
@@ -0,0 +1,24 @@
+#group extensions/overloadedrecorddot
+
+#test getfield
+{-# LANGUAGE OverloadedRecordDot #-}
+recorddot1 = a.b.c
+
+#test getfield
+{-# LANGUAGE OverloadedRecordDot #-}
+recorddot2 =
+  {-before-}a.b.c{-after-}
+
+#test projection
+{-# LANGUAGE OverloadedRecordDot #-}
+recorddot3 =
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+    & (.bbbbbbbbbbbbbbbbbbbbbbbbbbb)
+    & (.ccccccccccccccccccccccccccccccccccccc)
+    & (.ddddddddddddddddddddddddddddddddddddddddddddddddddd)
+
+#test projection too long
+{-# LANGUAGE OverloadedRecordDot #-}
+recorddot4 =
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+    & (.bbbbbbbbbbbbbbbbbbbbbbbbbbb.ccccccccccccccccccccccccccccccccccccc.ddddddddddddddddddddddddddddddddddddddddddddddddddd)
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
index 7d7c835..a8e5bf0 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs
@@ -980,6 +980,37 @@ layoutExpr lexpr@(L _ expr) = do
           , docForceSingleline eNDoc
           , docLit $ Text.pack "]"
           ]
+    HsGetField _epAnn _exp1 _field -> do
+      let
+        labelLayouter label = case label of
+          L flAnn (HsFieldLabel _ (L _ n)) ->
+            docHandleComms flAnn $ docLitS $ FastString.unpackFS n
+          L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
+        gather
+          :: [ToBriDocM BriDocNumbered]
+          -> LHsExpr GhcPs
+          -> (LHsExpr GhcPs, [ToBriDocM BriDocNumbered])
+        gather list = \case
+          L _ (HsGetField epAnn l r) -> gather
+            (docHandleComms epAnn $ labelLayouter r : list) l
+          x -> (x, list)
+      let (headE, paramEs) = gather
+            []
+            lexpr
+      expDoc <- shareDoc $ layoutExpr headE
+      -- this only has single-line layout, afaik
+      docForceSingleline $ docSeq $ intersperse (docLitS ".") (expDoc: paramEs)
+    HsProjection epAnn (f1 :| fR) -> do
+      let
+        labelLayouter label = case label of
+          L flAnn (HsFieldLabel _ (L _ n)) ->
+            docHandleComms flAnn $ docLitS $ FastString.unpackFS n
+          L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
+      docForceSingleline $ docHandleComms epAnn $ docSeq
+        (  [ docLitS "(" ]
+        ++ [ doc | f <- f1:fR, doc <- [docLitS ".", labelLayouter f] ]
+        ++ [ docLitS ")" ]
+        )
     ArithSeq{} -> briDocByExactInlineOnly "ArithSeq" lexpr
     HsBracket{} -> do
       -- TODO
@@ -1023,12 +1054,6 @@ layoutExpr lexpr@(L _ expr) = do
     HsPragE{} -> do
       -- TODO
       briDocByExactInlineOnly "HsPragE{}" lexpr
-    HsGetField{} -> do
-      -- TODO
-      briDocByExactInlineOnly "HsGetField{}" lexpr
-    HsProjection{} -> do
-      -- TODO
-      briDocByExactInlineOnly "HsGetField{}" lexpr
 
 recordExpression
   :: Bool