{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Haskell.Layout (cf2layout, haskellLayout) where

import BNFC.CF

import BNFC.Backend.CommonInterface.Backend

import BNFC.Backend.Common.Utils as Utils

import BNFC.Backend.Haskell.Options
import BNFC.Backend.Haskell.State

import BNFC.Backend.Haskell.Utilities.Utils

import BNFC.Options.GlobalOptions

import BNFC.Prelude

import Control.Monad.State

import qualified Data.Map        as Map
import           Data.List       (intersperse)
import           Data.String     (fromString)

import Prettyprinter

import System.FilePath (takeBaseName)

haskellLayout :: LBNF -> State HaskellBackendState Result
haskellLayout :: LBNF -> State HaskellBackendState Result
haskellLayout LBNF
lbnf = do
  HaskellBackendState
st <- StateT HaskellBackendState Identity HaskellBackendState
forall s (m :: * -> *). MonadState s m => m s
get
  let
    cfName :: String
cfName      = String -> String
takeBaseName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ GlobalOptions -> String
optInput (GlobalOptions -> String) -> GlobalOptions -> String
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> GlobalOptions
globalOpt HaskellBackendState
st
    inDirectory :: Bool
inDirectory = HaskellBackendOptions -> Bool
inDir (HaskellBackendOptions -> Bool) -> HaskellBackendOptions -> Bool
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> HaskellBackendOptions
haskellOpts HaskellBackendState
st
    nSpace :: Maybe String
nSpace      = HaskellBackendOptions -> Maybe String
nameSpace (HaskellBackendOptions -> Maybe String)
-> HaskellBackendOptions -> Maybe String
forall a b. (a -> b) -> a -> b
$ HaskellBackendState -> HaskellBackendOptions
haskellOpts HaskellBackendState
st
    layout :: String
layout      = LBNF -> String -> Bool -> Maybe String -> String
cf2layout LBNF
lbnf String
cfName Bool
inDirectory Maybe String
nSpace
  Result -> State HaskellBackendState Result
forall (m :: * -> *) a. Monad m => a -> m a
return [(Bool -> Maybe String -> String -> String -> String -> String
mkFilePath Bool
inDirectory Maybe String
nSpace String
cfName String
"Layout" String
"hs", String
layout)]

cf2layout :: LBNF -> String -> Bool -> Maybe String -> String
cf2layout :: LBNF -> String -> Bool -> Maybe String -> String
cf2layout LBNF
lbnf String
cfName Bool
inDir Maybe String
nameSpace =
  LayoutOptions -> Doc () -> String
docToString LayoutOptions
defaultLayoutOptions (Doc () -> String) -> Doc () -> String
forall a b. (a -> b) -> a -> b
$ LBNF -> String -> Bool -> Maybe String -> Doc ()
cf2doc LBNF
lbnf String
cfName Bool
inDir Maybe String
nameSpace

cf2doc :: LBNF -> String -> Bool -> Maybe String -> Doc ()
cf2doc :: LBNF -> String -> Bool -> Maybe String -> Doc ()
cf2doc LBNF
lbnf String
cfName Bool
inDir Maybe String
nameSpace = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ()] -> Doc ())
-> ([Doc ()] -> [Doc ()]) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc () -> [Doc ()] -> [Doc ()]
forall a. a -> [a] -> [a]
intersperse Doc ()
forall ann. Doc ann
emptyDoc ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$
  [ String -> String -> Doc ()
prologue String
layoutModule String
lexModule
  , LBNF -> Doc ()
restOfLayout LBNF
lbnf
  ]

  where

    layoutModule :: String
layoutModule = Bool -> Maybe String -> String -> String -> String
mkModule Bool
inDir Maybe String
nameSpace String
cfName String
"Layout"
    lexModule :: String
lexModule = Bool -> Maybe String -> String -> String -> String
mkModule Bool
inDir Maybe String
nameSpace String
cfName String
"Lex"

prologue :: ModuleName -> ModuleName -> Doc ()
prologue :: String -> String -> Doc ()
prologue String
layutModule String
lexModule = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
  [ Doc ()
"{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"{-# LANGUAGE LambdaCase #-}"
  , Doc ()
"{-# LANGUAGE PatternGuards #-}"
  , Doc ()
"{-# LANGUAGE OverloadedStrings #-}"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"module" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString String
layutModule Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"where"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"import Prelude"
  , Doc ()
"import Data.Maybe ( fromMaybe, listToMaybe, mapMaybe )"
  , Doc ()
"import qualified Data.List as List"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"import" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString String
lexModule
  , Doc ()
"  ( Posn(..), Tok(..), Token(..), TokSymbol(..)"
  , Doc ()
"  , prToken, tokenLineCol, tokenPos, tokenPosn"
  , Doc ()
"  )"
  ]

restOfLayout :: LBNF -> Doc ()
restOfLayout :: LBNF -> Doc ()
restOfLayout LBNF
lbnf = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
  [ Doc ()
"-- local parameters"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"data LayoutDelimiters"
  , Doc ()
"  = LayoutDelimiters"
  , Doc ()
"    { delimSep   :: TokSymbol"
  , Doc ()
"    , delimOpen  :: Maybe TokSymbol  -- ^ Nothing for toplevel layout."
  , Doc ()
"    , delimClose :: Maybe TokSymbol  -- ^ Nothing for toplevel layout."
  , Doc ()
"    }"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
layoutWords
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
layoutStop
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- layout separators"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"layoutOpen, layoutClose, layoutSep :: [TokSymbol]"
  , Doc ()
"layoutOpen  = List.nub $ mapMaybe (delimOpen  . snd) layoutWords"
  , Doc ()
"layoutClose = List.nub $ mapMaybe (delimClose . snd) layoutWords"
  , Doc ()
"layoutSep   = List.nub $ TokSymbol \";\"" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
semiColonId) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    Doc ()
": map (delimSep . snd) layoutWords"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"parenOpen, parenClose :: [TokSymbol]"
  , Doc ()
"parenOpen  = [TokSymbol \"(\"" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
lParenId) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"]"
  , Doc ()
"parenClose = [TokSymbol \")\"" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
rParenId) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"]"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Replace layout syntax with explicit layout tokens."
  , Doc ()
"resolveLayout :: Bool    -- ^ Whether to use top-level layout."
  , Doc ()
"              -> [Token] -> [Token]"
  , if Maybe Position -> Bool
forall a. Maybe a -> Bool
isJust Maybe Position
top
    then [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ()
"resolveLayout topLayout ="
      , Doc ()
"  res Nothing [if topLayout then Implicit topDelim Definitive 1 else Explicit]"
      , Doc ()
"  where"
      , Doc ()
"  topDelim :: LayoutDelimiters"
      , Doc ()
"  topDelim = LayoutDelimiters" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens Doc ()
delimiterTokSymbol Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"Nothing Nothing"
      ]
    else [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ()
"resolveLayout _topLayout = res Nothing [Explicit]"
      , Doc ()
"  where"
      ]
  , Doc ()
forall ann. Doc ann
emptyDoc
  -------------------------------------------
  , Doc ()
"  res :: Maybe Token -- ^ The previous token, if any."
  , Doc ()
"      -> [Block]     -- ^ A stack of layout blocks."
  , Doc ()
"      -> [Token] -> [Token]"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- The stack should never be empty."
  , Doc ()
"  res _ [] ts = error $ \"Layout error: stack empty. Tokens: \" ++ show ts"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- Handling explicit blocks:"
  , Doc ()
"  res _ st (t0 : ts)"
  , Doc ()
"    -- We found an open brace in the input,"
  , Doc ()
"    -- put an explicit layout block on the stack."
  , Doc ()
"    -- This is done even if there was no layout word,"
  , Doc ()
"    -- to keep opening and closing braces."
  , Doc ()
"    | isLayoutOpen t0 || isParenOpen t0"
  , Doc ()
"      = t0 : res (Just t0) (Explicit : st) ts"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"    -- If we encounter a closing brace, exit the first explicit layout block."
  , Doc ()
"    | isLayoutClose t0 || isParenClose t0"
  , Doc ()
"      , let (imps, rest) = span isImplicit st"
  , Doc ()
"      , let st' = drop 1 rest"
  , Doc ()
"      = if null st'"
  , Doc ()
"        then error $ unwords"
  , Doc ()
"          [ \"Layout error: Found\", prToken t0, \"at\" , tokenPos [t0]"
  , Doc ()
"          , \"without an explicit layout block.\""
  , Doc ()
"          ]"
  , Doc ()
"        else map (closingToken (tokenPosn t0)) imps ++ t0 : res (Just t0) st' ts"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- Ending or confirming implicit layout blocks:"
  , Doc ()
"  res pt (b@(Implicit delim status col) : bs) (t0 : ts)"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"      -- End of implicit block by a layout stop word."
  , Doc ()
"    | isStop t0"
  , Doc ()
"           -- Exit the current block and all implicit blocks"
  , Doc ()
"           -- more indented than the current token."
  , Doc ()
"      , let (ebs, st') = span ((column t0 <) . indentation) bs"
  , Doc ()
"           -- Insert block-closers after the previous token."
  , Doc ()
"      = map (closingToken (afterPrev pt)) (b : ebs) ++ t0 : res (Just t0) st' ts"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"    -- End of an implicit layout block by dedentation."
  , Doc ()
"    | newLine pt t0"
  , Doc ()
"      , column t0 < col"
  , Doc ()
"           -- Insert a block closer after the previous token."
  , Doc ()
"           -- Repeat, with the current block removed from the stack."
  , Doc ()
"      , let c = closingToken (afterPrev pt) b"
  , Doc ()
"      = c : res (Just c) bs (t0 : ts)"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"    -- If we are on a newline, confirm the last tentative blocks."
  , Doc ()
"    | newLine pt t0, Tentative{} <- status"
  , Doc ()
"      = res pt (Implicit delim Definitive col : confirm col bs) (t0 : ts)"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- Starting and processing implicit layout blocks:"
  , Doc ()
"  res pt st (t0 : ts)"
  , Doc ()
"    -- Start a new layout block if the first token is a layout word."
  , Doc ()
"    | Just delim@(LayoutDelimiters _ mopen _) <- isLayout t0"
  , Doc ()
"      = maybeInsertSeparator pt t0 st $"
  , Doc ()
"        case ts of"
  , Doc ()
"          -- Explicit layout, just move on. The next step"
  , Doc ()
"          -- will push an explicit layout block."
  , Doc ()
"          t1 : _ | isLayoutOpen t1 ->"
  , Doc ()
"            t0 : res (Just t0) st ts"
  , Doc ()
"          -- Otherwise, insert an open brace after the layout word"
  , Doc ()
"          _ ->"
  , Doc ()
"            t0 : b : res (Just b) (addImplicit delim (tokenPosn t0) pos st) ts"
  , Doc ()
"            where"
  , Doc ()
"            b   = sToken (nextPos t0) $ fromMaybe undefined mopen"
  , Doc ()
"            -- At the end of the file, the start column does not matter."
  , Doc ()
"            -- So if there is no token t1 after t0, just use the position of t0."
  , Doc ()
"            pos = tokenPosn $ fromMaybe t0 $ listToMaybe ts"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"    -- Insert separator if necessary."
  , Doc ()
"    | otherwise"
  , Doc ()
"      = maybeInsertSeparator pt t0 st $"
  , Doc ()
"        t0 : res (Just t0) st ts"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- At EOF: skip explicit blocks."
  , Doc ()
"  res (Just _) [Explicit]      [] = []"
  , Doc ()
"  res (Just t) (Explicit : bs) [] = res (Just t) bs []"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- If we are using top-level layout, insert a semicolon after"
  , Doc ()
"  -- the last token, if there isn't one already"
  , Doc ()
"  res (Just t) [Implicit (LayoutDelimiters sep _ _) _ _] []"
  , Doc ()
"    | isLayoutSep t = []"
  , Doc ()
"    | otherwise     = [sToken (nextPos t) sep]"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- At EOF in an implicit, non-top-level block: close the block"
  , Doc ()
"  res (Just t) (Implicit (LayoutDelimiters _ _ (Just close)) _ _ : bs) []"
  , Doc ()
"      = b : res (Just b) bs []"
  , Doc ()
"        where b = sToken (nextPos t) close"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- This should only happen if the input is empty."
  , Doc ()
"  res Nothing _st []"
  , Doc ()
"      = []"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- | Insert a 'layoutSep' if we are on a new line on the current"
  , Doc ()
"  --   implicit layout column."
  , Doc ()
"  maybeInsertSeparator"
  , Doc ()
"    :: Maybe Token  -- ^ The previous token."
  , Doc ()
"    -> Token        -- ^ The current token."
  , Doc ()
"    -> [Block]      -- ^ The layout stack."
  , Doc ()
"    -> [Token]      -- ^ The result token stream."
  , Doc ()
"    -> [Token]      -- ^ Maybe prepended with a 'layoutSep'."
  , Doc ()
"  maybeInsertSeparator pt t0 = \\case"
  , Doc ()
"    Implicit (LayoutDelimiters sep _ _) _ n : _"
  , Doc ()
"      | newLine pt t0"
  , Doc ()
"      , column t0 == n"
  , Doc ()
"      , maybe False (not . isTokenIn (layoutSep ++ layoutOpen)) pt"
  , Doc ()
"       -- Insert a semicolon after the previous token"
  , Doc ()
"       -- unless we are the beginning of the file,"
  , Doc ()
"       -- or the previous token is a semicolon or open brace."
  , Doc ()
"      -> (sToken (afterPrev pt) sep :)"
  , Doc ()
"    _ -> id"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  closingToken :: Position -> Block -> Token"
  , Doc ()
"  closingToken pos = sToken pos . \\case"
  , Doc ()
"    Implicit (LayoutDelimiters _ _ (Just sy)) _ _ -> sy"
  , Doc ()
"    _ -> error \"Trying to close a top level block.\""
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"type Position = Posn"
  , Doc ()
"type Line     = Int"
  , Doc ()
"type Column   = Int"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Entry of the layout stack."
  , Doc ()
"data Block"
  , Doc ()
"   = Implicit LayoutDelimiters Status Column"
  , Doc ()
"       -- ^ An implicit layout block with its start column."
  , Doc ()
"   | Explicit"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Get current indentation.  0 if we are in an explicit block."
  , Doc ()
"indentation :: Block -> Column"
  , Doc ()
"indentation = \\case"
  , Doc ()
"  Implicit _ _ n -> n"
  , Doc ()
"  Explicit -> 0"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if s block is implicit."
  , Doc ()
"isImplicit :: Block -> Bool"
  , Doc ()
"isImplicit = \\case"
  , Doc ()
"  Implicit{} -> True"
  , Doc ()
"  Explicit{} -> False"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"data Status"
  , Doc ()
"  = Tentative   -- ^ A layout column that has not been confirmed by a line break"
  , Doc ()
"  | Definitive  -- ^ A layout column that has been confirmed by a line break."
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Add a new implicit layout block."
  , Doc ()
"addImplicit"
  , Doc ()
"  :: LayoutDelimiters -- ^ Delimiters of the new block."
  , Doc ()
"  -> Position         -- ^ Position of the layout keyword."
  , Doc ()
"  -> Position         -- ^ Position of the token following the layout keword."
  , Doc ()
"  -> [Block]"
  , Doc ()
"  -> [Block]"
  , Doc ()
"addImplicit delim (Pn _ l0 _) (Pn _ l1 c1) st"
  , Doc ()
"    -- Case: layout keyword was at the end of the line:"
  , Doc ()
"    -- New implicit block is definitive."
  , Doc ()
"    | l1 > l0   = Implicit delim Definitive (col st') : st'"
  , Doc ()
"    -- Case: staying on the same line:"
  , Doc ()
"    -- New implicit block is tentative."
  , Doc ()
"    | otherwise = Implicit delim Tentative (col st) : st"
  , Doc ()
"  where"
  , Doc ()
"  st' = confirm c1 st"
  , Doc ()
"  col bs = max c1 $ 1 + definiteIndentation bs"
  , Doc ()
"    -- The column of the next token determines the starting column"
  , Doc ()
"    -- of the implicit layout block."
  , Doc ()
"    -- However, the next block needs to be strictly more indented"
  , Doc ()
"    -- than the previous block."
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  -- | Get the current confirmed indentation level."
  , Doc ()
"  definiteIndentation :: [Block] -> Int"
  , Doc ()
"  definiteIndentation bs ="
  , Doc ()
"    case dropWhile isTentative bs of"
  , Doc ()
"      Implicit _ Definitive n : _ -> n"
  , Doc ()
"      _ -> 0  -- 0 enables a first unindented block, see 194_layout/good05.in"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"  isTentative :: Block -> Bool"
  , Doc ()
"  isTentative = \\case"
  , Doc ()
"    Implicit _ Tentative _ -> True"
  , Doc ()
"    _ -> False"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Confirm tentative blocks that are not more indented than @col@."
  , Doc ()
"confirm :: Column -> [Block] -> [Block]"
  , Doc ()
"confirm c0 = loop"
  , Doc ()
"  where"
  , Doc ()
"  loop = \\case"
  , Doc ()
"    Implicit delim Tentative c : bs"
  , Doc ()
"      | c <= c0 -> Implicit delim Definitive c : loop bs"
  , Doc ()
"    bs -> bs"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Get the position immediately to the right of the given token."
  , Doc ()
"--   If no token is given, gets the first position in the file."
  , Doc ()
"afterPrev :: Maybe Token -> Position"
  , Doc ()
"afterPrev = maybe (Pn 0 1 1) nextPos"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Get the position immediately to the right of the given token."
  , Doc ()
"nextPos :: Token -> Position"
  , Doc ()
"nextPos t = Pn (g + s) l (c + s + 1)"
  , Doc ()
"  where"
  , Doc ()
"  Pn g l c = tokenPosn t"
  , Doc ()
"  s        = tokenLength t"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Get the number of characters in the token."
  , Doc ()
"tokenLength :: Token -> Int"
  , Doc ()
"tokenLength = length . prToken"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Create a position symbol token."
  , Doc ()
"sToken :: Position -> TokSymbol -> Token"
  , Doc ()
"sToken p t = PT p $ TK t"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Get the line number of a token."
  , Doc ()
"line :: Token -> Line"
  , Doc ()
"line = fst . tokenLineCol"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Get the column number of a token."
  , Doc ()
"column :: Token -> Column"
  , Doc ()
"column = snd . tokenLineCol"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Is the following token on a new line?"
  , Doc ()
"newLine :: Maybe Token -> Token -> Bool"
  , Doc ()
"newLine pt t0 = maybe True ((line t0 >) . line) pt"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a word is a layout start token."
  , Doc ()
"isLayout :: Token -> Maybe LayoutDelimiters"
  , Doc ()
"isLayout = \\case"
  , Doc ()
"  PT _ (TK t) -> lookup t layoutWords"
  , Doc ()
"  _ -> Nothing"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is one of the given symbols."
  , Doc ()
"isTokenIn :: [TokSymbol] -> Token -> Bool"
  , Doc ()
"isTokenIn ts = \\case"
  , Doc ()
"  PT _ (TK t) -> t `elem` ts"
  , Doc ()
"  _ -> False"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is a layout stop token."
  , Doc ()
"isStop :: Token -> Bool"
  , Doc ()
"isStop = isTokenIn layoutStopWords"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is the layout open token."
  , Doc ()
"isLayoutOpen :: Token -> Bool"
  , Doc ()
"isLayoutOpen = isTokenIn layoutOpen"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is the layout separator token."
  , Doc ()
"isLayoutSep :: Token -> Bool"
  , Doc ()
"isLayoutSep = isTokenIn layoutSep"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is the layout close token."
  , Doc ()
"isLayoutClose :: Token -> Bool"
  , Doc ()
"isLayoutClose = isTokenIn layoutClose"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is an opening parenthesis."
  , Doc ()
"isParenOpen :: Token -> Bool"
  , Doc ()
"isParenOpen = isTokenIn parenOpen"
  , Doc ()
forall ann. Doc ann
emptyDoc
  , Doc ()
"-- | Check if a token is a closing parenthesis."
  , Doc ()
"isParenClose :: Token -> Bool"
  , Doc ()
"isParenClose = isTokenIn parenClose"
  ]

  where

    symbolsAndKeywords :: SymbolsKeywords
symbolsAndKeywords = LBNF -> SymbolsKeywords
_lbnfSymbolsKeywords LBNF
lbnf

    semiColonId :: Int
semiColonId = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String1 -> SymbolsKeywords -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String1
";" SymbolsKeywords
symbolsAndKeywords
    lBraceId :: Int
lBraceId    = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String1 -> SymbolsKeywords -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String1
"{" SymbolsKeywords
symbolsAndKeywords
    rBraceId :: Int
rBraceId    = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String1 -> SymbolsKeywords -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String1
"}" SymbolsKeywords
symbolsAndKeywords
    lParenId :: Int
lParenId    = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String1 -> SymbolsKeywords -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String1
"(" SymbolsKeywords
symbolsAndKeywords
    rParenId :: Int
rParenId    = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ String1 -> SymbolsKeywords -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String1
")" SymbolsKeywords
symbolsAndKeywords

    delimiterTokSymbol :: Doc ()
delimiterTokSymbol = (String, Int) -> Doc ()
printTokSymbol (String
";", Int
semiColonId)

    startNames :: [String1]
startNames = Keyword -> String1
theKeyword (Keyword -> String1) -> [Keyword] -> [String1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Keyword Position -> [Keyword]
forall k a. Map k a -> [k]
Map.keys (LBNF -> Map Keyword Position
_lbnfLayoutStart LBNF
lbnf)
    startIds :: [Int]
startIds = (String1, Int) -> Int
forall a b. (a, b) -> b
snd ((String1, Int) -> Int) -> [(String1, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      SymbolsKeywords -> [(String1, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (
      (String1 -> Int -> Bool) -> SymbolsKeywords -> SymbolsKeywords
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
      (\ String1
k Int
_ -> String1
k String1 -> [String1] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String1]
startNames)
      (LBNF -> SymbolsKeywords
_lbnfSymbolsKeywords LBNF
lbnf) )
    startSymbols :: [(String, Int)]
startSymbols = [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String1 -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (String1 -> String) -> [String1] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String1]
startNames) [Int]
startIds

    stopNames :: [String1]
stopNames = Keyword -> String1
theKeyword (Keyword -> String1) -> [Keyword] -> [String1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Keyword Position -> [Keyword]
forall k a. Map k a -> [k]
Map.keys (LBNF -> Map Keyword Position
_lbnfLayoutStop LBNF
lbnf)
    stopIds :: [Int]
stopIds = (String1, Int) -> Int
forall a b. (a, b) -> b
snd ((String1, Int) -> Int) -> [(String1, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      SymbolsKeywords -> [(String1, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (
      (String1 -> Int -> Bool) -> SymbolsKeywords -> SymbolsKeywords
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
      (\ String1
k Int
_ -> String1
k String1 -> [String1] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String1]
stopNames)
      (LBNF -> SymbolsKeywords
_lbnfSymbolsKeywords LBNF
lbnf) )
    stopSymbols :: [(String, Int)]
stopSymbols = [String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String1 -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (String1 -> String) -> [String1] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String1]
stopNames) [Int]
stopIds

    top :: Maybe Position
top = LBNF -> Maybe Position
_lbnfLayoutTop LBNF
lbnf

    layoutWords :: Doc ()
    layoutWords :: Doc ()
layoutWords = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ()
"layoutWords :: [(TokSymbol, LayoutDelimiters)]"
      , Doc ()
"layoutWords = ["
      , Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$
        [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep (Doc () -> [Doc ()] -> [Doc ()]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ()
forall ann. Doc ann
comma ([Doc ()] -> [Doc ()]) -> [Doc ()] -> [Doc ()]
forall a b. (a -> b) -> a -> b
$ (String, Int) -> Doc ()
printTuple ((String, Int) -> Doc ()) -> [(String, Int)] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Int)]
startSymbols) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
forall ann. Doc ann
rbracket
      ]
      where
        printTuple :: (String, Int) -> Doc ()
        printTuple :: (String, Int) -> Doc ()
printTuple s :: (String, Int)
s@(String
_, Int
_) = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
          [ Doc ()
forall ann. Doc ann
lparen Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (String, Int) -> Doc ()
printTokSymbol (String, Int)
s
          , Doc ()
", LayoutDelimiters" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
            Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens ((String, Int) -> Doc ()
printTokSymbol (String
";", Int
semiColonId)) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
            Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens (Doc ()
"Just" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens ((String, Int) -> Doc ()
printTokSymbol (String
"{", Int
lBraceId))) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
            Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens (Doc ()
"Just" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
parens ((String, Int) -> Doc ()
printTokSymbol (String
"}", Int
rBraceId)))
          , Doc ()
forall ann. Doc ann
rparen
          ]

    layoutStop :: Doc ()
    layoutStop :: Doc ()
layoutStop = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ()
"layoutStopWords :: [TokSymbol]"
      , Doc ()
"layoutStopWords =" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
        Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
brackets ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
hsep ( Doc () -> [Doc ()] -> [Doc ()]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ()
forall ann. Doc ann
comma ((String, Int) -> Doc ()
printTokSymbol ((String, Int) -> Doc ()) -> [(String, Int)] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Int)]
stopSymbols)))
      ]

    printTokSymbol :: (String, Int) -> Doc ()
    printTokSymbol :: (String, Int) -> Doc ()
printTokSymbol  (String
tokName, Int
tokId) =
      Doc ()
"TokSymbol" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
dquotes (String -> Doc ()
forall a. IsString a => String -> a
fromString String
tokName) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
tokId)