{-
    BNF Converter: Layout handling Generator
    Copyright (C) 2004  Author:  Aarne Ranta
    Copyright (C) 2005  Bjorn Bringert

-}

{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Haskell.CFtoLayout where

import Data.Maybe                 ( fromMaybe, mapMaybe )

import BNFC.CF
import BNFC.PrettyPrint
import BNFC.Utils                 ( caseMaybe, for, whenJust )

data TokSymbol = TokSymbol String Int
  deriving Int -> TokSymbol -> ShowS
[TokSymbol] -> ShowS
TokSymbol -> String
(Int -> TokSymbol -> ShowS)
-> (TokSymbol -> String)
-> ([TokSymbol] -> ShowS)
-> Show TokSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokSymbol] -> ShowS
$cshowList :: [TokSymbol] -> ShowS
show :: TokSymbol -> String
$cshow :: TokSymbol -> String
showsPrec :: Int -> TokSymbol -> ShowS
$cshowsPrec :: Int -> TokSymbol -> ShowS
Show

data LayoutDelimiters = LayoutDelimiters TokSymbol (Maybe TokSymbol) (Maybe TokSymbol)
  deriving Int -> LayoutDelimiters -> ShowS
[LayoutDelimiters] -> ShowS
LayoutDelimiters -> String
(Int -> LayoutDelimiters -> ShowS)
-> (LayoutDelimiters -> String)
-> ([LayoutDelimiters] -> ShowS)
-> Show LayoutDelimiters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutDelimiters] -> ShowS
$cshowList :: [LayoutDelimiters] -> ShowS
show :: LayoutDelimiters -> String
$cshow :: LayoutDelimiters -> String
showsPrec :: Int -> LayoutDelimiters -> ShowS
$cshowsPrec :: Int -> LayoutDelimiters -> ShowS
Show

cf2Layout :: String -> String -> CF -> String
cf2Layout :: String -> String -> CF -> String
cf2Layout String
layName String
lexName CF
cf = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ String
"{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}"
    , String
""
    , String
"{-# LANGUAGE LambdaCase #-}"
    , String
"{-# LANGUAGE PatternGuards #-}"
    , String
"{-# LANGUAGE OverloadedStrings #-}"
    , String
""
    , String
"module " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
layName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" where"
    , String
""
    , String
"import Prelude"
    , String
"import Data.Maybe ( fromMaybe, listToMaybe, mapMaybe )"
    , String
"import qualified Data.List as List"
    , String
""
    , String
"import " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
lexName
    , String
"  ( Posn(..), Tok(..), Token(..), TokSymbol(..)"
    , String
"  , prToken, tokenLineCol, tokenPos, tokenPosn"
    , String
"  )"
    , String
""
    , String
"-- local parameters"
    , String
""
    , String
"data LayoutDelimiters"
    , String
"  = LayoutDelimiters"
    , String
"    { delimSep   :: TokSymbol"
    , String
"    , delimOpen  :: Maybe TokSymbol  -- ^ Nothing for toplevel layout."
    , String
"    , delimClose :: Maybe TokSymbol  -- ^ Nothing for toplevel layout."
    , String
"    }"
    , String
""
    , String
"layoutWords :: [(TokSymbol, LayoutDelimiters)]"
    , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
2 Doc
"layoutWords =" Doc
"[" Doc
"]" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
        [(TokSymbol, LayoutDelimiters)]
-> ((TokSymbol, LayoutDelimiters) -> Doc) -> [Doc]
forall a b. [a] -> (a -> b) -> [b]
for [(TokSymbol, LayoutDelimiters)]
lay (((TokSymbol, LayoutDelimiters) -> Doc) -> [Doc])
-> ((TokSymbol, LayoutDelimiters) -> Doc) -> [Doc]
forall a b. (a -> b) -> a -> b
$ \ (TokSymbol
kw, LayoutDelimiters
delims) ->
          Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
0 Doc
empty Doc
"(" Doc
")" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
            (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text [ TokSymbol -> String
forall a. Show a => a -> String
show TokSymbol
kw, LayoutDelimiters -> String
forall a. Show a => a -> String
show LayoutDelimiters
delims ]
    , String
""
    , String
"layoutStopWords :: [TokSymbol]"
    , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
2 Doc
"layoutStopWords =" Doc
"[" Doc
"]" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TokSymbol -> Doc) -> [TokSymbol] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (TokSymbol -> String) -> TokSymbol -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokSymbol -> String
forall a. Show a => a -> String
show) [TokSymbol]
stop
    , String
""
    , String
"-- layout separators"
    , String
""
    , String
"layoutOpen, layoutClose, layoutSep :: [TokSymbol]"
    , String
"layoutOpen  = List.nub $ mapMaybe (delimOpen  . snd) layoutWords"
    , String
"layoutClose = List.nub $ mapMaybe (delimClose . snd) layoutWords"
    , [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ String
"layoutSep   = List.nub $" ]
      , Maybe TokSymbol -> (TokSymbol -> [String]) -> [String]
forall m a. Monoid m => Maybe a -> (a -> m) -> m
whenJust Maybe TokSymbol
top ((TokSymbol -> [String]) -> [String])
-> (TokSymbol -> [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ \ TokSymbol
sep -> [ TokSymbol -> String
forall a. Show a => a -> String
show TokSymbol
sep, String
":" ]
      , [ String
"map (delimSep . snd) layoutWords" ]
      ]
    , String
""
    , String
"parenOpen, parenClose :: [TokSymbol]"
    , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
2 Doc
"parenOpen  =" Doc
"[" Doc
"]" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TokSymbol -> Doc) -> [TokSymbol] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (TokSymbol -> String) -> TokSymbol -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokSymbol -> String
forall a. Show a => a -> String
show) [TokSymbol]
parenOpen
    , Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
2 Doc
"parenClose =" Doc
"[" Doc
"]" Doc
"," ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TokSymbol -> Doc) -> [TokSymbol] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (TokSymbol -> String) -> TokSymbol -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokSymbol -> String
forall a. Show a => a -> String
show) [TokSymbol]
parenClose
    , String
""
    , String
"-- | Report an error during layout resolution."
    , String
"layoutError"
    , String
"   :: [Token]  -- ^ Remaining tokens."
    , String
"   -> String   -- ^ Error message."
    , String
"   -> a"
    , String
"layoutError ts msg"
    , String
"  | null ts   = error $ concat [ \"Layout error: \", msg, \".\" ]"
    , String
"  | otherwise = error $ unlines"
    , String
"      [ concat [ \"Layout error at \", tokenPos ts, \": \", msg, \".\" ]"
    , String
"      , unwords $ concat"
    , String
"         [ [ \"Remaining tokens:\" ]"
    , String
"         , map prToken $ take 10 ts"
    , String
"         , [ \"...\" | not $ null $ drop 10 ts ]"
    , String
"         ]"
    , String
"      ]"
    , String
""
    , String
"-- | Replace layout syntax with explicit layout tokens."
    , String
"resolveLayout"
    , String
"  :: Bool      -- ^ Whether to use top-level layout."
    , String
"  -> [Token]   -- ^ Token stream before layout resolution."
    , String
"  -> [Token]   -- ^ Token stream after layout resolution."
    ]
  , Maybe LayoutDelimiters
-> [String] -> (LayoutDelimiters -> [String]) -> [String]
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe LayoutDelimiters
topDelim
    -- No top-level layout
    [ String
"resolveLayout _topLayout = res Nothing [Explicit]"
    , String
"  where"
    ]
    -- Can have top-level layout
    (\ LayoutDelimiters
delim ->
    [ String
"resolveLayout topLayout ="
    , String
"  res Nothing [if topLayout then Implicit topDelim Definitive 1 else Explicit]"
    , String
"  where"
    , String
"  topDelim :: LayoutDelimiters"
    , String
"  topDelim = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LayoutDelimiters -> String
forall a. Show a => a -> String
show LayoutDelimiters
delim
    ])
  , [ String
""
    , String
"  res :: Maybe Token -- ^ The previous token, if any."
    , String
"      -> [Block]     -- ^ A stack of layout blocks."
    , String
"      -> [Token] -> [Token]"
    , String
""
    , String
"  -- The stack should never be empty."
    , String
"  res _ [] ts = layoutError ts \"layout stack empty\""
    , String
""
    , String
"  -- Handling explicit blocks:"
    , String
"  res _ st (t0 : ts)"
    , String
"    -- We found an open brace in the input,"
    , String
"    -- put an explicit layout block on the stack."
    , String
"    -- This is done even if there was no layout word,"
    , String
"    -- to keep opening and closing braces."
    , String
"    | isLayoutOpen t0 || isParenOpen t0"
    , String
"      = t0 : res (Just t0) (Explicit : st) ts"
    , String
""
    , String
"    -- If we encounter a closing brace, exit the first explicit layout block."
    , String
"    | isLayoutClose t0 || isParenClose t0"
    , String
"      , let (imps, rest) = span isImplicit st"
    , String
"      , let st' = drop 1 rest"
    , String
"      = if null st'"
    , String
"        then layoutError ts $ unwords"
    , String
"          [ \"found\", prToken t0, \"at\" , tokenPos [t0]"
    , String
"          , \"without an explicit layout block\""
    , String
"          ]"
    , String
"        else map (closingToken ts (tokenPosn t0)) imps ++ t0 : res (Just t0) st' ts"
    , String
""
    , String
"  -- Ending or confirming implicit layout blocks:"
    , String
"  res pt (b@(Implicit delim status col) : bs) (t0 : ts)"
    , String
"    "
    , String
"      -- Do not end top-level layout block by layout stop word."
    , String
"    | isStop t0,  col <= 1"
    , String
"      = t0 : res (Just t0) (b : bs) ts"
    , String
""
    , String
"      -- End of implicit block by a layout stop word."
    , String
"    | isStop t0"
    , String
"           -- Exit the current block and all implicit blocks"
    , String
"           -- more indented than the current token."
    , String
"      , let (ebs, st') = span ((column t0 <) . indentation) bs"
    , String
"           -- Insert block-closers after the previous token."
    , String
"      = map (closingToken ts (afterPrev pt)) (b : ebs) ++ t0 : res (Just t0) st' ts"
    , String
""
    , String
"    -- End of an implicit layout block by dedentation."
    , String
"    | newLine pt t0"
    , String
"      , column t0 < col"
    , String
"           -- Insert a block closer after the previous token."
    , String
"           -- Repeat, with the current block removed from the stack."
    , String
"      , let c = closingToken ts (afterPrev pt) b"
    , String
"      = c : res (Just c) bs (t0 : ts)"
    , String
""
    , String
"    -- If we are on a newline, confirm the last tentative blocks."
    , String
"    | newLine pt t0, Tentative{} <- status"
    , String
"      = res pt (Implicit delim Definitive col : confirm col bs) (t0 : ts)"
    , String
""
    , String
"  -- Starting and processing implicit layout blocks:"
    , String
"  res pt st (t0 : ts)"
    , String
"    -- Start a new layout block if the first token is a layout word."
    , String
"    | Just delim@(LayoutDelimiters _ mopen _) <- isLayout t0"
    , String
"      = maybeInsertSeparator pt t0 st $"
    , String
"        case ts of"
    , String
"          -- Explicit layout, just move on. The next step"
    , String
"          -- will push an explicit layout block."
    , String
"          t1 : _ | isLayoutOpen t1 ->"
    , String
"            t0 : res (Just t0) st ts"
    , String
"          -- Otherwise, insert an open brace after the layout word"
    , String
"          _ ->"
    , String
"            t0 : b : res (Just b) (addImplicit delim (tokenPosn t0) pos st) ts"
    , String
"            where"
    , String
"            b   = sToken (nextPos t0) $ fromMaybe undefined mopen"
    , String
"            -- At the end of the file, the start column does not matter."
    , String
"            -- So if there is no token t1 after t0, just use the position of t0."
    , String
"            pos = tokenPosn $ fromMaybe t0 $ listToMaybe ts"
    , String
""
    , String
"    -- Insert separator if necessary."
    , String
"    | otherwise"
    , String
"      = maybeInsertSeparator pt t0 st $"
    , String
"        t0 : res (Just t0) st ts"
    , String
""
    , String
"  -- At EOF: skip explicit blocks."
    , String
"  res (Just _) [Explicit]      [] = []"
    , String
"  res (Just t) (Explicit : bs) [] = res (Just t) bs []"
    , String
""
    , String
"  -- If we are using top-level layout, insert a semicolon after"
    , String
"  -- the last token, if there isn't one already"
    , String
"  res (Just t) [Implicit (LayoutDelimiters sep _ _) _ _] []"
    , String
"    | isLayoutSep t = []"
    , String
"    | otherwise     = [sToken (nextPos t) sep]"
    , String
""
    , String
"  -- At EOF in an implicit, non-top-level block: close the block"
    , String
"  res (Just t) (Implicit (LayoutDelimiters _ _ (Just close)) _ _ : bs) []"
    , String
"      = b : res (Just b) bs []"
    , String
"        where b = sToken (nextPos t) close"
    , String
""
    , String
"  -- This should only happen if the input is empty."
    , String
"  res Nothing _st []"
    , String
"      = []"
    , String
""
    , String
"  -- | Insert a 'layoutSep' if we are on a new line on the current"
    , String
"  --   implicit layout column."
    , String
"  maybeInsertSeparator"
    , String
"    :: Maybe Token  -- ^ The previous token."
    , String
"    -> Token        -- ^ The current token."
    , String
"    -> [Block]      -- ^ The layout stack."
    , String
"    -> [Token]      -- ^ The result token stream."
    , String
"    -> [Token]      -- ^ Maybe prepended with a 'layoutSep'."
    , String
"  maybeInsertSeparator pt t0 = \\case"
    , String
"    Implicit (LayoutDelimiters sep _ _) _ n : _"
    , String
"      | newLine pt t0"
    , String
"      , column t0 == n"
    , String
"      , maybe False (not . isTokenIn (layoutSep ++ layoutOpen)) pt"
    , String
"       -- Insert a semicolon after the previous token"
    , String
"       -- unless we are the beginning of the file,"
    , String
"       -- or the previous token is a semicolon or open brace."
    , String
"      -> (sToken (afterPrev pt) sep :)"
    , String
"    _ -> id"
    , String
""
    , String
"  closingToken :: [Token] -> Position -> Block -> Token"
    , String
"  closingToken ts pos = sToken pos . \\case"
    , String
"    Implicit (LayoutDelimiters _ _ (Just sy)) _ _ -> sy"
    , String
"    _ -> layoutError ts \"trying to close a top level block\""
    , String
""
    , String
"type Position = Posn"
    , String
"type Line     = Int"
    , String
"type Column   = Int"
    , String
""
    , String
"-- | Entry of the layout stack."
    , String
"data Block"
    , String
"   = Implicit LayoutDelimiters Status Column"
    , String
"       -- ^ An implicit layout block with its start column."
    , String
"   | Explicit"
    , String
""
    , String
"-- | Get current indentation.  0 if we are in an explicit block."
    , String
"indentation :: Block -> Column"
    , String
"indentation = \\case"
    , String
"  Implicit _ _ n -> n"
    , String
"  Explicit -> 0"
    , String
""
    , String
"-- | Check if s block is implicit."
    , String
"isImplicit :: Block -> Bool"
    , String
"isImplicit = \\case"
    , String
"  Implicit{} -> True"
    , String
"  Explicit{} -> False"
    , String
""
    , String
"data Status"
    , String
"  = Tentative   -- ^ A layout column that has not been confirmed by a line break"
    , String
"  | Definitive  -- ^ A layout column that has been confirmed by a line break."
    , String
""
    , String
"-- | Add a new implicit layout block."
    , String
"addImplicit"
    , String
"  :: LayoutDelimiters -- ^ Delimiters of the new block."
    , String
"  -> Position         -- ^ Position of the layout keyword."
    , String
"  -> Position         -- ^ Position of the token following the layout keword."
    , String
"  -> [Block]"
    , String
"  -> [Block]"
    , String
"addImplicit delim (Pn _ l0 _) (Pn _ l1 c1) st"
    , String
"    -- Case: layout keyword was at the end of the line:"
    , String
"    -- New implicit block is definitive."
    , String
"    | l1 > l0   = Implicit delim Definitive (col st') : st'"
    , String
"    -- Case: staying on the same line:"
    , String
"    -- New implicit block is tentative."
    , String
"    | otherwise = Implicit delim Tentative (col st) : st"
    , String
"  where"
    , String
"  st' = confirm c1 st"
    , String
"  col bs = max c1 $ 1 + definiteIndentation bs"
    , String
"    -- The column of the next token determines the starting column"
    , String
"    -- of the implicit layout block."
    , String
"    -- However, the next block needs to be strictly more indented"
    , String
"    -- than the previous block."
    , String
""
    , String
"  -- | Get the current confirmed indentation level."
    , String
"  definiteIndentation :: [Block] -> Int"
    , String
"  definiteIndentation bs ="
    , String
"    case dropWhile isTentative bs of"
    , String
"      Implicit _ Definitive n : _ -> n"
    , String
"      _ -> 0  -- 0 enables a first unindented block, see 194_layout/good05.in"
    , String
""
    , String
"  isTentative :: Block -> Bool"
    , String
"  isTentative = \\case"
    , String
"    Implicit _ Tentative _ -> True"
    , String
"    _ -> False"
    , String
""
    , String
"-- | Confirm tentative blocks that are not more indented than @col@."
    , String
"confirm :: Column -> [Block] -> [Block]"
    , String
"confirm c0 = loop"
    , String
"  where"
    , String
"  loop = \\case"
    , String
"    Implicit delim Tentative c : bs"
    , String
"      | c <= c0 -> Implicit delim Definitive c : loop bs"
    , String
"    bs -> bs"
    , String
""
    , String
"-- | Get the position immediately to the right of the given token."
    , String
"--   If no token is given, gets the first position in the file."
    , String
"afterPrev :: Maybe Token -> Position"
    , String
"afterPrev = maybe (Pn 0 1 1) nextPos"
    , String
""
    , String
"-- | Get the position immediately to the right of the given token."
    , String
"nextPos :: Token -> Position"
    , String
"nextPos t = Pn (g + s) l (c + s + 1)"
    , String
"  where"
    , String
"  Pn g l c = tokenPosn t"
    , String
"  s        = tokenLength t"
    , String
""
    , String
"-- | Get the number of characters in the token."
    , String
"tokenLength :: Token -> Int"
    , String
"tokenLength = length . prToken"
    , String
""
    , String
"-- | Create a position symbol token."
    , String
"sToken :: Position -> TokSymbol -> Token"
    , String
"sToken p t = PT p $ TK t"
    , String
""
    , String
"-- | Get the line number of a token."
    , String
"line :: Token -> Line"
    , String
"line = fst . tokenLineCol"
    , String
""
    , String
"-- | Get the column number of a token."
    , String
"column :: Token -> Column"
    , String
"column = snd . tokenLineCol"
    , String
""
    , String
"-- | Is the following token on a new line?"
    , String
"newLine :: Maybe Token -> Token -> Bool"
    , String
"newLine pt t0 = maybe True ((line t0 >) . line) pt"
    , String
""
    , String
"-- | Check if a word is a layout start token."
    , String
"isLayout :: Token -> Maybe LayoutDelimiters"
    , String
"isLayout = \\case"
    , String
"  PT _ (TK t) -> lookup t layoutWords"
    , String
"  _ -> Nothing"
    , String
""
    , String
"-- | Check if a token is one of the given symbols."
    , String
"isTokenIn :: [TokSymbol] -> Token -> Bool"
    , String
"isTokenIn ts = \\case"
    , String
"  PT _ (TK t) -> t `elem` ts"
    , String
"  _ -> False"
    , String
""
    , String
"-- | Check if a token is a layout stop token."
    , String
"isStop :: Token -> Bool"
    , String
"isStop = isTokenIn layoutStopWords"
    , String
""
    , String
"-- | Check if a token is the layout open token."
    , String
"isLayoutOpen :: Token -> Bool"
    , String
"isLayoutOpen = isTokenIn layoutOpen"
    , String
""
    , String
"-- | Check if a token is the layout separator token."
    , String
"isLayoutSep :: Token -> Bool"
    , String
"isLayoutSep = isTokenIn layoutSep"
    , String
""
    , String
"-- | Check if a token is the layout close token."
    , String
"isLayoutClose :: Token -> Bool"
    , String
"isLayoutClose = isTokenIn layoutClose"
    , String
""
    , String
"-- | Check if a token is an opening parenthesis."
    , String
"isParenOpen :: Token -> Bool"
    , String
"isParenOpen = isTokenIn parenOpen"
    , String
""
    , String
"-- | Check if a token is a closing parenthesis."
    , String
"isParenClose :: Token -> Bool"
    , String
"isParenClose = isTokenIn parenClose"
    ]
  ]
  where
  (Maybe String
top0, LayoutKeyWords
lay0, [String]
stop0) = CF -> (Maybe String, LayoutKeyWords, [String])
layoutPragmas CF
cf
  top :: Maybe TokSymbol
top      = String -> Maybe TokSymbol
mkTokSymbol (String -> Maybe TokSymbol) -> Maybe String -> Maybe TokSymbol
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String
top0
  topDelim :: Maybe LayoutDelimiters
topDelim = (TokSymbol -> LayoutDelimiters)
-> Maybe TokSymbol -> Maybe LayoutDelimiters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ TokSymbol
sep -> TokSymbol -> Maybe TokSymbol -> Maybe TokSymbol -> LayoutDelimiters
LayoutDelimiters TokSymbol
sep Maybe TokSymbol
forall a. Maybe a
Nothing Maybe TokSymbol
forall a. Maybe a
Nothing) Maybe TokSymbol
top
  lay :: [(TokSymbol, LayoutDelimiters)]
lay      = LayoutKeyWords
-> ((String, Delimiters) -> (TokSymbol, LayoutDelimiters))
-> [(TokSymbol, LayoutDelimiters)]
forall a b. [a] -> (a -> b) -> [b]
for LayoutKeyWords
lay0 (((String, Delimiters) -> (TokSymbol, LayoutDelimiters))
 -> [(TokSymbol, LayoutDelimiters)])
-> ((String, Delimiters) -> (TokSymbol, LayoutDelimiters))
-> [(TokSymbol, LayoutDelimiters)]
forall a b. (a -> b) -> a -> b
$ \ (String
kw, Delimiters String
sep String
open String
close) ->
    ( TokSymbol -> Maybe TokSymbol -> TokSymbol
forall a. a -> Maybe a -> a
fromMaybe TokSymbol
forall a. HasCallStack => a
undefined (Maybe TokSymbol -> TokSymbol) -> Maybe TokSymbol -> TokSymbol
forall a b. (a -> b) -> a -> b
$ String -> Maybe TokSymbol
mkTokSymbol String
kw
    , TokSymbol -> Maybe TokSymbol -> Maybe TokSymbol -> LayoutDelimiters
LayoutDelimiters (TokSymbol -> Maybe TokSymbol -> TokSymbol
forall a. a -> Maybe a -> a
fromMaybe TokSymbol
forall a. HasCallStack => a
undefined (Maybe TokSymbol -> TokSymbol) -> Maybe TokSymbol -> TokSymbol
forall a b. (a -> b) -> a -> b
$ String -> Maybe TokSymbol
mkTokSymbol String
sep) (String -> Maybe TokSymbol
mkTokSymbol String
open) (String -> Maybe TokSymbol
mkTokSymbol String
close)
    )
  stop :: [TokSymbol]
stop = (String -> Maybe TokSymbol) -> [String] -> [TokSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe TokSymbol
mkTokSymbol [String]
stop0
  mkTokSymbol :: String -> Maybe TokSymbol
  mkTokSymbol :: String -> Maybe TokSymbol
mkTokSymbol String
x = String -> Int -> TokSymbol
TokSymbol String
x (Int -> TokSymbol) -> Maybe Int -> Maybe TokSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, Int)]
tokens
  tokens :: [(String, Int)]
tokens = CF -> [(String, Int)]
forall f. CFG f -> [(String, Int)]
cfTokens CF
cf
  -- Extra parentheses to keep track of (#370).
  parenOpen :: [TokSymbol]
parenOpen  = (String -> Maybe TokSymbol) -> [String] -> [TokSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe TokSymbol
mkTokSymbol [ String
"(", String
"[" ]
  parenClose :: [TokSymbol]
parenClose = (String -> Maybe TokSymbol) -> [String] -> [TokSymbol]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe TokSymbol
mkTokSymbol [ String
")", String
"]" ]