toburger · January 19, 2016 15:27 · Jan 19, 2016 · Nov 18, 2015 · Nov 18, 2015 · Nov 17, 2015
diff --git a/ParserLibrary.fsx → ParserLibrary.fs b/ParserLibrary.fsx → ParserLibrary.fs
@@ -6,6 +6,8 @@ Final version of a parser library.
 Related blog post: http://fsharpforfunandprofit.com/posts/understanding-parser-combinators-3/
 *)
 
+module ParserLibrary
+
 module TextInput =
     open System
 

diff --git a/ParserLibrary.fsx b/ParserLibrary.fsx
@@ -35,7 +35,7 @@ module TextInput =
     let currentLine inputState = 
         let linePos = inputState.position.line
         if linePos < inputState.lines.Length then
-            inputState.lines.[inputState.position.line]
+            inputState.lines.[linePos]
         else
             "end of file"
 

diff --git a/understanding_parser_combinators-3.fsx b/understanding_parser_combinators-3.fsx
@@ -343,7 +343,7 @@ module TextInput =
     let currentLine inputState = 
         let linePos = inputState.position.line
         if linePos < inputState.lines.Length then
-            inputState.lines.[inputState.position.line]
+            inputState.lines.[linePos]
         else
             "end of file"
 

diff --git a/ParserLibrary.fsx b/ParserLibrary.fsx
@@ -33,7 +33,11 @@ module TextInput =
 
     // return the current line
     let currentLine inputState = 
-        inputState.lines.[inputState.position.line]
+        let linePos = inputState.position.line
+        if linePos < inputState.lines.Length then
+            inputState.lines.[inputState.position.line]
+        else
+            "end of file"
 
     /// Create a new InputState from a string
     let fromStr str = 

diff --git a/understanding_parser_combinators-3.fsx b/understanding_parser_combinators-3.fsx
@@ -341,7 +341,11 @@ module TextInput =
 
     // return the current line
     let currentLine inputState = 
-        inputState.lines.[inputState.position.line]
+        let linePos = inputState.position.line
+        if linePos < inputState.lines.Length then
+            inputState.lines.[inputState.position.line]
+        else
+            "end of file"
 
     /// Create a new InputState from a string
     let fromStr str = 

diff --git a/ParserLibrary.fsx b/ParserLibrary.fsx
@@ -158,9 +158,9 @@ let setLabel parser newLabel =
         | Success s ->
             // if Success, do nothing
             Success s 
-        | Failure (oldLabel,err,remainingInput) -> 
+        | Failure (oldLabel,err,pos) -> 
             // if Failure, return new label
-            Failure (newLabel,err,remainingInput) 
+            Failure (newLabel,err,pos) 
     // return the Parser
     {parseFn=newInnerFn; label=newLabel}
 
@@ -179,13 +179,15 @@ let satisfy predicate label =
         match charOpt with
         | None -> 
             let err = "No more input"
-            Failure (label,err,parserPositionFromInputState input)
+            let pos = parserPositionFromInputState input
+            Failure (label,err,pos)
         | Some first -> 
             if predicate first then
                 Success (first,remainingInput)
             else
                 let err = sprintf "Unexpected '%c'" first
-                Failure (label,err,parserPositionFromInputState input)
+                let pos = parserPositionFromInputState input
+                Failure (label,err,pos)
     // return the parser
     {parseFn=innerFn;label=label}
 
@@ -196,9 +198,9 @@ let bindP f p =
     let innerFn input =
         let result1 = runOnInput p input 
         match result1 with
-        | Failure (label,err,remainingInput) -> 
+        | Failure (label,err,pos) -> 
             // return error from parser1
-            Failure (label,err,remainingInput)  
+            Failure (label,err,pos)  
         | Success (value1,remainingInput) ->
             // apply f to get a new parser
             let p2 = f value1
@@ -390,27 +392,27 @@ let anyOf listOfChars =
     |> choice
     <?> label
 
+/// Convert a list of chars to a string
+let charListToStr charList =
+    String(List.toArray charList) 
+
 /// Parses a sequence of zero or more chars with the char parser cp. 
 /// It returns the parsed chars as a string.
 let manyChars cp =
     many cp
-    |>> fun charList -> String(List.toArray charList) 
+    |>> charListToStr
 
 /// Parses a sequence of one or more chars with the char parser cp. 
 /// It returns the parsed chars as a string.
 let manyChars1 cp =
     many1 cp
-    |>> fun charList -> String(List.toArray charList) 
+    |>> charListToStr
 
 /// parse a specific string
 let pstring str = 
     // label is just the string
     let label = str 
 
-    // Helper to create a string from a list of chars
-    let charListToStr charList = 
-            String(List.toArray charList)
-
     str
     // convert to list of char
     |> List.ofSeq
@@ -422,7 +424,6 @@ let pstring str =
     |> mapP charListToStr 
     <?> label
 
-
 // ------------------------------
 // whitespace parsing
 // ------------------------------
@@ -489,3 +490,5 @@ let pfloat =
     opt (pchar '-') .>>. digits .>>. pchar '.' .>>. digits 
     |> mapP resultToFloat
     <?> label
+
+
diff --git a/understanding_parser_combinators-3.fsx b/understanding_parser_combinators-3.fsx
@@ -93,9 +93,9 @@ module LabelledParser =
                 Success s 
             | Failure (oldLabel,err) -> 
                 // if Failure, return new label
-                Failure (newLabel,err) 
+                Failure (newLabel,err)         // <====== use newLabel here
         // return the Parser
-        {parseFn=newInnerFn; label=newLabel}
+        {parseFn=newInnerFn; label=newLabel}   // <====== use newLabel here 
 
     /// infix version of setLabel
     let ( <?> ) = setLabel
@@ -104,19 +104,19 @@ module LabelledParser =
     /// "bindP" takes a parser-producing function f, and a parser p
     /// and passes the output of p into f, to create a new parser
     let bindP f p =
-        let label = "unknown"
+        let label = "unknown"                     // <====== "label" is new! 
         let innerFn input =
             let result1 = run p input 
             match result1 with
-            | Failure (label,err) -> 
+            | Failure (label,err) ->              // <====== "label" is new! 
                 // return error from parser1
                 Failure (label,err)  
             | Success (value1,remainingInput) ->
                 // apply f to get a new parser
                 let p2 = f value1
                 // run parser with remaining input
                 run p2 remainingInput
-        {parseFn=innerFn; label=label}
+        {parseFn=innerFn; label=label}            // <====== "parseFn" and "label" are new!
 
     /// Infix version of bindP
     let ( >>= ) p f = bindP f p
@@ -159,7 +159,7 @@ module LabelledParser =
         p1 >>= (fun p1Result -> 
         p2 >>= (fun p2Result -> 
             returnP (p1Result,p2Result) ))
-        <?> label
+        <?> label                       // <====== provide a custom label
 
     /// Infix version of andThen
     let ( .>>. ) = andThen
@@ -209,7 +209,7 @@ module LabelledParser =
         listOfChars
         |> List.map pchar // convert into parsers
         |> choice
-        <?> label
+        <?> label                           // <====== provide a custom label
 
     module Label_Test =
 
@@ -282,7 +282,7 @@ module ReplacePcharWithSatisfy =
                 Failure (label,"No more input")
             else
                 let first = input.[0] 
-                if predicate first then
+                if predicate first then       // <====== use predicate here
                     let remainingInput = input.[1..]
                     Success (first,remainingInput)
                 else
@@ -487,9 +487,9 @@ module ParserWithPositionalErrors =
             | Success s ->
                 // if Success, do nothing
                 Success s 
-            | Failure (oldLabel,err,remainingInput) -> 
+            | Failure (oldLabel,err,pos) -> 
                 // if Failure, return new label
-                Failure (newLabel,err,remainingInput) 
+                Failure (newLabel,err,pos) 
         // return the Parser
         {parseFn=newInnerFn; label=newLabel}
 
@@ -504,13 +504,17 @@ module ParserWithPositionalErrors =
             match charOpt with
             | None -> 
                 let err = "No more input"
-                Failure (label,err,parserPositionFromInputState input)
+                let pos = parserPositionFromInputState input
+                //Failure (label,err)     // <====== old version
+                Failure (label,err,pos)   // <====== new version
             | Some first -> 
                 if predicate first then
                     Success (first,remainingInput)
                 else
                     let err = sprintf "Unexpected '%c'" first
-                    Failure (label,err,parserPositionFromInputState input)
+                    let pos = parserPositionFromInputState input
+                    //Failure (label,err)     // <====== old version
+                    Failure (label,err,pos)   // <====== new version
         // return the parser
         {parseFn=innerFn;label=label}
 
@@ -521,9 +525,9 @@ module ParserWithPositionalErrors =
         let innerFn input =
             let result1 = runOnInput p input 
             match result1 with
-            | Failure (label,err,remainingInput) -> 
+            | Failure (label,err,pos) ->       // <====== new with pos
                 // return error from parser1
-                Failure (label,err,remainingInput)  
+                Failure (label,err,pos)  
             | Success (value1,remainingInput) ->
                 // apply f to get a new parser
                 let p2 = f value1
@@ -739,27 +743,27 @@ module StandardParsers =
         |> choice
         <?> label
 
+    /// Convert a list of chars to a string
+    let charListToStr charList =
+        String(List.toArray charList) 
+
     /// Parses a sequence of zero or more chars with the char parser cp. 
     /// It returns the parsed chars as a string.
     let manyChars cp =
         many cp
-        |>> fun charList -> String(List.toArray charList) 
+        |>> charListToStr
 
     /// Parses a sequence of one or more chars with the char parser cp. 
     /// It returns the parsed chars as a string.
     let manyChars1 cp =
         many1 cp
-        |>> fun charList -> String(List.toArray charList) 
+        |>> charListToStr
 
     /// parse a specific string
     let pstring str = 
         // label is just the string
         let label = str 
 
-        // Helper to create a string from a list of chars
-        let charListToStr charList = 
-             String(List.toArray charList)
-
         str
         // convert to list of char
         |> List.ofSeq

diff --git a/ParserLibrary.fsx b/ParserLibrary.fsx
@@ -0,0 +1,491 @@
+(*
+ParserLibrary.fsx
+
+Final version of a parser library.
+
+Related blog post: http://fsharpforfunandprofit.com/posts/understanding-parser-combinators-3/
+*)
+
+module TextInput =
+    open System
+
+    type Position = {
+        line : int
+        column : int
+    }
+
+    /// define an initial position
+    let initialPos = {line=0; column=0}
+
+    /// increment the column number
+    let incrCol pos = 
+        {pos with column=pos.column + 1}
+
+    /// increment the line number and set the column to 0
+    let incrLine pos = 
+        {line=pos.line + 1; column=0}
+
+    /// Define the current input state
+    type InputState = {
+        lines : string[]
+        position : Position 
+    }
+
+    // return the current line
+    let currentLine inputState = 
+        inputState.lines.[inputState.position.line]
+
+    /// Create a new InputState from a string
+    let fromStr str = 
+        if String.IsNullOrEmpty(str) then
+            {lines=[||]; position=initialPos}
+        else
+            let separators = [| "\r\n"; "\n" |]
+            let lines = str.Split(separators, StringSplitOptions.None)
+            {lines=lines; position=initialPos}
+
+
+    /// Get the next character from the input, if any
+    /// else return None. Also return the updated InputState
+    /// Signature: InputState -> InputState * char option 
+    let nextChar input =
+        let linePos = input.position.line
+        let colPos = input.position.column
+        // three cases
+        // 1) if line >= maxLine -> 
+        //       return EOF
+        // 2) if col less than line length -> 
+        //       return char at colPos, increment colPos
+        // 3) if col at line length -> 
+        //       return NewLine, increment linePos
+
+        if linePos >= input.lines.Length then
+            input, None
+        else
+            let currentLine = currentLine input
+            if colPos < currentLine.Length then
+                let char = currentLine.[colPos]
+                let newPos = incrCol input.position 
+                let newState = {input with position=newPos}
+                newState, Some char
+            else 
+                // end of line, so return LF and move to next line
+                let char = '\n'
+                let newPos = incrLine input.position 
+                let newState = {input with position=newPos}
+                newState, Some char
+
+// ===========================================
+// Parser code
+// ===========================================
+
+open System
+
+// Aliases for input, etc
+type Input = TextInput.InputState   // type alias
+type ParserLabel = string
+type ParserError = string
+
+/// Stores information about the parser position for error messages
+type ParserPosition = {
+    currentLine : string
+    line : int
+    column : int
+    }
+
+// Result type
+type Result<'a> =
+    | Success of 'a
+    | Failure of ParserLabel * ParserError * ParserPosition 
+
+/// A Parser structure has a parsing function & label
+type Parser<'a> = {
+    parseFn : (Input -> Result<'a * Input>)
+    label:  ParserLabel 
+    }
+
+
+/// Run the parser on a InputState
+let runOnInput parser input = 
+    // call inner function with input
+    parser.parseFn input
+
+/// Run the parser on a string
+let run parser inputStr = 
+    // call inner function with input
+    runOnInput parser (TextInput.fromStr inputStr)
+
+// =============================================
+// Error messages
+// =============================================
+
+let parserPositionFromInputState (inputState:Input) = {
+    currentLine = TextInput.currentLine inputState
+    line = inputState.position.line
+    column = inputState.position.column
+    }
+
+let printResult result =
+    match result with
+    | Success (value,input) -> 
+        printfn "%A" value
+    | Failure (label,error,parserPos) -> 
+        let errorLine = parserPos.currentLine
+        let colPos = parserPos.column
+        let linePos = parserPos.line
+        let failureCaret = sprintf "%*s^%s" colPos "" error
+        // examples of formatting
+        //   sprintf "%*s^%s" 0 "" "test"
+        //   sprintf "%*s^%s" 10 "" "test"
+        printfn "Line:%i Col:%i Error parsing %s\n%s\n%s" linePos colPos label errorLine failureCaret 
+
+
+// =============================================
+// Label related
+// =============================================
+
+/// get the label from a parser
+let getLabel parser = 
+    // get label
+    parser.label
+
+/// update the label in the parser
+let setLabel parser newLabel = 
+    // change the inner function to use the new label
+    let newInnerFn input = 
+        let result = parser.parseFn input
+        match result with
+        | Success s ->
+            // if Success, do nothing
+            Success s 
+        | Failure (oldLabel,err,remainingInput) -> 
+            // if Failure, return new label
+            Failure (newLabel,err,remainingInput) 
+    // return the Parser
+    {parseFn=newInnerFn; label=newLabel}
+
+/// infix version of setLabel
+let ( <?> ) = setLabel
+
+
+// =============================================
+// Standard combinators
+// =============================================
+
+/// Match an input token if the predicate is satisfied
+let satisfy predicate label =
+    let innerFn input =
+        let remainingInput,charOpt = TextInput.nextChar input 
+        match charOpt with
+        | None -> 
+            let err = "No more input"
+            Failure (label,err,parserPositionFromInputState input)
+        | Some first -> 
+            if predicate first then
+                Success (first,remainingInput)
+            else
+                let err = sprintf "Unexpected '%c'" first
+                Failure (label,err,parserPositionFromInputState input)
+    // return the parser
+    {parseFn=innerFn;label=label}
+
+/// "bindP" takes a parser-producing function f, and a parser p
+/// and passes the output of p into f, to create a new parser
+let bindP f p =
+    let label = "unknown"
+    let innerFn input =
+        let result1 = runOnInput p input 
+        match result1 with
+        | Failure (label,err,remainingInput) -> 
+            // return error from parser1
+            Failure (label,err,remainingInput)  
+        | Success (value1,remainingInput) ->
+            // apply f to get a new parser
+            let p2 = f value1
+            // run parser with remaining input
+            runOnInput p2 remainingInput
+    {parseFn=innerFn; label=label}
+
+/// Infix version of bindP
+let ( >>= ) p f = bindP f p
+
+/// Lift a value to a Parser
+let returnP x = 
+    let label = sprintf "%A" x
+    let innerFn input =
+        // ignore the input and return x
+        Success (x,input)
+    // return the inner function
+    {parseFn=innerFn; label=label}
+
+/// apply a function to the value inside a parser
+let mapP f = 
+    bindP (f >> returnP)
+
+/// infix version of mapP
+let ( <!> ) = mapP
+
+/// "piping" version of mapP
+let ( |>> ) x f = mapP f x
+
+/// apply a wrapped function to a wrapped value
+let applyP fP xP =         
+    fP >>= (fun f -> 
+    xP >>= (fun x -> 
+        returnP (f x) ))
+
+/// infix version of apply
+let ( <*> ) = applyP
+
+/// lift a two parameter function to Parser World
+let lift2 f xP yP =
+    returnP f <*> xP <*> yP
+
+/// Combine two parsers as "A andThen B"
+let andThen p1 p2 =         
+    let label = sprintf "%s andThen %s" (getLabel p1) (getLabel p2)
+    p1 >>= (fun p1Result -> 
+    p2 >>= (fun p2Result -> 
+        returnP (p1Result,p2Result) ))
+    <?> label
+
+/// Infix version of andThen
+let ( .>>. ) = andThen
+
+/// Combine two parsers as "A orElse B"
+let orElse p1 p2 =
+    let label = sprintf "%s orElse %s" (getLabel p1) (getLabel p2)
+    let innerFn input =
+        // run parser1 with the input
+        let result1 = runOnInput p1 input
+
+        // test the result for Failure/Success
+        match result1 with
+        | Success result -> 
+            // if success, return the original result
+            result1
+
+        | Failure _ -> 
+            // if failed, run parser2 with the input
+            let result2 = runOnInput p2 input
+
+            // return parser2's result
+            result2 
+
+    // return the inner function
+    {parseFn=innerFn; label=label}
+
+/// Infix version of orElse
+let ( <|> ) = orElse
+
+/// Choose any of a list of parsers
+let choice listOfParsers = 
+    List.reduce ( <|> ) listOfParsers 
+
+let rec sequence parserList =
+    // define the "cons" function, which is a two parameter function
+    let cons head tail = head::tail
+
+    // lift it to Parser World
+    let consP = lift2 cons
+
+    // process the list of parsers recursively
+    match parserList with
+    | [] -> 
+        returnP []
+    | head::tail ->
+        consP head (sequence tail)
+
+/// (helper) match zero or more occurences of the specified parser
+let rec parseZeroOrMore parser input =
+    // run parser with the input
+    let firstResult = runOnInput parser input 
+    // test the result for Failure/Success
+    match firstResult with
+    | Failure (_,_,_) -> 
+        // if parse fails, return empty list
+        ([],input)  
+    | Success (firstValue,inputAfterFirstParse) -> 
+        // if parse succeeds, call recursively
+        // to get the subsequent values
+        let (subsequentValues,remainingInput) = 
+            parseZeroOrMore parser inputAfterFirstParse
+        let values = firstValue::subsequentValues
+        (values,remainingInput)  
+
+/// matches zero or more occurences of the specified parser
+let many parser = 
+    let label = sprintf "many %s" (getLabel parser)
+    let rec innerFn input =
+        // parse the input -- wrap in Success as it always succeeds
+        Success (parseZeroOrMore parser input)
+    {parseFn=innerFn; label=label}
+
+/// matches one or more occurences of the specified parser
+let many1 p =         
+    let label = sprintf "many1 %s" (getLabel p)
+
+    p      >>= (fun head -> 
+    many p >>= (fun tail -> 
+        returnP (head::tail) ))
+    <?> label
+
+/// Parses an optional occurrence of p and returns an option value.
+let opt p = 
+    let label = sprintf "opt %s" (getLabel p)
+    let some = p |>> Some
+    let none = returnP None
+    (some <|> none) <?> label
+
+/// Keep only the result of the left side parser
+let (.>>) p1 p2 = 
+    // create a pair
+    p1 .>>. p2 
+    // then only keep the first value
+    |> mapP (fun (a,b) -> a) 
+
+/// Keep only the result of the right side parser
+let (>>.) p1 p2 = 
+    // create a pair
+    p1 .>>. p2 
+    // then only keep the second value
+    |> mapP (fun (a,b) -> b) 
+
+/// Keep only the result of the middle parser
+let between p1 p2 p3 = 
+    p1 >>. p2 .>> p3 
+
+/// Parses one or more occurrences of p separated by sep
+let sepBy1 p sep =
+    let sepThenP = sep >>. p            
+    p .>>. many sepThenP 
+    |>> fun (p,pList) -> p::pList
+
+/// Parses zero or more occurrences of p separated by sep
+let sepBy p sep =
+    sepBy1 p sep <|> returnP []
+
+// =============================================
+// Standard parsers 
+// =============================================
+
+
+// ------------------------------
+// char and string parsing
+// ------------------------------
+
+/// parse a char 
+let pchar charToMatch = 
+    // label is just the character
+    let label = sprintf "%c" charToMatch 
+
+    let predicate ch = (ch = charToMatch) 
+    satisfy predicate label 
+
+/// Choose any of a list of characters
+let anyOf listOfChars = 
+    let label = sprintf "anyOf %A" listOfChars 
+    listOfChars
+    |> List.map pchar // convert into parsers
+    |> choice
+    <?> label
+
+/// Parses a sequence of zero or more chars with the char parser cp. 
+/// It returns the parsed chars as a string.
+let manyChars cp =
+    many cp
+    |>> fun charList -> String(List.toArray charList) 
+
+/// Parses a sequence of one or more chars with the char parser cp. 
+/// It returns the parsed chars as a string.
+let manyChars1 cp =
+    many1 cp
+    |>> fun charList -> String(List.toArray charList) 
+
+/// parse a specific string
+let pstring str = 
+    // label is just the string
+    let label = str 
+
+    // Helper to create a string from a list of chars
+    let charListToStr charList = 
+            String(List.toArray charList)
+
+    str
+    // convert to list of char
+    |> List.ofSeq
+    // map each char to a pchar
+    |> List.map pchar 
+    // convert to Parser<char list>
+    |> sequence
+    // convert Parser<char list> to Parser<string>
+    |> mapP charListToStr 
+    <?> label
+
+
+// ------------------------------
+// whitespace parsing
+// ------------------------------
+
+/// parse a whitespace char
+let whitespaceChar = 
+    let predicate = Char.IsWhiteSpace 
+    let label = "whitespace"
+    satisfy predicate label 
+
+/// parse zero or more whitespace char
+let spaces = many whitespaceChar
+
+/// parse one or more whitespace char
+let spaces1 = many1 whitespaceChar
+
+
+
+// ------------------------------
+// number parsing
+// ------------------------------
+
+/// parse a digit
+let digitChar = 
+    let predicate = Char.IsDigit 
+    let label = "digit"
+    satisfy predicate label 
+
+
+// parse an integer
+let pint = 
+    let label = "integer" 
+
+    // helper
+    let resultToInt (sign,digits) = 
+        let i = digits |> int  // ignore int overflow for now
+        match sign with
+        | Some ch -> -i  // negate the int
+        | None -> i
+
+    // define parser for one or more digits
+    let digits = manyChars1 digitChar 
+
+    // an "int" is optional sign + one or more digits
+    opt (pchar '-') .>>. digits 
+    |> mapP resultToInt
+    <?> label
+
+// parse a float
+let pfloat = 
+    let label = "float" 
+
+    // helper
+    let resultToFloat (((sign,digits1),point),digits2) = 
+        let fl = sprintf "%s.%s" digits1 digits2 |> float
+        match sign with
+        | Some ch -> -fl  // negate the float
+        | None -> fl
+
+    // define parser for one or more digits 
+    let digits = manyChars1 digitChar 
+
+    // a float is sign, digits, point, digits (ignore exponents for now)
+    opt (pchar '-') .>>. digits .>>. pchar '.' .>>. digits 
+    |> mapP resultToFloat
+    <?> label
diff --git a/understanding_parser_combinators-3.fsx b/understanding_parser_combinators-3.fsx
@@ -0,0 +1,895 @@
+(*
+understanding_parser_combinators-3.fsx
+
+Adding more informative errors to the parser library.
+
+Related blog post: http://fsharpforfunandprofit.com/posts/understanding-parser-combinators-3/
+*)
+
+
+// =============================================
+// Section 1 -- Labeled parsers
+// =============================================
+
+
+(*
+// The problem:
+
+let parseDigit = anyOf ['0'..'9']
+run parseDigit "|ABC"  // Failure "Expecting '9'. Got '|'"
+
+// We want error to say: Failure "Expecting digit. Got '|'"
+*)
+
+
+module LabelledParser =
+
+    open System
+
+    // Aliases 
+    type ParserLabel = string
+    type ParserError = string
+
+    // Result type
+    type Result<'a> =
+        | Success of 'a
+        | Failure of ParserLabel * ParserError 
+
+    (*
+    // before
+    type Parser<'a> = Parser of (string -> Result<'a * string>)
+    *)
+
+    /// A Parser structure has a parsing function & label
+    type Parser<'a> = {
+        parseFn : (string -> Result<'a * string>)
+        label:  ParserLabel 
+        }
+
+    let printResult result =
+        match result with
+        | Success (value,input) -> 
+            printfn "%A" value
+        | Failure (label,error) -> 
+            printfn "Error parsing %s\n%s" label error
+
+    /// parse a char 
+    let pchar charToMatch = 
+        let label = sprintf "%c" charToMatch 
+        let innerFn input =
+            if String.IsNullOrEmpty(input) then
+                Failure (label,"No more input")
+            else
+                let first = input.[0] 
+                if first = charToMatch then
+                    let remainingInput = input.[1..]
+                    Success (charToMatch,remainingInput)
+                else
+                    let err = sprintf "Unexpected '%c'" first
+                    Failure (label,err)
+        // return the parser
+        {parseFn=innerFn;label=label}
+
+    /// Run a parser with some input
+    let run parser input = 
+        // get inner function
+        let innerFn = parser.parseFn 
+        // call inner function with input
+        innerFn input
+
+    /// get the label from a parser
+    let getLabel parser = 
+        // get label
+        parser.label
+
+    /// update the label in the parser
+    let setLabel parser newLabel = 
+        // change the inner function to use the new label
+        let newInnerFn input = 
+            let result = parser.parseFn input
+            match result with
+            | Success s ->
+                // if Success, do nothing
+                Success s 
+            | Failure (oldLabel,err) -> 
+                // if Failure, return new label
+                Failure (newLabel,err) 
+        // return the Parser
+        {parseFn=newInnerFn; label=newLabel}
+
+    /// infix version of setLabel
+    let ( <?> ) = setLabel
+
+
+    /// "bindP" takes a parser-producing function f, and a parser p
+    /// and passes the output of p into f, to create a new parser
+    let bindP f p =
+        let label = "unknown"
+        let innerFn input =
+            let result1 = run p input 
+            match result1 with
+            | Failure (label,err) -> 
+                // return error from parser1
+                Failure (label,err)  
+            | Success (value1,remainingInput) ->
+                // apply f to get a new parser
+                let p2 = f value1
+                // run parser with remaining input
+                run p2 remainingInput
+        {parseFn=innerFn; label=label}
+
+    /// Infix version of bindP
+    let ( >>= ) p f = bindP f p
+
+    /// Lift a value to a Parser
+    let returnP x = 
+        let label = sprintf "%A" x
+        let innerFn input =
+            // ignore the input and return x
+            Success (x,input)
+        // return the inner function
+        {parseFn=innerFn; label=label}
+
+    /// apply a function to the value inside a parser
+    let mapP f = 
+        bindP (f >> returnP)
+
+    /// infix version of mapP
+    let ( <!> ) = mapP
+
+    /// "piping" version of mapP
+    let ( |>> ) x f = mapP f x
+
+    /// apply a wrapped function to a wrapped value
+    let applyP fP xP =         
+        fP >>= (fun f -> 
+        xP >>= (fun x -> 
+            returnP (f x) ))
+
+    /// infix version of apply
+    let ( <*> ) = applyP
+
+    /// lift a two parameter function to Parser World
+    let lift2 f xP yP =
+        returnP f <*> xP <*> yP
+
+    /// Combine two parsers as "A andThen B"
+    let andThen p1 p2 =         
+        let label = sprintf "%s andThen %s" (getLabel p1) (getLabel p2)
+        p1 >>= (fun p1Result -> 
+        p2 >>= (fun p2Result -> 
+            returnP (p1Result,p2Result) ))
+        <?> label
+
+    /// Infix version of andThen
+    let ( .>>. ) = andThen
+
+    // combine two parsers as "A orElse B"
+    let orElse parser1 parser2 =
+        // construct a new label
+        let label = sprintf "%s orElse %s" (getLabel parser1) (getLabel parser2)
+
+        let innerFn input =
+            // run parser1 with the input
+            let result1 = run parser1 input
+
+            // test the result for Failure/Success
+            match result1 with
+            | Success result -> 
+                // if success, return the result
+                result1
+
+            | Failure (_,err) -> 
+                // if failed, run parser2 with the input
+                let result2 = run parser2 input
+
+                // return parser2's result
+                match result2 with
+                | Success _ -> 
+                    // if success, return the result
+                    result2
+
+                | Failure (_,err) -> 
+                    // if failed, return the error with overall label
+                    Failure (label,err)
+
+        // return the Parser
+        {parseFn=innerFn; label=label}
+
+    // infix version of orElse
+    let ( <|> ) = orElse
+
+    /// choose any of a list of parsers
+    let choice listOfParsers = 
+        List.reduce ( <|> ) listOfParsers 
+
+    /// choose any of a list of characters
+    let anyOf listOfChars = 
+        let label = sprintf "any of %A" listOfChars 
+        listOfChars
+        |> List.map pchar // convert into parsers
+        |> choice
+        <?> label
+
+    module Label_Test =
+
+        let parseAB = 
+            pchar 'A' .>>. pchar 'B' 
+
+        run parseAB "A|C"  
+        |> printResult
+        // Error parsing A andThen B
+        // Unexpected '|'
+
+        let parseAB_WithLabel = 
+            pchar 'A' .>>. pchar 'B' 
+            <?> "AB"
+
+        run parseAB_WithLabel  "A|C"  
+        |> printResult
+        // Error parsing AB
+        // Unexpected '|'
+
+        let parseDigit = 
+            anyOf ['0'..'9']
+
+        run parseDigit "|ABC"  
+        |> printResult
+        // Error parsing any of ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9']
+        // Unexpected '|'
+
+        let parseDigit_WithLabel = 
+            anyOf ['0'..'9'] 
+            <?> "digit"
+
+        run parseDigit_WithLabel "|ABC"  
+        |> printResult
+        // Error parsing digit
+        // Unexpected '|'
+
+        type Keyword = IF | FOR
+
+        let keyword_IF = 
+            pchar 'i' .>>. pchar 'f' |>> (fun _ -> IF)
+        let keyword_FOR = 
+            pchar 'f' .>>. pchar 'o' .>>. pchar 'r' |>> (fun _ -> FOR)
+        let keyword = 
+            choice [keyword_IF; keyword_FOR]
+            <?> "keyword"
+
+        run keyword "if x then"  
+        |> printResult
+        // IF
+
+        run keyword "while x then"  
+        |> printResult
+        // Error parsing keyword
+        // Unexpected 'w'
+
+// =============================================
+// Section 2 - replacing "pchar" with "satisfy"
+// =============================================
+
+module ReplacePcharWithSatisfy =
+    open System
+    open LabelledParser 
+
+
+    /// Match an input token if the predicate is satisfied
+    let satisfy predicate label =
+        let innerFn input =
+            if String.IsNullOrEmpty(input) then
+                Failure (label,"No more input")
+            else
+                let first = input.[0] 
+                if predicate first then
+                    let remainingInput = input.[1..]
+                    Success (first,remainingInput)
+                else
+                    let err = sprintf "Unexpected '%c'" first
+                    Failure (label,err)
+        // return the parser
+        {parseFn=innerFn;label=label}
+
+    /// parse a char 
+    let pchar charToMatch = 
+        let predicate ch = (ch = charToMatch) 
+        let label = sprintf "%c" charToMatch 
+        satisfy predicate label 
+
+    /// parse a digit
+    let digitChar = 
+        let predicate = Char.IsDigit 
+        let label = "digit"
+        satisfy predicate label 
+
+    /// parse a whitespace char
+    let whitespaceChar = 
+        let predicate = Char.IsWhiteSpace 
+        let label = "whitespace"
+        satisfy predicate label 
+
+// =============================================
+// Section 3. Adding positional context to error messages
+// =============================================
+
+
+module TextInput =
+    open System
+
+    type Position = {
+        line : int
+        column : int
+    }
+
+    /// define an initial position
+    let initialPos = {line=0; column=0}
+
+    /// increment the column number
+    let incrCol pos = 
+        {pos with column=pos.column + 1}
+
+    /// increment the line number and set the column to 0
+    let incrLine pos = 
+        {line=pos.line + 1; column=0}
+
+    /// Define the current input state
+    type InputState = {
+        lines : string[]
+        position : Position 
+    }
+
+    // return the current line
+    let currentLine inputState = 
+        inputState.lines.[inputState.position.line]
+
+    /// Create a new InputState from a string
+    let fromStr str = 
+        if String.IsNullOrEmpty(str) then
+            {lines=[||]; position=initialPos}
+        else
+            let separators = [| "\r\n"; "\n" |]
+            let lines = str.Split(separators, StringSplitOptions.None)
+            {lines=lines; position=initialPos}
+
+
+    /// Get the next character from the input, if any
+    /// else return None. Also return the updated InputState
+    /// Signature: InputState -> InputState * char option 
+    let nextChar input =
+        let linePos = input.position.line
+        let colPos = input.position.column
+        // three cases
+        // 1) if line >= maxLine -> 
+        //       return EOF
+        // 2) if col less than line length -> 
+        //       return char at colPos, increment colPos
+        // 3) if col at line length -> 
+        //       return NewLine, increment linePos
+
+        if linePos >= input.lines.Length then
+            input, None
+        else
+            let currentLine = currentLine input
+            if colPos < currentLine.Length then
+                let char = currentLine.[colPos]
+                let newPos = incrCol input.position 
+                let newState = {input with position=newPos}
+                newState, Some char
+            else 
+                // end of line, so return LF and move to next line
+                let char = '\n'
+                let newPos = incrLine input.position 
+                let newState = {input with position=newPos}
+                newState, Some char
+
+    // ---------  
+    // test 
+    // --------- 
+    module Input_Test =
+        let rec readAllChars input =
+            [
+                let remainingInput,charOpt = nextChar input 
+                match charOpt with
+                | None -> 
+                    // end of input
+                    ()
+                | Some ch -> 
+                    // return first character
+                    yield ch
+                    // return the remaining characters
+                    yield! readAllChars remainingInput
+            ]
+
+        fromStr "" |> readAllChars       // []
+        fromStr "a" |> readAllChars      // ['a'; '\n']
+        fromStr "ab" |> readAllChars     // ['a'; 'b'; '\n']
+        fromStr "a\nb" |> readAllChars   // ['a'; '\n'; 'b'; '\n']
+
+module ParserWithPositionalErrors =
+
+    open System
+
+    // Aliases for input, etc
+    type Input = TextInput.InputState   // type alias
+    type ParserLabel = string
+    type ParserError = string
+
+    /// Stores information about the parser position for error messages
+    type ParserPosition = {
+        currentLine : string
+        line : int
+        column : int
+        }
+
+    // Result type
+    type Result<'a> =
+        | Success of 'a
+        | Failure of ParserLabel * ParserError * ParserPosition 
+
+    /// A Parser structure has a parsing function & label
+    type Parser<'a> = {
+        parseFn : (Input -> Result<'a * Input>)
+        label:  ParserLabel 
+        }
+
+    let parserPositionFromInputState (inputState:Input) = {
+        currentLine = TextInput.currentLine inputState
+        line = inputState.position.line
+        column = inputState.position.column
+        }
+
+    let printResult result =
+        match result with
+        | Success (value,input) -> 
+            printfn "%A" value
+        | Failure (label,error,parserPos) -> 
+            let errorLine = parserPos.currentLine
+            let colPos = parserPos.column
+            let linePos = parserPos.line
+            let failureCaret = sprintf "%*s^%s" colPos "" error
+            // examples of formatting
+            //   sprintf "%*s^%s" 0 "" "test"
+            //   sprintf "%*s^%s" 10 "" "test"
+            printfn "Line:%i Col:%i Error parsing %s\n%s\n%s" linePos colPos label errorLine failureCaret 
+
+    (*
+    let exampleError = 
+        Failure ("identifier", "unexpected |",
+                 {currentLine = "123 ab|cd"; line=1; column=6})
+    printResult exampleError 
+    // Line:1 Col:6 Error parsing identifier
+    // 123 ab|cd
+    //       ^unexpected |
+    *)
+
+    /// Run the parser on a InputState
+    let runOnInput parser input = 
+        // call inner function with input
+        parser.parseFn input
+
+    /// Run the parser on a string
+    let run parser inputStr = 
+        // call inner function with input
+        runOnInput parser (TextInput.fromStr inputStr)
+
+    /// get the label from a parser
+    let getLabel parser = 
+        // get label
+        parser.label
+
+    /// update the label in the parser
+    let setLabel parser newLabel = 
+        // change the inner function to use the new label
+        let newInnerFn input = 
+            let result = parser.parseFn input
+            match result with
+            | Success s ->
+                // if Success, do nothing
+                Success s 
+            | Failure (oldLabel,err,remainingInput) -> 
+                // if Failure, return new label
+                Failure (newLabel,err,remainingInput) 
+        // return the Parser
+        {parseFn=newInnerFn; label=newLabel}
+
+    /// infix version of setLabel
+    let ( <?> ) = setLabel
+
+
+    /// Match an input token if the predicate is satisfied
+    let satisfy predicate label =
+        let innerFn input =
+            let remainingInput,charOpt = TextInput.nextChar input 
+            match charOpt with
+            | None -> 
+                let err = "No more input"
+                Failure (label,err,parserPositionFromInputState input)
+            | Some first -> 
+                if predicate first then
+                    Success (first,remainingInput)
+                else
+                    let err = sprintf "Unexpected '%c'" first
+                    Failure (label,err,parserPositionFromInputState input)
+        // return the parser
+        {parseFn=innerFn;label=label}
+
+    /// "bindP" takes a parser-producing function f, and a parser p
+    /// and passes the output of p into f, to create a new parser
+    let bindP f p =
+        let label = "unknown"
+        let innerFn input =
+            let result1 = runOnInput p input 
+            match result1 with
+            | Failure (label,err,remainingInput) -> 
+                // return error from parser1
+                Failure (label,err,remainingInput)  
+            | Success (value1,remainingInput) ->
+                // apply f to get a new parser
+                let p2 = f value1
+                // run parser with remaining input
+                runOnInput p2 remainingInput
+        {parseFn=innerFn; label=label}
+
+    /// Infix version of bindP
+    let ( >>= ) p f = bindP f p
+
+    /// Lift a value to a Parser
+    let returnP x = 
+        let label = sprintf "%A" x
+        let innerFn input =
+            // ignore the input and return x
+            Success (x,input)
+        // return the inner function
+        {parseFn=innerFn; label=label}
+
+    /// apply a function to the value inside a parser
+    let mapP f = 
+        bindP (f >> returnP)
+
+    /// infix version of mapP
+    let ( <!> ) = mapP
+
+    /// "piping" version of mapP
+    let ( |>> ) x f = mapP f x
+
+    /// apply a wrapped function to a wrapped value
+    let applyP fP xP =         
+        fP >>= (fun f -> 
+        xP >>= (fun x -> 
+            returnP (f x) ))
+
+    /// infix version of apply
+    let ( <*> ) = applyP
+
+    /// lift a two parameter function to Parser World
+    let lift2 f xP yP =
+        returnP f <*> xP <*> yP
+
+    /// Combine two parsers as "A andThen B"
+    let andThen p1 p2 =         
+        let label = sprintf "%s andThen %s" (getLabel p1) (getLabel p2)
+        p1 >>= (fun p1Result -> 
+        p2 >>= (fun p2Result -> 
+            returnP (p1Result,p2Result) ))
+        <?> label
+
+    /// Infix version of andThen
+    let ( .>>. ) = andThen
+
+    /// Combine two parsers as "A orElse B"
+    let orElse p1 p2 =
+        let label = sprintf "%s orElse %s" (getLabel p1) (getLabel p2)
+        let innerFn input =
+            // run parser1 with the input
+            let result1 = runOnInput p1 input
+
+            // test the result for Failure/Success
+            match result1 with
+            | Success result -> 
+                // if success, return the original result
+                result1
+
+            | Failure _ -> 
+                // if failed, run parser2 with the input
+                let result2 = runOnInput p2 input
+
+                // return parser2's result
+                result2 
+
+        // return the inner function
+        {parseFn=innerFn; label=label}
+
+    /// Infix version of orElse
+    let ( <|> ) = orElse
+
+    /// Choose any of a list of parsers
+    let choice listOfParsers = 
+        List.reduce ( <|> ) listOfParsers 
+
+    let rec sequence parserList =
+        // define the "cons" function, which is a two parameter function
+        let cons head tail = head::tail
+
+        // lift it to Parser World
+        let consP = lift2 cons
+
+        // process the list of parsers recursively
+        match parserList with
+        | [] -> 
+            returnP []
+        | head::tail ->
+            consP head (sequence tail)
+
+    /// (helper) match zero or more occurences of the specified parser
+    let rec parseZeroOrMore parser input =
+        // run parser with the input
+        let firstResult = runOnInput parser input 
+        // test the result for Failure/Success
+        match firstResult with
+        | Failure (_,_,_) -> 
+            // if parse fails, return empty list
+            ([],input)  
+        | Success (firstValue,inputAfterFirstParse) -> 
+            // if parse succeeds, call recursively
+            // to get the subsequent values
+            let (subsequentValues,remainingInput) = 
+                parseZeroOrMore parser inputAfterFirstParse
+            let values = firstValue::subsequentValues
+            (values,remainingInput)  
+
+    /// matches zero or more occurences of the specified parser
+    let many parser = 
+        let label = sprintf "many %s" (getLabel parser)
+        let rec innerFn input =
+            // parse the input -- wrap in Success as it always succeeds
+            Success (parseZeroOrMore parser input)
+        {parseFn=innerFn; label=label}
+
+    /// matches one or more occurences of the specified parser
+    let many1 p =         
+        let label = sprintf "many1 %s" (getLabel p)
+
+        p      >>= (fun head -> 
+        many p >>= (fun tail -> 
+            returnP (head::tail) ))
+        <?> label
+
+    /// Parses an optional occurrence of p and returns an option value.
+    let opt p = 
+        let label = sprintf "opt %s" (getLabel p)
+        let some = p |>> Some
+        let none = returnP None
+        (some <|> none) <?> label
+
+    /// Keep only the result of the left side parser
+    let (.>>) p1 p2 = 
+        // create a pair
+        p1 .>>. p2 
+        // then only keep the first value
+        |> mapP (fun (a,b) -> a) 
+
+    /// Keep only the result of the right side parser
+    let (>>.) p1 p2 = 
+        // create a pair
+        p1 .>>. p2 
+        // then only keep the second value
+        |> mapP (fun (a,b) -> b) 
+
+    /// Keep only the result of the middle parser
+    let between p1 p2 p3 = 
+        p1 >>. p2 .>> p3 
+
+    /// Parses one or more occurrences of p separated by sep
+    let sepBy1 p sep =
+        let sepThenP = sep >>. p            
+        p .>>. many sepThenP 
+        |>> fun (p,pList) -> p::pList
+
+    /// Parses zero or more occurrences of p separated by sep
+    let sepBy p sep =
+        sepBy1 p sep <|> returnP []
+
+
+    module PositionalError_Test =
+
+        /// parse a char 
+        let pchar charToMatch = 
+            let predicate ch = (ch = charToMatch) 
+            let label = sprintf "%c" charToMatch 
+            satisfy predicate label 
+
+        let parseAB = 
+            pchar 'A' .>>. pchar 'B' 
+            <?> "AB"
+
+        run parseAB "A|C"  
+        |> printResult
+        // Line:0 Col:1 Error parsing AB
+        // A|C
+        //  ^Unexpected '|'
+
+
+
+// =============================================
+// Section 4. Adding some standard parsers to the library
+// =============================================
+
+module StandardParsers =
+    open System
+    open ParserWithPositionalErrors
+
+    // ------------------------------
+    // char and string parsing
+    // ------------------------------
+
+    /// parse a char 
+    let pchar charToMatch = 
+        // label is just the character
+        let label = sprintf "%c" charToMatch 
+
+        let predicate ch = (ch = charToMatch) 
+        satisfy predicate label 
+
+    /// Choose any of a list of characters
+    let anyOf listOfChars = 
+        let label = sprintf "anyOf %A" listOfChars 
+        listOfChars
+        |> List.map pchar // convert into parsers
+        |> choice
+        <?> label
+
+    /// Parses a sequence of zero or more chars with the char parser cp. 
+    /// It returns the parsed chars as a string.
+    let manyChars cp =
+        many cp
+        |>> fun charList -> String(List.toArray charList) 
+
+    /// Parses a sequence of one or more chars with the char parser cp. 
+    /// It returns the parsed chars as a string.
+    let manyChars1 cp =
+        many1 cp
+        |>> fun charList -> String(List.toArray charList) 
+
+    /// parse a specific string
+    let pstring str = 
+        // label is just the string
+        let label = str 
+
+        // Helper to create a string from a list of chars
+        let charListToStr charList = 
+             String(List.toArray charList)
+
+        str
+        // convert to list of char
+        |> List.ofSeq
+        // map each char to a pchar
+        |> List.map pchar 
+        // convert to Parser<char list>
+        |> sequence
+        // convert Parser<char list> to Parser<string>
+        |> mapP charListToStr 
+        <?> label
+
+    module StringParsers_Test =
+
+        run (pstring "AB") "ABC"  
+        |> printResult   
+        // Success
+        // "AB"
+
+        run (pstring "AB") "A|C"  
+        |> printResult
+        // Line:0 Col:1 Error parsing AB
+        // A|C
+        //  ^Unexpected '|'
+
+
+
+    // ------------------------------
+    // whitespace parsing
+    // ------------------------------
+
+    /// parse a whitespace char
+    let whitespaceChar = 
+        let predicate = Char.IsWhiteSpace 
+        let label = "whitespace"
+        satisfy predicate label 
+
+    /// parse zero or more whitespace char
+    let spaces = many whitespaceChar
+
+    /// parse one or more whitespace char
+    let spaces1 = many1 whitespaceChar
+
+    module WhitespaceParsers_Test =
+
+        run spaces " ABC"  
+        |> printResult   
+        // [' ']
+
+        run spaces "A"  
+        |> printResult
+        // []
+
+        run spaces1 " ABC"  
+        |> printResult   
+        // [' ']
+
+        run spaces1 "A"  
+        |> printResult
+        // Line:0 Col:0 Error parsing many1 whitespace
+        // A
+        // ^Unexpected 'A'
+
+
+    // ------------------------------
+    // number parsing
+    // ------------------------------
+
+    /// parse a digit
+    let digitChar = 
+        let predicate = Char.IsDigit 
+        let label = "digit"
+        satisfy predicate label 
+
+
+    // parse an integer
+    let pint = 
+        let label = "integer" 
+
+        // helper
+        let resultToInt (sign,digits) = 
+            let i = digits |> int  // ignore int overflow for now
+            match sign with
+            | Some ch -> -i  // negate the int
+            | None -> i
+
+        // define parser for one or more digits
+        let digits = manyChars1 digitChar 
+
+        // an "int" is optional sign + one or more digits
+        opt (pchar '-') .>>. digits 
+        |> mapP resultToInt
+        <?> label
+
+    // parse a float
+    let pfloat = 
+        let label = "float" 
+
+        // helper
+        let resultToFloat (((sign,digits1),point),digits2) = 
+            let fl = sprintf "%s.%s" digits1 digits2 |> float
+            match sign with
+            | Some ch -> -fl  // negate the float
+            | None -> fl
+
+        // define parser for one or more digits 
+        let digits = manyChars1 digitChar 
+
+        // a float is sign, digits, point, digits (ignore exponents for now)
+        opt (pchar '-') .>>. digits .>>. pchar '.' .>>. digits 
+        |> mapP resultToFloat
+        <?> label
+
+    module NumericParsers_Test =
+
+        run pint "-123Z" 
+        |> printResult   
+        // -123
+
+        run pint "-Z123" 
+        |> printResult
+        // Line:0 Col:1 Error parsing integer
+        // -Z123
+        //  ^Unexpected 'Z'
+
+        run pfloat "-123.45Z" 
+        |> printResult   
+        // -123.45
+
+        run pfloat "-123Z45" 
+        |> printResult
+        // Line:0 Col:4 Error parsing float
+        // -123Z45
+        //     ^Unexpected 'Z'