implementation module lex

import Data.Either
import Data.List
import StdString
import System.CommandLine
import StdFile
import StdMisc
from StdFunc import id, const
import Data.Maybe
import Control.Applicative
import Control.Monad
import Control.Monad.State
from Data.Func import $

// Misschien moeten we hier continuation style van maken
instance toString lexerOutput where
	toString l = "dit is een lexer output, danwel error\n"

lexer :: [Char] -> LexerOutput [Token]
lexer _ = Left "Not Implemented"

Start :: *World -> *World
Start w
# (args, w) = getCommandLine w // We lezen nu nog standaard van stdin
# (out, w) = stdio w
# (toparse, out) = readEntireFile out
# out = out <<< toString (lexer toparse)
# (b, w) = fclose out w
| not b = setReturnCode 1 w
= w
	where
		readEntireFile :: *File -> *([Char], *File)
		readEntireFile f
		# (b, c, f) = freadc f
		| not b = ([], f)
		# (cs, f) = readEntireFile f
		= ([c:cs], f)



// Clean adaption of Yard, a parsec like parser combinator
:: Parser a = Parser ([Char] -> (LexerOutput a, [Char]))

runParser :: (Parser a) [Char] -> (LexerOutput a, [Char])
runParser (Parser p) s = p s

instance Functor Parser where
    fmap f s    = liftM f s

instance Applicative Parser where
    pure a      = Parser $ \s -> (Right a, s) 
    (<*>) sf s  = ap sf s

instance Monad Parser where
    bind p f    = Parser $ \s -> let (out, rest) = runParser p s in case out of
                    Left e  = (Left e, rest)
                    Right t = runParser (f t) rest

//gives us some, many and optional
instance Alternative Parser where
    empty       = zero
    (<|>) p1 p2 = parserAlternative p1 p2
parserAlternative p1 p2 = Parser $ \s -> let (out, rest) = runParser p1 s in case out of
                            Left e  = runParser p2 s
                            Right t = (Right t, rest)

//parser that fails with error
fail :: String -> Parser a
fail e = Parser $ \s -> (Left e, s)

//parser that always fails
zero :: Parser a
zero = fail "Zero parser"

//matches exactly one Char
item :: Parser Char
item = Parser $ \s -> case s of 
        []      = (Left "Unexpected empty input", s)
        [x:xs]  = (Right x, xs)

//matches any char which satisfies f
satisfy :: (Char -> Bool) -> Parser Char
satisfy f = item >>= (\r -> if (f r) (return r) zero)

//tries a parser, if it fails returns a default value
optionalDef :: a (Parser a) -> Parser a
optionalDef def p = parserAlternative p (return def)

//matched given char
char :: Char -> Parser Char
char c = satisfy (\i -> c==i) //I hate that we can't do: satisfy (==c)

alpha :: Parser Char
alpha = satisfy isAlpha

digit :: Parser Char
digit = satisfy isDigit

//matches a given String
string :: [Char] -> Parser [Char]
string s = mapM_ char s >>| return s