quox/lib/Quox/Name.idr

module Quox.Name

import public Data.SnocList
import Data.List
import Derive.Prelude

%hide TT.Name

%default total
%language ElabReflection


public export
data BaseName
= UN String -- user-given name
| Unused    -- "_"
%runElab derive "BaseName" [Eq, Ord]

export
baseStr : BaseName -> String
baseStr (UN x) = x
baseStr Unused = "_"

export Show BaseName where show = baseStr
export FromString BaseName where fromString = UN


public export
Mods : Type
Mods = SnocList String


public export
record Name where
  constructor MakeName
  mods : Mods
  base : BaseName
%runElab derive "Name" [Eq, Ord]

public export %inline
unq : BaseName -> Name
unq = MakeName [<]

||| add some namespaces to the beginning of a name
public export %inline
addMods : Mods -> Name -> Name
addMods ms = {mods $= (ms <+>)}


public export
PBaseName : Type
PBaseName = String

public export
record PName where
  constructor MakePName
  mods : Mods
  base : String
%runElab derive "PName" [Eq, Ord]

export %inline
fromPName : PName -> Name
fromPName p = MakeName p.mods $ UN p.base

export %inline
toPName : Name -> PName
toPName p = MakePName p.mods $ baseStr p.base

export
Show PName where
  show (MakePName mods base) = concat $ intersperse "." $ toList $ mods :< base

export Show Name where show = show . toPName

export FromString PName where fromString = MakePName [<]

export FromString Name where fromString = fromPName . fromString


export
toDotsP : PName -> String
toDotsP x = fastConcat $ cast $ map (<+> ".") x.mods :< x.base

export
toDots : Name -> String
toDots x = fastConcat $ cast $ map (<+> ".") x.mods :< baseStr x.base

export
fromListP : List1 String -> PName
fromListP (x ::: xs) = go [<] x xs where
  go : SnocList String -> String -> List String -> PName
  go mods x []        = MakePName mods x
  go mods x (y :: ys) = go (mods :< x) y ys

export %inline
fromList : List1 String -> Name
fromList = fromPName . fromListP