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

(.module:
  [library
   [lux (#- or and not)
    [abstract
     [monad (#+ Monad do)]]
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]]
    [data
     ["/" text (#+ Char) ("#\." monoid)]
     ["." product]
     ["." maybe]
     [collection
      ["." list ("#\." fold)]]]
    [macro
     ["." code]
     ["." template]]
    [math
     [number
      ["n" nat ("#\." decimal)]]]]]
  ["." //])

(type: #export Offset
  {#.doc (doc "An offset into a block of text.")}
  Nat)

(def: start_offset
  Offset
  0)

(type: #export Parser
  {#.doc (doc "A parser for text.")}
  (//.Parser [Offset Text]))

(type: #export Slice
  {#.doc (doc "A slice of a block of text.")}
  {#basis Offset
   #distance Offset})

(def: (remaining' offset tape)
  (-> Offset Text Text)
  (|> tape (/.split offset) maybe.assume product.right))

(exception: #export (unconsumed_input {offset Offset} {tape Text})
  (exception.report
   ["Offset" (n\encode offset)]
   ["Input size" (n\encode (/.size tape))]
   ["Remaining input" (remaining' offset tape)]))

(exception: #export (expected_to_fail {offset Offset} {tape Text})
  (exception.report
   ["Offset" (n\encode offset)]
   ["Input" (remaining' offset tape)]))

(exception: #export cannot_parse)
(exception: #export cannot_slice)

(def: #export (run parser input)
  {#.doc (doc "Executes a parser against a block of text."
              "Verifies that the entire input has been processed.")}
  (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: #export offset
  {#.doc (doc "Yields the current offset into the input.")}
  (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\fold (function (_ [slice::basis slice::distance]
                                [total::basis total::distance])
                     [total::basis ("lux i64 +" slice::distance total::distance)])
                   {#basis offset
                    #distance 0}
                   slices))))

(def: #export any
  {#.doc "Yields the next character without applying any logic."}
  (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: #export any!
  {#.doc "Yields the next character (as a slice) without applying any logic."}
  (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> <caveat>]
  [(`` (def: #export (<name> parser)
         {#.doc (doc (~~ (template.text ["Produce a character" <caveat> " if the parser fails."])))}
         (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! " (as a slice)"]
  )

(exception: #export (cannot_match {reference Text})
  (exception.report
   ["Reference" (/.format reference)]))

(def: #export (this reference)
  {#.doc (doc "Checks that a specific text shows up in the input.")}
  (-> Text (Parser Any))
  (function (_ [offset tape])
    (case (/.index_of' 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: #export end!
  {#.doc "Ensure the parser's input is empty."}
  (Parser Any)
  (function (_ (^@ input [offset tape]))
    (if (n.= offset (/.size tape))
      (#try.Success [input []])
      (exception.except ..unconsumed_input input))))

(def: #export peek
  {#.doc "Yields the next character (without consuming it from the input)."}
  (Parser Text)
  (function (_ (^@ input [offset tape]))
    (case (/.char offset tape)
      (#.Some output)
      (#try.Success [input (/.of_char output)])

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

(def: #export remaining
  {#.doc "Get all of the remaining input (without consuming it)."}
  (Parser Text)
  (function (_ (^@ input [offset tape]))
    (#try.Success [input (remaining' offset tape)])))

(def: #export (range bottom top)
  {#.doc "Only yields characters within a range."}
  (-> Nat Nat (Parser Text))
  (do //.monad
    [char any
     .let [char' (maybe.assume (/.char 0 char))]
     _ (//.assertion ($_ /\compose "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: #export <name>
     {#.doc (code.text ($_ /\compose "Only yields " <desc> " characters."))}
     (Parser Text)
     (..range (char <bottom>) (char <top>)))]

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

(def: #export alpha
  {#.doc "Yields alphabetic characters."}
  (Parser Text)
  (//.either lower upper))

(def: #export alpha_num
  {#.doc "Yields alphanumeric characters."}
  (Parser Text)
  (//.either alpha decimal))

(def: #export hexadecimal
  {#.doc "Yields hexadecimal digits."}
  (Parser Text)
  ($_ //.either
      decimal
      (range (char "a") (char "f"))
      (range (char "A") (char "F"))))

(template [<name>]
  [(exception: #export (<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> <description_modifier>]
  [(def: #export (<name> options)
     {#.doc (code.text ($_ /\compose "Yields characters that are" <description_modifier> " part of a piece of text."))}
     (-> 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 " not"]
  )

(template [<name> <modifier> <exception> <description_modifier>]
  [(def: #export (<name> options)
     {#.doc (code.text ($_ /\compose "Yields characters (as a slice) that are" <description_modifier> " part of a piece of text."))}
     (-> 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 " not"]
  )

(exception: #export (character_does_not_satisfy_predicate {character Char})
  (exception.report
   ["Character" (/.format (/.of_char character))]))

(def: #export (satisfies parser)
  {#.doc "Yields characters that satisfy a predicate."}
  (-> (-> 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: #export space
  {#.doc "Yields white-space."}
  (Parser Text)
  (..satisfies /.space?))

(def: #export (and left right)
  {#.doc (doc "Yields the outputs of both parsers composed together.")}
  (-> (Parser Text) (Parser Text) (Parser Text))
  (do //.monad
    [=left left
     =right right]
    (in ($_ /\compose =left =right))))

(def: #export (and! left right)
  {#.doc (doc "Yields the outputs of both parsers composed together (as a slice).")}
  (-> (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: #export (<name> parser)
     {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " characters as a single continuous text (as a slice)."))}
     (-> (Parser Text) (Parser Text))
     (|> parser <base> (\ //.monad map /.concat)))]

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

(template [<name> <base> <doc_modifier>]
  [(def: #export (<name> parser)
     {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " characters as a single continuous text (as a slice)."))}
     (-> (Parser Slice) (Parser Slice))
     (with_slices (<base> parser)))]

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

(template [<name> <base> <doc_modifier>]
  [(def: #export (<name> amount parser)
     {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " N characters (as a slice)."))}
     (-> Nat (Parser Text) (Parser Text))
     (|> parser
         (<base> amount)
         (\ //.monad map /.concat)))]

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

(template [<name> <base> <doc_modifier>]
  [(def: #export (<name> amount parser)
     {#.doc (code.text ($_ /\compose "Yields " <doc_modifier> " N characters (as a slice)."))}
     (-> 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: #export (between minimum additional parser)
  (-> Nat Nat (Parser Text) (Parser Text))
  (|> parser
      (//.between minimum additional)
      (\ //.monad map /.concat)))

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

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

(def: #export (local local_input parser)
  {#.doc "Applies a parser against the given input."}
  (All [a] (-> Text (Parser a) (Parser a)))
  (function (_ real_input)
    (case (..run parser local_input)
      (#try.Failure error)
      (#try.Failure error)

      (#try.Success value)
      (#try.Success [real_input value]))))

(def: #export (slice parser)
  {#.doc (doc "Converts a slice to a block of text.")}
  (-> (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: #export (then structured text)
  {#.doc (doc "Embeds a text parser into an arbitrary parser that yields text.")}
  (All [s a]
    (-> (Parser a)
        (//.Parser s Text)
        (//.Parser s a)))
  (do //.monad
    [raw text]
    (//.lift (..run structured raw))))