Regex Applicative Functor

Give a way to apply captures values on a given function

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 
86: 
87:

open System
open System.Text.RegularExpressions

let regexOptions = RegexOptions.CultureInvariant ||| RegexOptions.IgnoreCase

type Result<'a> = 
    { Result : 'a
      Tail : string }

type ResultState<'a> = 
    | Success of Result<'a>
    | Failure of string

type Pattern = 
    | Pattern of string

type Capture<'a> = 
    | Capture of (string list -> 'a option)

type Parser<'a> = 
    | Parser of Capture<'a> * Pattern

let regex (Parser(Capture f, Pattern pattern)) input = 
    let m = Regex.Match(input, pattern, regexOptions)
    if m.Success then 
        let values = 
            [ for g in m.Groups -> g.Value ]
        
        let value = 
            values
            |> List.head
            |> Seq.length
        
        match f (values |> List.tail) with
        | Some result -> 
            { Result = result
              Tail = input.Substring(m.Index + value) }
            |> Success
        | None -> Failure input
    else Failure input

let apply parse f = 
    match f with
    | Success f' -> 
        match parse f'.Tail with
        | Success r' -> 
            Success { Result = f'.Result r'.Result
                      Tail = r'.Tail }
        | Failure failure -> Failure failure
    | Failure failure -> Failure failure

let map f input = 
    Success { Result = f
              Tail = input }

let timeSpan = 
    function 
    | [ i; "m" ] | [ i; "mn" ] -> TimeSpan.FromMinutes(float i) |> Some
    | [ i; "h" ] -> TimeSpan.FromHours(float i) |> Some
    | [ i; "s" ] -> TimeSpan.FromSeconds(float i) |> Some
    | _ -> None

type Command = Inspect
let nc r = Capture (fun _ -> Some r)

let inspectCommand = 
    function 
    | [ "inspect" ] -> Some Inspect
    | _ -> None

let inspector command t1 t2 = command, t1, t2

let parseTime = 
    (Capture timeSpan, Pattern """\b([0-9]+)(mn|m|h|s)""")
    |> Parser
    |> regex

let parseInspect = 
    (nc Inspect, Pattern """(inspect)""")
    |> Parser
    |> regex

"inspect every 10s toto 23mn"
|> map inspector
|> apply parseInspect
|> apply parseTime
|> apply parseTime

namespace System

namespace System.Text

namespace System.Text.RegularExpressions

val regexOptions : RegexOptions

Full name: Script.regexOptions

field RegexOptions.CultureInvariant = 512

field RegexOptions.IgnoreCase = 1

type Result<'a> =
{Result: 'a;
Tail: string;}

Full name: Script.Result<_>

Multiple items
Result.Result: 'a

--------------------
type Result<'a> =
{Result: 'a;
Tail: string;}

Full name: Script.Result<_>

Result.Tail: string

Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string

type ResultState<'a> =
| Success of Result<'a>
| Failure of string

Full name: Script.ResultState<_>

union case ResultState.Success: Result<'a> -> ResultState<'a>

Multiple items
union case ResultState.Failure: string -> ResultState<'a>

--------------------
active recognizer Failure: exn -> string option

Full name: Microsoft.FSharp.Core.Operators.( |Failure|_| )

Multiple items
union case Pattern.Pattern: string -> Pattern

--------------------
type Pattern = | Pattern of string

Full name: Script.Pattern

Multiple items
union case Capture.Capture: (string list -> 'a option) -> Capture<'a>

--------------------
type Capture =
  member Index : int
  member Length : int
  member ToString : unit -> string
  member Value : string

Full name: System.Text.RegularExpressions.Capture

--------------------
type Capture<'a> = | Capture of (string list -> 'a option)

Full name: Script.Capture<_>

type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>

type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>

Multiple items
union case Parser.Parser: Capture<'a> * Pattern -> Parser<'a>

--------------------
type Parser<'a> = | Parser of Capture<'a> * Pattern

Full name: Script.Parser<_>

val regex : Parser<'a> -> input:string -> ResultState<'a>

Full name: Script.regex

val f : (string list -> 'a option)

val pattern : string

val input : string

val m : Match

Multiple items
type Regex =
  new : pattern:string -> Regex + 1 overload
  member GetGroupNames : unit -> string[]
  member GetGroupNumbers : unit -> int[]
  member GroupNameFromNumber : i:int -> string
  member GroupNumberFromName : name:string -> int
  member IsMatch : input:string -> bool + 1 overload
  member Match : input:string -> Match + 2 overloads
  member Matches : input:string -> MatchCollection + 1 overload
  member Options : RegexOptions
  member Replace : input:string * replacement:string -> string + 5 overloads
  ...

Full name: System.Text.RegularExpressions.Regex

--------------------
Regex(pattern: string) : unit
Regex(pattern: string, options: RegexOptions) : unit

Regex.Match(input: string, pattern: string) : Match
Regex.Match(input: string, pattern: string, options: RegexOptions) : Match

property Group.Success: bool

val values : string list

val g : Group

property Match.Groups: GroupCollection

property Capture.Value: string

val value : int

Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>

val head : list:'T list -> 'T

Full name: Microsoft.FSharp.Collections.List.head

module Seq

from Microsoft.FSharp.Collections

val length : source:seq<'T> -> int

Full name: Microsoft.FSharp.Collections.Seq.length

val tail : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.tail

union case Option.Some: Value: 'T -> Option<'T>

val result : 'a

String.Substring(startIndex: int) : string
String.Substring(startIndex: int, length: int) : string

property Capture.Index: int

union case Option.None: Option<'T>

union case ResultState.Failure: string -> ResultState<'a>

val apply : parse:(string -> ResultState<'a>) -> f:ResultState<('a -> 'b)> -> ResultState<'b>

Full name: Script.apply

val parse : (string -> ResultState<'a>)

val f : ResultState<('a -> 'b)>

val f' : Result<('a -> 'b)>

val r' : Result<'a>

Result.Result: 'a -> 'b

Result.Result: 'a

val failure : string

val map : f:'a -> input:string -> ResultState<'a>

Full name: Script.map

val f : 'a

val timeSpan : _arg1:string list -> TimeSpan option

Full name: Script.timeSpan

val i : string

Multiple items
type TimeSpan =
  struct
    new : ticks:int64 -> TimeSpan + 3 overloads
    member Add : ts:TimeSpan -> TimeSpan
    member CompareTo : value:obj -> int + 1 overload
    member Days : int
    member Duration : unit -> TimeSpan
    member Equals : value:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member Hours : int
    member Milliseconds : int
    member Minutes : int
    ...
  end

Full name: System.TimeSpan

--------------------
TimeSpan()
TimeSpan(ticks: int64) : unit
TimeSpan(hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int, milliseconds: int) : unit

TimeSpan.FromMinutes(value: float) : TimeSpan

Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>

TimeSpan.FromHours(value: float) : TimeSpan

TimeSpan.FromSeconds(value: float) : TimeSpan

type Command = | Inspect

Full name: Script.Command

union case Command.Inspect: Command

val nc : r:'a -> Capture<'a>

Full name: Script.nc

val r : 'a

val inspectCommand : _arg1:string list -> Command option

Full name: Script.inspectCommand

val inspector : command:'a -> t1:'b -> t2:'c -> 'a * 'b * 'c

Full name: Script.inspector

val command : 'a

val t1 : 'b

val t2 : 'c

val parseTime : (string -> ResultState<TimeSpan>)

Full name: Script.parseTime

val parseInspect : (string -> ResultState<Command>)

Full name: Script.parseInspect

Raw view Test code New version

More information

Link:	http://fssnip.net/7Pr
Posted:	7 years ago
Author:	cboudereau
Tags:	applicative functor , applicative functors , regex