module parsec

    open prelude
    open prelude.option
    open prelude.string
    open prelude.html

    

    Parser a = {parser: String -> {rest: String, parsed: Option a}}



    inline run_parser:
    --  Runs a parser over a text argument and throws away the leftover text.
    
          Parser p  -> String -> Option p	                    
        | {parser = p} x = p x |> λ {parsed = {some = y}, _} = {some = y} 
                                  | _  = {none}
                                       
                    
    
    inline (<$>):
    --  Applies a function to the parse result, only if the parse was
    --  successful.
    
        (a -> b) -> Parser a    -> Parser b
        f       <$> {parser = z} =

            { parser s =
                  z s |>  λ {parsed = {some: x}, rest = ss} =
                               {parsed = {some = f x}, rest = ss}
                          | {parsed = {none}, rest = x} =
                               {parsed = {none}, rest = x} }



    inline (<*>):
    --  Allows functions that take multiple arguments to be applied
    --  sequentially to a sequence of parsed values.
    
        Parser (a -> b) -> Parser a    -> Parser b
        {parser = fp}  <*> {parser = p} =

            { parser s = 
                  fp s |> λ {parsed = {some: f}, rest = rr} =
                                p rr |> λ {parsed = {some = x}, rest = z} =
                                              {parsed = {some = f x}, rest = z}
                                        | {parsed = {none}, rest = x} =
                                              {parsed = {none}, rest = x}
                          | {parsed: {none}, rest: x} =
                               {parsed: {none}, rest: x} }





    private inline lift(g, {parser: f}) =
        { parser text =
             let f' = f text
             in  g { text: text
                     f: f
                     parsed: f'.parsed
                     rest: f'.rest
                     f': f' }}

    inline (*>):
    --  Applies two parsers in sequence, throwing out the result
    --  of the first.
        
        Parser a -> Parser b -> Parser b
        {parser = f} *> {parser = g} =

            { parser s =
                  f s |> λ {parsed = {some = x}, rest = zz} = g zz
                         | {parsed = {none}, rest = x} =
                               {parsed = {none}, rest = x} }
       


    inline (<|>):
    --  Alternative will try the first parser, and applies the second only if
    --  the first fails *and* consumes no input from the text.
    
        Parser a      -> Parser a    -> Parser a
        {parser = f} <|> {parser = g} =

            let h text {parsed = {none}, rest = textt} when text == textt =
                    g text
                | _ x = x

            in {parser text = h text (f text)}



    inline try':
    --  Tries to apply a parser, but restores the parser state in the case
    --  of a failure.  This is useful with combinators that check the
    --  state of the consumed text, like `<|>`

          Parser a    -> Parser a
        = lift λ (x & {_, parsed: {none}}) =
                     {parsed: {none}, rest: x.text}
               | x = x.f'



    inline string:
    --  A parser that matches a string.  Unlike Haskell's Parsec library,
    --  parsec.formal will not consume any input if the entire string
    --  doesn't match.  This is for efficiency reasons currently, but
    --  may change in the future.
	
	  String -> Parser String              
        | x = { parser y = 
                    let sub = do! `y.substring(0, x.length)`
                    if (sub == x)    
                        { rest   = do! `y.substring(x.length)`
                          parsed = {some = x} }
                    else {rest = y, parsed = {none}} }
                      
                      
    
    inline push! : x -> Array x -> Array x
         | x xs = do! `xs.unshift(x); xs`

    many:
    --  Applies a parser repeatedly, until parsing fails. 

          Parser a -> Parser (Array a)
        = lift λ (x & {_, parsed: {none}}) =
                     {parsed: {some: []}, rest = x.rest}
               | (y & {_, parsed: {some: x}}) =
                     (push! x <$> many {parser: y.f}).parser y.rest
                                  
              

    module "Testing"

        {some = "ten"} == run_parser (string "ten") "tens"
        {some = "tenten"} == run_parser ((λx = x +++ x) <$> string "ten") "tenfingers"

        {parsed = {some = "tenten"}, rest = "fingers"} 
            == ((λx = x +++ x) <$> string "ten").parser "tenfingers"

        var result = run_parser ((λx y = y +++ x) <$> string "ten" <*> string "fingers") "tenfingers"
        result == {some: "fingersten"}
        
        var result = run_parser (string "ten" <|> string "eleven") "eleven"
        result == {some: "eleven"}

        var result = run_parser (string "ten" *> string "fingers") "tenfingers"
        result == {some: "fingers"}

        var parser = (string "ten" *> string "fingers") <|> string "tentoes"
            result = run_parser parser "tentoes"
        result == {none}

        var parser = try' (string "ten" *> string "fingers") <|> string "tentoes"
            result = run_parser parser "tentoes"
        result == {some: "tentoes"}
                            
        var parser = many (string "ten")
            result = run_parser parser "tententententen"
        result == {some: ["ten", "ten", "ten", "ten", "ten"]}