path: root/stdlib/source/library/lux/control/parser/text.lux

(.using
  [library
   [lux {"-" and not local}
    [abstract
     [monad {"+" Monad do}]]
    [control
     ["[0]" maybe]
     ["[0]" try {"+" Try}]
     ["[0]" exception {"+" exception:}]]
    [data
     ["/" text {"+" Char} ("[1]#[0]" monoid)]
     ["[0]" product]
     [collection
      ["[0]" list ("[1]#[0]" mix)]]]
    [macro
     ["[0]" code]
     ["[0]" template]]
    [math
     [number
      ["n" nat ("[1]#[0]" decimal)]]]]]
  ["[0]" //])

(type: .public Offset
  Nat)

(def: start_offset
  Offset
  0)

(type: .public Parser
  (//.Parser [Offset Text]))

(type: .public Slice
  (Record
   [#basis Offset
    #distance Offset]))

(def: (left_over offset tape)
  (-> Offset Text Text)
  (|> tape (/.clip_since offset) maybe.trusted))

(exception: .public (unconsumed_input [offset Offset
                                       tape Text])
  (exception.report
   ["Offset" (n#encoded offset)]
   ["Input size" (n#encoded (/.size tape))]
   ["Remaining input" (..left_over offset tape)]))

(exception: .public (expected_to_fail [offset Offset
                                       tape Text])
  (exception.report
   ["Offset" (n#encoded offset)]
   ["Input" (..left_over offset tape)]))

(exception: .public cannot_parse)
(exception: .public cannot_slice)

(def: .public (result parser input)
  (All (_ a) (-> (Parser a) Text (Try a)))
  (case (parser [start_offset input])
    {try.#Failure msg}
    {try.#Failure msg}
    
    {try.#Success [[end_offset _] output]}
    (if (n.= end_offset (/.size input))
      {try.#Success output}
      (exception.except ..unconsumed_input [end_offset input]))))

(def: .public offset
  (Parser Offset)
  (function (_ (^@ input [offset tape]))
    {try.#Success [input offset]}))

(def: (with_slices parser)
  (-> (Parser (List Slice)) (Parser Slice))
  (do //.monad
    [offset ..offset
     slices parser]
    (in (list#mix (function (_ [slice::basis slice::distance]
                               [total::basis total::distance])
                    [total::basis ("lux i64 +" slice::distance total::distance)])
                  [#basis offset
                   #distance 0]
                  slices))))

(def: .public any
  (Parser Text)
  (function (_ [offset tape])
    (case (/.char offset tape)
      {.#Some output}
      {try.#Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]}

      _
      (exception.except ..cannot_parse []))))

(def: .public any!
  (Parser Slice)
  (function (_ [offset tape])
    (case (/.char offset tape)
      {.#Some _}
      {try.#Success [[("lux i64 +" 1 offset) tape]
                     [#basis offset
                      #distance 1]]}

      _
      (exception.except ..cannot_slice []))))

(template [<name> <type> <any>]
  [(`` (def: .public (<name> parser)
         (All (_ a) (-> (Parser a) (Parser <type>)))
         (function (_ input)
           (case (parser input)
             {try.#Failure msg}
             (<any> input)
             
             _
             (exception.except ..expected_to_fail input)))))]

  [not  Text  ..any]
  [not! Slice ..any!]
  )

(exception: .public (cannot_match [reference Text])
  (exception.report
   ["Reference" (/.format reference)]))

(def: .public (this reference)
  (-> Text (Parser Any))
  (function (_ [offset tape])
    (case (/.index_since offset reference tape)
      {.#Some where}
      (if (n.= offset where)
        {try.#Success [[("lux i64 +" (/.size reference) offset) tape]
                       []]}
        (exception.except ..cannot_match [reference]))

      _
      (exception.except ..cannot_match [reference]))))

(def: .public end!
  (Parser Any)
  (function (_ (^@ input [offset tape]))
    (if (n.= offset (/.size tape))
      {try.#Success [input []]}
      (exception.except ..unconsumed_input input))))

(def: .public next
  (Parser Text)
  (function (_ (^@ input [offset tape]))
    (case (/.char offset tape)
      {.#Some output}
      {try.#Success [input (/.of_char output)]}

      _
      (exception.except ..cannot_parse []))))

(def: .public remaining
  (Parser Text)
  (function (_ (^@ input [offset tape]))
    {try.#Success [input (..left_over offset tape)]}))

(def: .public (range bottom top)
  (-> Nat Nat (Parser Text))
  (do //.monad
    [char any
     .let [char' (maybe.trusted (/.char 0 char))]
     _ (//.assertion ($_ /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top))
                     (.and (n.>= bottom char')
                           (n.<= top char')))]
    (in char)))

(template [<name> <bottom> <top> <desc>]
  [(def: .public <name>
     (Parser Text)
     (..range (char <bottom>) (char <top>)))]

  [upper   "A" "Z" "uppercase"]
  [lower   "a" "z" "lowercase"]
  [decimal "0" "9" "decimal"]
  [octal   "0" "7" "octal"]
  )

(def: .public alpha
  (Parser Text)
  (//.either lower upper))

(def: .public alpha_num
  (Parser Text)
  (//.either alpha decimal))

(def: .public hexadecimal
  (Parser Text)
  ($_ //.either
      decimal
      (range (char "a") (char "f"))
      (range (char "A") (char "F"))))

(template [<name>]
  [(exception: .public (<name> [options Text
                                character Char])
     (exception.report
      ["Options" (/.format options)]
      ["Character" (/.format (/.of_char character))]))]

  [character_should_be]
  [character_should_not_be]
  )

(template [<name> <modifier> <exception>]
  [(def: .public (<name> options)
     (-> Text (Parser Text))
     (function (_ [offset tape])
       (case (/.char offset tape)
         {.#Some output}
         (let [output' (/.of_char output)]
           (if (<modifier> (/.contains? output' options))
             {try.#Success [[("lux i64 +" 1 offset) tape] output']}
             (exception.except <exception> [options output])))

         _
         (exception.except ..cannot_parse []))))]

  [one_of  |>   ..character_should_be]
  [none_of .not ..character_should_not_be]
  )

(template [<name> <modifier> <exception>]
  [(def: .public (<name> options)
     (-> Text (Parser Slice))
     (function (_ [offset tape])
       (case (/.char offset tape)
         {.#Some output}
         (let [output' (/.of_char output)]
           (if (<modifier> (/.contains? output' options))
             {try.#Success [[("lux i64 +" 1 offset) tape]
                            [#basis offset
                             #distance 1]]}
             (exception.except <exception> [options output])))

         _
         (exception.except ..cannot_slice []))))]

  [one_of!  |>   ..character_should_be]
  [none_of! .not ..character_should_not_be]
  )

(exception: .public (character_does_not_satisfy_predicate [character Char])
  (exception.report
   ["Character" (/.format (/.of_char character))]))

(def: .public (satisfies parser)
  (-> (-> Char Bit) (Parser Text))
  (function (_ [offset tape])
    (case (/.char offset tape)
      {.#Some output}
      (if (parser output)
        {try.#Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]}
        (exception.except ..character_does_not_satisfy_predicate [output]))

      _
      (exception.except ..cannot_parse []))))

(def: .public space
  (Parser Text)
  (..satisfies /.space?))

(def: .public (and left right)
  (-> (Parser Text) (Parser Text) (Parser Text))
  (do //.monad
    [=left left
     =right right]
    (in ($_ /#composite =left =right))))

(def: .public (and! left right)
  (-> (Parser Slice) (Parser Slice) (Parser Slice))
  (do //.monad
    [[left::basis left::distance] left
     [right::basis right::distance] right]
    (in [left::basis ("lux i64 +" left::distance right::distance)])))

(template [<name> <base> <doc_modifier>]
  [(def: .public (<name> parser)
     (-> (Parser Text) (Parser Text))
     (|> parser <base> (# //.monad each /.together)))]

  [some //.some "some"]
  [many //.many "many"]
  )

(template [<name> <base> <doc_modifier>]
  [(def: .public (<name> parser)
     (-> (Parser Slice) (Parser Slice))
     (with_slices (<base> parser)))]

  [some! //.some "some"]
  [many! //.many "many"]
  )

(template [<name> <base> <doc_modifier>]
  [(def: .public (<name> amount parser)
     (-> Nat (Parser Text) (Parser Text))
     (|> parser
         (<base> amount)
         (# //.monad each /.together)))]

  [exactly  //.exactly  "exactly"]
  [at_most  //.at_most  "at most"]
  [at_least //.at_least "at least"]
  )

(template [<name> <base> <doc_modifier>]
  [(def: .public (<name> amount parser)
     (-> Nat (Parser Slice) (Parser Slice))
     (with_slices
       (<base> amount parser)))]

  [exactly!  //.exactly  "exactly"]
  [at_most!  //.at_most  "at most"]
  [at_least! //.at_least "at least"]
  )

(def: .public (between minimum additional parser)
  (-> Nat Nat (Parser Text) (Parser Text))
  (|> parser
      (//.between minimum additional)
      (# //.monad each /.together)))

(def: .public (between! minimum additional parser)
  (-> Nat Nat (Parser Slice) (Parser Slice))
  (with_slices
    (//.between minimum additional parser)))

(def: .public (enclosed [start end] parser)
  (All (_ a) (-> [Text Text] (Parser a) (Parser a)))
  (|> parser
      (//.before (this end))
      (//.after (this start))))

(def: .public (local local_input parser)
  (All (_ a) (-> Text (Parser a) (Parser a)))
  (function (_ real_input)
    (case (..result parser local_input)
      {try.#Failure error}
      {try.#Failure error}

      {try.#Success value}
      {try.#Success [real_input value]})))

(def: .public (slice parser)
  (-> (Parser Slice) (Parser Text))
  (do //.monad
    [[basis distance] parser]
    (function (_ (^@ input [offset tape]))
      (case (/.clip basis distance tape)
        {.#Some output}
        {try.#Success [input output]}

        {.#None}
        (exception.except ..cannot_slice [])))))

(def: .public (then structured text)
  (All (_ s a)
    (-> (Parser a)
        (//.Parser s Text)
        (//.Parser s a)))
  (do //.monad
    [raw text]
    (//.lifted (..result structured raw))))