module Text.EBNF.Build.Parser.Except where
import Text.Parsec.Pos
import Text.EBNF.SyntaxTree
import Text.EBNF.Helper
import Data.Function
import Data.List
data FailData = FailData {
failtype :: String,
description :: String,
pos :: SourcePos
} deriving (Eq)
instance Show FailData where
show fd = concat [failtype fd, " in " , show $ pos fd, ":\n", description fd]
data Report = Clean
| Warning {warnings :: [FailData]}
| Failed {failures :: [FailData]} deriving (Eq)
instance Show Report where
show Clean = "Clean Report"
show (Warning w) = intercalate "\n" . map show $ w
show (Failed f) = intercalate "\n" . map show $ f
concatReports :: [Report] -> Report
concatReports = foldl combineReports Clean
combineReports :: Report -> Report -> Report
combineReports Clean Clean = Clean
combineReports Clean a = a
combineReports a Clean = combineReports Clean a
combineReports (Warning w) (Failed f) = Failed (sortBy (compare `on` pos) $ f ++ w)
combineReports (Failed f) (Warning w) = combineReports (Warning w) (Failed f)
combineReports (Failed f) (Failed f') = Failed (sortBy (compare `on` pos) $ f ++ f')
combineReports (Warning w) (Warning w') = Warning (sortBy (compare `on` pos) $ w ++ w')
generateReport :: SyntaxTree -> Report
generateReport st = concatReports . map (($ st) . reporter) $ reports
reports :: [SyntaxTree -> Report]
reports = []
reporter :: (SyntaxTree -> Report) -> SyntaxTree -> Report
reporter fn st = let rep = fn st
reps = map fn $ children st
in concatReports (rep:reps)
neverTerminating :: SyntaxTree -> Report
neverTerminating (SyntaxTree _ _ _ []) = Clean
neverTerminating st
| opInRepeat = Failed [reportf]
| hasOptionalInTail = Warning [reportw]
| otherwise = Clean
where
reportf =
FailData "failure"
"sequence will never terminate (repeat sequence only contains or favours optionals)"
(position st)
reportw =
FailData "warning"
"sequence may never terminate (contains optional sequence in a repeat sequence)"
(position st)
opInRepeat = (isRepeatSeq && isOnlyOptionals) || opIsFirstInDef
opIsFirstInDef = isRepeatSeq && ((identifier . head . children . head $ children st) == "optional sequence")
isRepeatSeq = identifier st == "repeated sequence"
hasOptionalInTail = any (\a -> identifier (sk a) == "optional sequence")
. tail' . children . head . children $ st
isOnlyOptionals = all (\a -> identifier (sk a) == "optional sequence")
. children . head . children $ st
sk :: SyntaxTree -> SyntaxTree
sk st' = st'
tail' :: [a] -> [a]
tail' [] = []
tail' a = tail a