(.module:
  [lux #- nat int deg]
  (lux (control [equality #+ 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)))