From e996ccb1fe4f38a829939a7cf7abeda943e6eb90 Mon Sep 17 00:00:00 2001
From: Andreas Abel <andreas.abel@ifi.lmu.de>
Date: Tue, 6 Apr 2021 14:00:25 +0200
Subject: [PATCH] [ re #345 ] layout: cosmetical changes: simplifications, code
 formatting

---
 source/src/BNFC/Backend/Haskell/CFtoLayout.hs | 54 +++++++++----------
 1 file changed, 26 insertions(+), 28 deletions(-)

diff --git a/source/src/BNFC/Backend/Haskell/CFtoLayout.hs b/source/src/BNFC/Backend/Haskell/CFtoLayout.hs
index 9c571fb6..206ffaaa 100644
--- a/source/src/BNFC/Backend/Haskell/CFtoLayout.hs
+++ b/source/src/BNFC/Backend/Haskell/CFtoLayout.hs
@@ -9,8 +9,10 @@ module BNFC.Backend.Haskell.CFtoLayout where
 
 import Data.List (sort)
 import BNFC.CF
-import BNFC.Options (TokenText)
-import BNFC.Backend.Haskell.Utils
+import BNFC.Options               ( TokenText )
+import BNFC.PrettyPrint
+import BNFC.Utils                 ( table )
+import BNFC.Backend.Haskell.Utils ( tokenTextImport, tokenTextPackParens, tokenTextUnpack )
 
 layoutOpen  = "{"
 layoutClose = "}"
@@ -18,31 +20,27 @@ layoutSep   = ";"
 
 cf2Layout :: TokenText -> String -> String -> CF -> String
 cf2Layout tokenText layName lexName cf = unlines $ concat
-  [ [ "module " ++ layName ++ " where"
+  [ [ "-- Generated by the BNF Converter"
     , ""
-    , "import Prelude"
-    , ""
-    , "import " ++ lexName
+    , "module " ++ layName ++ " where"
     , ""
+    , "import Prelude"
     ]
   , tokenTextImport tokenText
-  , [ "import Data.Maybe (isNothing, fromJust)"
-    , ""
-    , "-- Generated by the BNF Converter"
+  , [ ""
+    , "import " ++ lexName
     , ""
     , "-- local parameters"
     , ""
-    , ""
     , "topLayout :: Bool"
     , "topLayout = " ++ show top
     , ""
     , "layoutWords, layoutStopWords :: [String]"
-    , "layoutWords     = " ++ show lay
-    , "layoutStopWords = " ++ show stop
+    , render $ prettyList 2 "layoutWords     =" "[" "]" "," $ map (text . show) lay
+    , render $ prettyList 2 "layoutStopWords =" "[" "]" "," $ map (text . show) stop
     , ""
     , "-- layout separators"
     , ""
-    , ""
     , "layoutOpen, layoutClose, layoutSep :: String"
     , "layoutOpen  = " ++ show layoutOpen
     , "layoutClose = " ++ show layoutClose
@@ -57,7 +55,7 @@ cf2Layout tokenText layName lexName cf = unlines $ concat
     , "  tl = tp && topLayout"
     , ""
     , "  res :: Maybe Token -- ^ The previous token, if any."
-    , "      -> [Block] -- ^ A stack of layout blocks."
+    , "      -> [Block]     -- ^ A stack of layout blocks."
     , "      -> [Token] -> [Token]"
     , ""
     , "  -- The stack should never be empty."
@@ -116,8 +114,7 @@ cf2Layout tokenText layName lexName cf = unlines $ concat
     , "                case st of"
     , "                  Implicit n:_"
     , "                    | newLine pt t0 && column t0 == n"
-    , "                      && not (isNothing pt ||"
-    , "                              isTokenIn [layoutSep,layoutOpen] (fromJust pt)) ->"
+    , "                      && maybe False (not . isTokenIn [layoutSep,layoutOpen]) pt ->"
     , "                     let b':t0':b'':_ ="
     , "                           addToken (afterPrev pt) layoutSep (t0:b:ts')"
     , "                     in moveAlong st' [b',t0',b''] ts'"
@@ -140,7 +137,7 @@ cf2Layout tokenText layName lexName cf = unlines $ concat
     , "       -- Insert a semicolon after the previous token."
     , "       -- unless we are the beginning of the file,"
     , "       -- or the previous token is a semicolon or open brace."
-    , "       if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt)"
+    , "       if maybe True (isTokenIn [layoutSep,layoutOpen]) pt"
     , "          then moveAlong st [t0] ts"
     , "          else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts)"
     , "                in moveAlong st [b,t0'] ts'"
@@ -155,8 +152,8 @@ cf2Layout tokenText layName lexName cf = unlines $ concat
     , "  -- If we are using top-level layout, insert a semicolon after"
     , "  -- the last token, if there isn't one already"
     , "  res (Just t) [Implicit _n] []"
-    , "      | isTokenIn [layoutSep] t = []"
-    , "      | otherwise = addToken (nextPos t) layoutSep []"
+    , "      | isLayoutSep t = []"
+    , "      | otherwise     = [sToken (nextPos t) layoutSep]"
     , ""
     , "  -- At EOF in an implicit, non-top-level block: close the block"
     , "  res (Just t) (Implicit _ : bs) [] ="
@@ -218,19 +215,16 @@ cf2Layout tokenText layName lexName cf = unlines $ concat
     , "-- | Get the position immediately to the right of the given token."
     , "nextPos :: Token -> Position"
     , "nextPos t = Pn (g + s) l (c + s + 1)"
-    , "  where Pn g l c = position t"
-    , "        s = tokenLength t"
+    , "  where"
+    , "  Pn g l c = position t"
+    , "  s        = tokenLength t"
     , ""
     , "-- | Create a symbol token."
     , "sToken :: Position -> String -> Token"
-    , "sToken p s = PT p (TS " ++ tokenTextPackParens tokenText "s" ++ " i)"
-    , "  where"
-    , "    i = case s of"
-    ]
-  , [ "      " ++ show s ++ " -> " ++ show i
-      | (s, i) <- zip resws [1..]
+    , "sToken p s = PT p $ TS " ++ tokenTextPackParens tokenText "s" ++ " $ case s of"
     ]
-  , [ "      _ -> error $ \"not a reserved word: \" ++ show s"
+  , map ("    " ++) $ table " -> " $ zipWith (\ s n -> [show s, show n]) resws [1..]
+  , [ "    _ -> error $ \"not a reserved word: \" ++ show s"
     , ""
     , "-- | Get the position of a token."
     , "position :: Token -> Position"
@@ -264,6 +258,10 @@ cf2Layout tokenText layName lexName cf = unlines $ concat
     , "isLayoutOpen :: Token -> Bool"
     , "isLayoutOpen = isTokenIn [layoutOpen]"
     , ""
+    , "-- | Check if a token is the layout separator token."
+    , "isLayoutSep :: Token -> Bool"
+    , "isLayoutSep = isTokenIn [layoutSep]"
+    , ""
     , "-- | Check if a token is the layout close token."
     , "isLayoutClose :: Token -> Bool"
     , "isLayoutClose = isTokenIn [layoutClose]"