(;module:
  lux
  (lux (control [eq #+ Eq])
       (data bool
             number
             [text #+ Eq<Text> "Text/" Monoid<Text>]
             ident
             (coll [list #* "" Functor<List> Fold<List>])
             )))

## [Types]
## (type: (Code' w)
##   (#;Bool Bool)
##   (#;Nat Nat)
##   (#;Int Int)
##   (#;Frac Frac)
##   (#;Text Text)
##   (#;Symbol Text Text)
##   (#;Tag Text Text)
##   (#;Form (List (w (Code' w))))
##   (#;Tuple (List (w (Code' w))))
##   (#;Record (List [(w (Code' w)) (w (Code' w))])))

## (type: Code
##   (Ann Cursor (Code' (Ann Cursor))))

## [Utils]
(def: _cursor Cursor ["" +0 +0])

## [Functions]
(do-template [<name> <type> <tag>]
  [(def: #export (<name> x)
     (-> <type> Code)
     [_cursor (<tag> x)])]
  
  [bool   Bool              #;Bool]
  [nat    Nat               #;Nat]
  [int    Int               #;Int]
  [deg    Deg               #;Deg]
  [frac   Frac              #;Frac]
  [text   Text              #;Text]
  [symbol Ident             #;Symbol]
  [tag    Ident             #;Tag]
  [form   (List Code)       #;Form]
  [tuple  (List Code)       #;Tuple]
  [record (List [Code Code]) #;Record]
  )

(do-template [<name> <tag> <doc>]
  [(def: #export (<name> name)
     {#;doc <doc>}
     (-> Text Code)
     [_cursor (<tag> ["" name])])]

  [local-symbol #;Symbol "Produces a local symbol (a symbol with no module prefix)."]
  [local-tag    #;Tag    "Produces a local tag (a tag with no module prefix)."])

## [Structures]
(struct: #export _ (Eq Code)
  (def: (= x y)
    (case [x y]
      (^template [<tag> <eq>]
        [[_ (<tag> x')] [_ (<tag> y')]]
        (:: <eq> = x' y'))
      ([#;Bool   Eq<Bool>]
       [#;Nat    Eq<Nat>]
       [#;Int    Eq<Int>]
       [#;Deg    Eq<Deg>]
       [#;Frac   Eq<Frac>]
       [#;Text   Eq<Text>]
       [#;Symbol Eq<Ident>]
       [#;Tag    Eq<Ident>])

      (^template [<tag>]
        [[_ (<tag> xs')] [_ (<tag> ys')]]
        (and (:: Eq<Nat> = (size xs') (size ys'))
             (fold (function [[x' y'] old]
                     (and old (= x' y')))
                   true
                   (zip2 xs' ys'))))
      ([#;Form]
       [#;Tuple])

      [[_ (#;Record xs')] [_ (#;Record ys')]]
      (and (:: Eq<Nat> = (size xs') (size ys'))
           (fold (function [[[xl' xr'] [yl' yr']] old]
                   (and old (= xl' yl') (= xr' yr')))
                 true
                 (zip2 xs' ys')))
      
      _
      false)))

## [Values]
(def: #export (to-text ast)
  (-> Code Text)
  (case ast
    (^template [<tag> <struct>]
      [_ (<tag> value)]
      (:: <struct> encode value))
    ([#;Bool   Codec<Text,Bool>]
     [#;Nat    Codec<Text,Nat>]
     [#;Int    Codec<Text,Int>]
     [#;Deg    Codec<Text,Deg>]
     [#;Frac   Codec<Text,Frac>]
     [#;Symbol Codec<Text,Ident>])

    [_ (#;Text value)]
    (text;encode value)

    [_ (#;Tag ident)]
    (Text/compose  "#" (:: Codec<Text,Ident> encode ident))

    (^template [<tag> <open> <close>]
      [_ (<tag> members)]
      ($_ Text/compose <open> (|> members (map to-text) (interpose " ") (text;join-with "")) <close>))
    ([#;Form  "(" ")"]
     [#;Tuple "[" "]"])

    [_ (#;Record pairs)]
    ($_ Text/compose "{" (|> pairs (map (function [[left right]] ($_ Text/compose (to-text left) " " (to-text right)))) (interpose " ") (text;join-with "")) "}")
    ))

(def: #export (replace original substitute ast)
  {#;doc "Replaces all code that looks like the 'original' with the 'substitute'."}
  (-> Code Code Code Code)
  (if (:: Eq<Code> = original ast)
    substitute
    (case ast
      (^template [<tag>]
        [cursor (<tag> parts)]
        [cursor (<tag> (map (replace original substitute) parts))])
      ([#;Form]
       [#;Tuple])

      [cursor (#;Record parts)]
      [cursor (#;Record (map (function [[left right]]
                               [(replace original substitute left)
                                (replace original substitute right)])
                             parts))]

      _
      ast)))