implementation module SmurfParse

from StdFunc import o, flip
import StdChar
import StdList
import StdFile
import StdTuple
import StdString

from Data.Func import $
import Data.Maybe
import Control.Applicative
import Control.Monad

import Smurf

parse :: ![Char] -> Maybe Program
parse []       = pure []
parse ['"':cs] = parseString cs >>= \(s,cs`) -> append (Push s) $ parse cs`
parse ['i':cs] = apparse Input cs
parse ['o':cs] = apparse Output cs
parse ['+':cs] = apparse Cat cs
parse ['h':cs] = apparse Head cs
parse ['t':cs] = apparse Tail cs
parse ['q':cs] = apparse Quotify cs
parse ['p':cs] = apparse Put cs
parse ['g':cs] = apparse Get cs
parse ['x':cs] = apparse Exec cs
parse [c:cs]   = if (isSpace c) (parse cs) empty

apparse :: Stm -> [Char] -> Maybe Program
apparse stm = append stm o parse

append :: a (m [a]) -> m [a] | Monad m
append x mx = mx >>= \xs -> pure [x:xs]

parseString :: ![Char] -> Maybe (String, [Char])
parseString cs = pS [] cs
where
    pS :: ![Char] ![Char] -> Maybe (String, [Char])
    pS _ []             = empty
    pS s ['"':cs]       = pure (toString $ reverse s, cs)
    pS s ['\\':'n':cs]  = pS ['\n':s] cs
    pS s ['\\':'r':cs]  = pS ['\r':s] cs
    pS s ['\\':'t':cs]  = pS ['\t':s] cs
    pS s ['\\':'\\':cs] = pS ['\\':s] cs
    pS s ['\\':'"':cs]  = pS ['"':s] cs
    pS s [c:cs]         = pS [c:s] cs