{-# LANGUAGE LambdaCase #-}

module BNFC.Backend.C.RegToFlex (printRegFlex) where

-- modified from pretty-printer generated by the BNF converter

import Data.Char (ord, showLitChar)
import qualified Data.List as List

import BNFC.Abs
import BNFC.Backend.Common (flexEps)

-- the top-level printing method
printRegFlex :: Reg -> String
printRegFlex = render . prt 0

-- you may want to change render and parenth

render :: [String] -> String
render = rend (0::Int) where
  rend i ss = case ss of
    "["      :ts -> cons "["  $ rend i ts
    "("      :ts -> cons "("  $ rend i ts
    t  : "," :ts -> cons t    $ space "," $ rend i ts
    t  : ")" :ts -> cons t    $ cons ")"  $ rend i ts
    t  : "]" :ts -> cons t    $ cons "]"  $ rend i ts
    t        :ts -> space t   $ rend i ts
    _            -> ""
  cons s t  = s ++ t
  space t s = if null s then t else t ++ s

parenth :: [String] -> [String]
parenth ss = ["("] ++ ss ++ [")"]

-- the printer class does the job
class Print a where
  prt :: Int -> a -> [String]

prPrec :: Int -> Int -> [String] -> [String]
prPrec i j = if j<i then parenth else id

instance Print Identifier where
  prt _ (Identifier (_, i)) = [i]

instance Print Reg where
  prt i = \case
   RSeq reg0 reg -> prPrec i 2 (concat [prt 2 reg0 , prt 3 reg])
   RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg])

   -- Flex does not support set difference. See link for valid patterns.
   -- https://westes.github.io/flex/manual/Patterns.html#Patterns
   -- RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg])
   RMinus reg0 REps -> prt i reg0 -- REps is identity for set difference
   RMinus RAny (RChar c)   -> [ concat [ "[^", escapeChar c,             "]" ] ]
   RMinus RAny (RAlts str) -> [ concat [ "[^", concatMap escapeChar str, "]" ] ]
     -- FIXME: unicode inside brackets [...] is not accepted by flex
   -- FIXME: maybe we could add cases for char - RDigit, RLetter etc.
   RMinus _ _ -> error  "Flex does not support general set difference"

   RStar reg -> concat [ prt 3 reg , ["*"] ]
   RPlus reg -> concat [ prt 3 reg , ["+"] ]
   ROpt reg  -> concat [ prt 3 reg , ["?"] ]
   REps      -> [ flexEps ]
   RChar c   -> [ escapeChar c ]
   -- Unicode characters cannot be inside [...] so we use | instead.
   RAlts str -> prPrec i 1 $ List.intersperse "|" $ map escapeChar str
     -- RAlts str -> concat [["["], prt 0 $ concatMap escapeChar str, ["]"]]
   RSeqs str -> prPrec i 2 $ map escapeChar str
   RDigit    -> [ "{DIGIT}"   ]
   RLetter   -> [ "{LETTER}"  ]
   RUpper    -> [ "{CAPITAL}" ]
   RLower    -> [ "{SMALL}"   ]
   RAny      -> [ "."         ]

-- | Handle special characters in regular expressions.

escapeChar :: Char -> String
escapeChar c
  | c `elem` reserved       = '\\':[c]
  | let x = ord c, x >= 256 = [c]  -- keep unicode characters -- "\x" ++ showHex x ""
  | otherwise               = showLitChar c ""
  where
  reserved :: String
  reserved = "$+-*=<>[](){}!?.,;:^~|&%#/\\$_@\""