Applicative Parser

ApplicativeParser

module ApplicativeParser

// Credits go to the outstanding Brent Yorgey CIS 194 course found here: https://www.seas.upenn.edu/~cis194/spring13/lectures.html
// The following is a simlified version of homework/assignments for week 10 and 11.

// Extremely simplified (aplicative) parser combinator small thing (i.e. snippets and/or gist)
// ----------------------------------------------------------------------------------
// * The primitive parsers are all made based of single character parsers
// * Style A/B feels right working with this kind of code, and besides Applicative, one need also consider
//   the Alternative API's (choice <|> operator, end empty Parser). Combinators like zeroOrMore, oneOrMore needs
//   the <|> choice operator to be defined)
//
// In Haskell (need some massaging because out Parser use a different state-model)
// ===========
// instance Alternative Parser where
//   -- empty :: Parser a
//   empty = Parser (const Nothing)
//   -- (<|>) :: Parser a -> Parser a -> Parser a
//   Parser p1 <|> Parser p2 = Parser $ liftA2 (<|>) p1 p2
//
// Also haskell has more applicative goodness defined by default
//
// To parse something but ignore its output, you can use the
//      (*>) and (<*) operators, which have the types
//      (*>) :: Applicative f => f a -> f b -> f b
//      (<*) :: Applicative f => f a -> f b -> f a
//
// Does F# applicative CE (Type C) syntax support the above constructs. I know to little about F# to answer that question.

// (startIndex, stringToParse)
type SpanInfo = int * string

// State Applicative Parser (See also State Monad)
type Parser<'T> = Parser of runParser : (SpanInfo -> option<'T * SpanInfo>)

// Parser<'a> -> (SpanInfo -> option<'a * SpanInfo>)
let runParser (Parser p) = p

// runParser but use string in place of SpanInfo
// That is given a Parser<string> the result is: string -> (string * string) option
let run (p: Parser<'T>) =
    (fun (s: string) ->
        match runParser p <| (0, s) with
        | Some (x, (i, s)) -> Some (x, s.Substring(i, s.Length - i))
        | None -> None)

// private helper: apply a function to fst of pair
let first f (x, y) = (f x, y)

//
// Functor
//

// ('a -> 'b) - Parser<'a> -> Parser<'b>
let map f (Parser p) =
    Parser <| (fun spanInfo -> Option.map (first f) (p spanInfo))

let (<!>) f p = map f p

//
// Applicative
//

// 'a -> Parser<'a>
let pure' x = Parser <| (fun spanInfo -> Some (x, spanInfo))

// Parser<'a -> 'b> -> Parser<'a> -> Parser<'b>
let apply p1 p2 =
    let p3 = fun spanInfo ->
        match (runParser p1) spanInfo with
            | Some (f, restSpanInfo) -> runParser (map f p2) restSpanInfo  // uses map of Functor Parser
            | None -> None
    Parser p3

let (<*>) = apply

//
// Primitive parser
//

// make primitive character parser
let satisfy (p : char -> bool) : Parser<char> =
    // runParser :: (SpanInfo -> option<char * SpanInfo>)
    let f (i, s : string) : option<char * SpanInfo> =
        if (i < s.Length)
        then Some (s.[i], (i + 1, s))
        else None
    Parser f

// char -> Parser<char>
let char c = satisfy ((=) c) // This one will be used from now on!!!

//
// Examples (aka ad hoc tests) using Style A (TODO: Add Style B and Style C examples)
//

// Combined parser using Style A

// 1 arg combinator
let ascii (c: char) : int = int c

let asciiA (c: char) = ascii <!> (char c)

let asciiD = pure' ascii <*> (char 'D')
let asciiD' = ascii <!> (char 'D')

// Example 1: Testing map
// > run asciiD "Don Syme";;
// val it : .... = Some (68, "on Syme")

// 2 arg combinator
let sum (x: int) (y: int) = x + y

let asciiDo = sum <!> (asciiA 'D') <*> (asciiA 'o')

// Example 2: Testing apply
// Expected value is 86 + 111 = 179
// > run asciiDo "Don Syme";;
// val it : ..... = Some (179, "n Syme")

// 3 arg combinator
let cons3 (c1: char) (c2: char) (c3: char) = string c1 + string c2 + string c3

// using pure and apply
let parseDon = (pure' cons3) <*> (char 'D') <*> (char 'o') <*> (char 'n')

// using map and apply
let parseDon' = cons3 <!> char 'D' <*> char 'o' <*> char 'n'

// Example 3: Testing apply
// > "Don Syme" |> run parseDon;;
// val it : .... = Some ("Don", " Syme")

satisfy have a BUG, it should obviously use the predicate

let satisfy (predicate: char -> bool) : Parser<char> =
    // runParser :: (SpanInfo -> option<char * SpanInfo>)
    let f (i, s : string) : option<char * SpanInfo> =
        if (i < s.Length)
        then 
            let c = s.[i] 
            if (predicate c) then Some (c, (i + 1, s)) else None
        else None
    Parser f