(.module: {#.doc "Commons syntax readers."}
  [lux #*
   [abstract
    monad]
   [control
    ["p" parser ("#@." monad)
     ["s" code (#+ Parser)]]]
   [data
    ["." name ("#@." equivalence)]
    ["." product]
    ["." maybe]
    [collection
     ["." list]]]]
  ["." //
   ["#//" ///
    [syntax (#+ syntax:)]]])

(def: #export export
  (Parser Bit)
  (p.either (p.after (s.tag! (name-of #export)) (p@wrap #1))
            (p@wrap #0)))

(def: #export declaration
  {#.doc (doc "A reader for declaration syntax."
              "Such as:"
              quux
              (foo bar baz))}
  (Parser //.Declaration)
  (p.either (p.and s.local-identifier
                   (p@wrap (list)))
            (s.form (p.and s.local-identifier
                           (p.some s.local-identifier)))))

(def: #export annotations
  {#.doc "Reader for the common annotations syntax used by def: statements."}
  (Parser //.Annotations)
  (s.record (p.some (p.and s.tag s.any))))

(def: check^
  (Parser [(Maybe Code) Code])
  (p.either (s.form (do p.monad
                      [_ (s.text! "lux check")
                       type s.any
                       value s.any]
                      (wrap [(#.Some type) value])))
            (p.and (p@wrap #.None)
                   s.any)))

(def: _definition-anns-tag^
  (Parser Name)
  (s.tuple (p.and s.text s.text)))

(def: (_definition-anns^ _)
  (-> Any (Parser //.Annotations))
  (p.or (s.tag! (name-of #.Nil))
        (s.form (do p.monad
                  [_ (s.tag! (name-of #.Cons))
                   [head tail] (p.and (s.tuple (p.and _definition-anns-tag^ s.any))
                                      (_definition-anns^ []))]
                  (wrap [head tail])))
        ))

(def: (flat-list^ _)
  (-> Any (Parser (List Code)))
  (p.either (do p.monad
              [_ (s.tag! (name-of #.Nil))]
              (wrap (list)))
            (s.form (do p.monad
                      [_ (s.tag! (name-of #.Cons))
                       [head tail] (s.tuple (p.and s.any s.any))
                       tail (s.local (list tail) (flat-list^ []))]
                      (wrap (#.Cons head tail))))))

(template [<name> <type> <tag> <then>]
  [(def: <name>
     (Parser <type>)
     (<| s.tuple
         (p.after s.any)
         s.form
         (do p.monad
           [_ (s.tag! (name-of <tag>))]
           <then>)))]

  [tuple-meta^ (List Code) #.Tuple (flat-list^ [])]
  [text-meta^  Text        #.Text  s.text]
  )

(def: (find-definition-args meta-data)
  (-> (List [Name Code]) (List Text))
  (<| (maybe.default (list))
      (: (Maybe (List Text)))
      (case (list.find (|>> product.left (name@= ["lux" "func-args"])) meta-data)
        (^multi (#.Some [_ value])
                [(p.run tuple-meta^ (list value))
                 (#.Right [_ args])]
                [(p.run (p.some text-meta^) args)
                 (#.Right [_ args])])
        (#.Some args)

        _
        #.None)))

(def: #export (definition compiler)
  {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."}
  (-> Lux (Parser //.Definition))
  (do {@ p.monad}
    [definition-raw s.any
     me-definition-raw (|> definition-raw
                           ////.expand-all
                           (////.run compiler)
                           p.lift)]
    (s.local me-definition-raw
             (s.form (do @
                       [_ (s.text! "lux def")
                        definition-name s.local-identifier
                        [?definition-type definition-value] check^
                        definition-anns s.any
                        definition-anns (s.local (list definition-anns)
                                                 (_definition-anns^ []))
                        #let [definition-args (find-definition-args definition-anns)]]
                       (wrap {#//.definition-name definition-name
                              #//.definition-type ?definition-type
                              #//.definition-anns definition-anns
                              #//.definition-value definition-value
                              #//.definition-args definition-args}))))))

(def: #export (typed-definition compiler)
  {#.doc "A reader for definitions that ensures the input syntax is typed."}
  (-> Lux (Parser //.Definition))
  (do p.monad
    [_definition (definition compiler)
     _ (case (get@ #//.definition-type _definition)
         (#.Some _)
         (wrap [])

         #.None
         (p.fail "Typed definition must have a type!"))]
    (wrap _definition)))

(def: #export typed-input
  {#.doc "Reader for the common typed-argument syntax used by many macros."}
  (Parser //.Typed-Input)
  (s.record (p.and s.any s.any)))

(def: #export type-variables
  {#.doc "Reader for the common type var/param used by many macros."}
  (Parser (List Text))
  (s.tuple (p.some s.local-identifier)))