aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/name.lux
blob: 3ad96cd84e45d8b235f66604af6fc7665ea5a367 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
(.module:
  [lux #*
   [abstract
    [monoid (#+)]
    [equivalence (#+ Equivalence)]
    [order (#+ Order)]
    [codec (#+ Codec)]
    hash]
   [data
    ["." text ("#@." monoid hash)]]])

## (type: Name
##   [Text Text])

(template [<name> <side>]
  [(def: #export (<name> [module short])
     (-> Name Text)
     <side>)]

  [module module]
  [short  short]
  )

(structure: #export equivalence (Equivalence Name)
  (def: (= [xmodule xname] [ymodule yname])
    (and (text@= xmodule ymodule)
         (text@= xname yname))))

(def: (name@< [moduleP shortP] [moduleS shortS])
  (-> Name Name Bit)
  (if (text@= moduleP moduleS)
    (:: text.order < shortP shortS)
    (:: text.order < moduleP moduleS)))

(structure: #export order (Order Name)
  (def: &equivalence ..equivalence)
  (def: < name@<)
  (def: (<= parameter subject)
    (or (:: ..equivalence = parameter subject)
        (name@< parameter subject)))
  (def: (> parameter subject)
    (name@< subject parameter))
  (def: (>= parameter subject)
    (or (:: ..equivalence = subject parameter)
        (name@< subject parameter))))

(structure: #export codec (Codec Text Name)
  (def: (encode [module short])
    (case module
      "" short
      _ ($_ text@compose module "." short)))
  
  (def: (decode input)
    (if (text@= "" input)
      (#.Left (text@compose "Invalid format for Name: " input))
      (case (text.split-all-with "." input)
        (^ (list short))
        (#.Right ["" short])

        (^ (list module short))
        (#.Right [module short])

        _
        (#.Left (text@compose "Invalid format for Name: " input))))))

(structure: #export hash (Hash Name)
  (def: &equivalence ..equivalence)
  
  (def: (hash [module name])
    (n/+ (text@hash module) (text@hash name))))