module Parser
where
import Text.ParserCombinators.Parsec.Token
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Language
import Text.ParserCombinators.Parsec.Error
import Editor
import Offset
type ParseE = GenParser Char ()
numero :: ParseE Integer
numero = natural haskell
parseFilename = manyTill anyChar ((many1 space >> return ()) <|> eof)
parseExternalCommand = char '!' >> manyTill anyChar eof
parseCommandName = parseFilename
parseOffset :: ParseE Offset
parseOffset = let
lastline = char '$' >> return LastLine
absolute = numero >>= return . Absolute . fromInteger
current = char '.' >> return Current
previous1 = char '-' >> numero >>= return . Prev. fromInteger
previous2 = many1 (char '-') >>= return . Prev . length
next1 = (space <|> char '+') >> numero >>= return . Next . fromInteger
next2 = many1 (char '+') >>= return . Next . length
are c = char c >> manyTill anyChar ((char c >> return ()) <|> eof)
renext = are '/' >>= return . ReNext
lastrenext = string "//" >> return LastReNext
reprev = are '?' >>= return . RePrev
lastreprev = string "??" >> return LastRePrev
markedas = string "'" >> lower >>= return . MarkedAs
in choice (map try [lastline,absolute,current,previous1,previous2,next1,next2,
lastrenext,renext,lastreprev,reprev,markedas])
parseRange :: ParseE Range
parseRange = let
couple = do
l <- parseOffset
char ','
r <- parseOffset
return $ Range l r
coma = char ',' >> return (Range (Absolute 1) LastLine)
semicoma = char ';' >> return (Range Current LastLine)
in choice (map try [coma,semicoma,couple])
defaultOR :: Command -> OffsetOrRange
defaultOR Append = ORO Current
defaultOR Insert = ORO Current
defaultOR Change = ORO Current
defaultOR Print = ORO Current
defaultOR (SmallG _) = ORR (Range (Absolute 1) (Current))
defaultOR (BigG _) = ORR (Range (Absolute 1) (Current))
defaultOR Delete = ORO Current
defaultOR NoCommand = ORN
defaultOR (Edit _) = ORN
defaultOR Write = ORN
defaultOR (WriteNew _) = ORN
defaultOR (SetFilename _) = ORN
defaultOR GetFilename = ORN
defaultOR (EditExternal s) = ORN
defaultOR UndoChange = ORN
defaultOR RedoChange = ORN
acceptOffsetOnly :: Command -> OffsetOrRange -> ParseE ()
acceptOffsetOnly c (ORR _) = pzero <?> ("only offsets for function " ++ show c ++ ".")
acceptOffsetOnly _ _ = return ()
parseOffsetOrRange :: ParseE OffsetOrRange
parseOffsetOrRange
= try (parseRange >>= return . ORR)
<|> try (parseOffset >>= return .ORO)
<|> return ORN
rconst :: Command -> ParseE (OffsetOrRange -> ParseE Command)
rconst = return . const . return
parseCommand :: ParseE (OffsetOrRange -> ParseE Command)
parseCommand = let
append = char 'a' >> eof >> return (\r -> acceptOffsetOnly Append r >> return Append)
insert = char 'i' >> eof >> return (\r -> acceptOffsetOnly Insert r >> return Insert)
change = char 'c' >> eof >> rconst Change
delete = char 'd' >> eof >> rconst Delete
print = char 'p' >> eof >> rconst Print
smallg = char 'g' >> char '/' >> many1 (noneOf "/")
>>= \p -> char '/' >> eof >> rconst (SmallG p)
bigg = char 'G' >> char '/' >> many1 (noneOf "/")
>>= \p -> char '/' >> eof >> rconst (BigG p)
nocomm = eof >> rconst NoCommand
extedit = char 'e' >> many1 space >> parseExternalCommand >>= rconst . EditExternal
edit = char 'e' >> many1 space >> parseFilename >>= rconst . Edit
writen = char 'w' >> many1 space >> parseFilename >>= rconst . WriteNew
write = char 'w' >> rconst Write
setfn = char 'f' >> many1 space >> parseFilename >>= rconst . SetFilename
getfn = char 'f' >> rconst GetFilename
undo = char 'u' >> rconst UndoChange
redo = char 'R' >> rconst RedoChange
shelp = string "he" >> many1 space >> parseCommandName >>= rconst . HelpTopic
help = string "he" >> rconst HelpList
in choice (map try [append,insert,change,delete,
print,smallg,bigg,extedit,edit
,writen,write,setfn,getfn,undo,
shelp,help,redo]) <|> nocomm
parser :: ParseE CompleteCommand
parser = do
r <- parseOffsetOrRange
c <- parseCommand >>= ($ r)
return $ CC c $ case r of
ORN -> defaultOR c
_ -> r
parse :: String -> Either String CompleteCommand
parse s = either (Left . show) Right $ Text.ParserCombinators.Parsec.parse parser "Command Parser" s