module Text.Imparse.Parse (parseParser)
where
import Data.Char (isAlpha, isAlphaNum)
import Data.Maybe (catMaybes)
import Data.List (nub, findIndex, isPrefixOf)
import Data.List.Split (splitOn, splitWhen)
import Data.Text (unpack, strip, pack)
import qualified StaticAnalysis.All as A
import Text.Imparse.AbstractSyntax
parseParser :: A.Analysis a => String -> Either String (Parser a)
parseParser s =
let blocks = splitOn "\n\n" (trim s)
in Right $ Parser A.unanalyzed [] $ catMaybes [pProductionOrDelimiters (trim b) | b <- blocks]
pProductionOrDelimiters :: A.Analysis a => String -> Maybe (Production a)
pProductionOrDelimiters s = case splitOn "\n" (noEmptyLines s) of
line:lines ->
case nonemp $ splitOn " " line of
[entity, "::="] ->
Just $
Production A.unanalyzed entity $
map (Choices A.unanalyzed) $
map catMaybes $
splitWhen (\c -> case c of Nothing -> True; _ -> False) $
[pChoice s | s <- lines, trim s /= ""]
_ -> Nothing
_ -> Nothing
pChoice :: A.Analysis a => String -> Maybe (Choice a)
pChoice s = case nonemp $ splitOn " " (trim s) of
"|":es -> Just $ Choice A.unanalyzed Nothing AssocNone [pElement e | e <- es, e /= ""]
"<":es -> Just $ Choice A.unanalyzed Nothing AssocLeft [pElement e | e <- es, e /= ""]
">":es -> Just $ Choice A.unanalyzed Nothing AssocRight [pElement e | e <- es, e /= ""]
"~":es -> Just $ Choice A.unanalyzed Nothing AssocFlat [pElement e | e <- es, e /= ""]
c:"|":es -> Just $ Choice A.unanalyzed (Just c) AssocNone [pElement e | e <- es, e /= ""]
c:"<":es -> Just $ Choice A.unanalyzed (Just c) AssocLeft [pElement e | e <- es, e /= ""]
c:">":es -> Just $ Choice A.unanalyzed (Just c) AssocRight [pElement e | e <- es, e /= ""]
c:"~":es -> Just $ Choice A.unanalyzed (Just c) AssocFlat [pElement e | e <- es, e /= ""]
["^"] -> Nothing
_ -> Nothing
pElement :: A.Analysis a => String -> Element a
pElement t = case t of
'`':'`':s -> Terminal $ Explicit $ '`':s
"`$" -> Terminal $ StringLiteral
"`#" -> Terminal $ NaturalLiteral
"`#.#" -> Terminal $ DecimalLiteral
"`id" -> Terminal $ Identifier
"`var" -> Terminal $ Identifier
"`con" -> Terminal $ Constructor
"`flag" -> Terminal $ Flag
'`':s -> pNonTerminal s
_ -> Terminal $ Explicit t
pNonTerminal :: A.Analysis a => String -> Element a
pNonTerminal s =
if length s >= 1 && isAlpha (head s) && and (map isAlphaNum s) then
NonTerminal A.unanalyzed s
else if length s <= 2 then
Error $ "`" ++ s
else if ends "{" "}" s then
Terminal $ RegExp $ tail $ init s
else if ends ">>" "<<" s then
Indented True $ pNonTerminal (drop 2 $ init $ init s)
else if ends ">" "<" s then
Indented False $ pNonTerminal (tail $ init s)
else if ends "[" "]" s then
let s' = tail $ init s
in case findIndex (=='/') s' of
Nothing -> Many (pNonTerminal s') Nothing
Just i ->
let nt = take i s'
sep = drop (i+1) s'
in Many (pNonTerminal nt) (Just sep)
else if ends "(" ")" s then
May $ pNonTerminal (tail $ init s)
else
Error $ "`" ++ s
nonemp :: [String] -> [String]
nonemp = filter ((/=) "")
trim :: String -> String
trim = unpack.strip.pack
ends :: String -> String -> String -> Bool
ends p s t = isPrefixOf p t && isPrefixOf (reverse s) (reverse t)
noEmptyLines :: String -> String
noEmptyLines s = case s of
'\n':s' ->
case findIndex (=='\n') s' of
Nothing -> s
Just i ->
if nub (take i s') == [' '] then
"\n\n" ++ noEmptyLines (drop (i+1) s')
else
"\n" ++ (noEmptyLines s')
c :s' -> c : noEmptyLines s'
"" -> ""
--eof