module Sqel.Data.Sel where

import Exon (exon)

import Sqel.SOP.Constraint (symbolText, symbolString)

data SelPrefix =
  DefaultPrefix
  |
  NoPrefix
  |
  SelPrefix Symbol

type family IndexPrefixed (spec :: SelPrefix) (name :: Symbol) :: Symbol where
  IndexPrefixed 'DefaultPrefix name = AppendSymbol "sqel_sum_index__" name
  IndexPrefixed 'NoPrefix name = name
  IndexPrefixed ('SelPrefix spec) name = AppendSymbol spec name

type IndexName :: SelPrefix -> Symbol -> Symbol -> Constraint
class KnownSymbol name => IndexName prefix tpe name | prefix tpe -> name where

instance (
    name ~ IndexPrefixed prefixSpec tpe,
    KnownSymbol name
  ) => IndexName prefixSpec tpe name where

type family TypePrefixed (spec :: SelPrefix) (name :: Symbol) :: Symbol where
  TypePrefixed 'DefaultPrefix name = AppendSymbol "sqel_type__" name
  TypePrefixed 'NoPrefix name = name
  TypePrefixed ('SelPrefix spec) name = AppendSymbol spec name

type TypeName :: SelPrefix -> Symbol -> Symbol -> Constraint
class (
    KnownSymbol name,
    KnownSymbol tpe
  ) => TypeName prefix tpe name | prefix tpe -> name where

instance (
    name ~ TypePrefixed prefixSpec tpe,
    KnownSymbol name,
    KnownSymbol tpe
  ) => TypeName prefixSpec tpe name where

data Sel =
  SelSymbol Symbol
  |
  SelPath [Symbol]
  |
  SelAuto
  |
  SelUnused
  |
  SelIndex SelPrefix Symbol

type SelW :: Sel -> Type
data SelW sel where
  SelWSymbol :: KnownSymbol name => Proxy name -> SelW ('SelSymbol name)
  SelWPath :: SelW ('SelPath path)
  SelWAuto :: SelW 'SelAuto
  SelWUnused :: SelW 'SelUnused
  SelWIndex :: IndexName prefix tpe name => Proxy name -> SelW ('SelIndex prefix tpe)

type MkSel :: Sel -> Constraint
class MkSel sel where
  mkSel :: SelW sel

instance (
    KnownSymbol sel
  ) => MkSel ('SelSymbol sel) where
  mkSel :: SelW ('SelSymbol sel)
mkSel = forall (prefix :: Symbol).
KnownSymbol prefix =>
Proxy prefix -> SelW ('SelSymbol prefix)
SelWSymbol forall {k} (t :: k). Proxy t
Proxy

instance MkSel 'SelAuto where
  mkSel :: SelW 'SelAuto
mkSel = SelW 'SelAuto
SelWAuto

instance MkSel 'SelUnused where
  mkSel :: SelW 'SelUnused
mkSel = SelW 'SelUnused
SelWUnused

instance MkSel ('SelPath p) where
  mkSel :: SelW ('SelPath p)
mkSel = forall (p :: [Symbol]). SelW ('SelPath p)
SelWPath

-- TODO path: store witness
showSelW :: SelW s -> Text
showSelW :: forall (s :: Sel). SelW s -> Text
showSelW = \case
  SelW s
SelWAuto -> Text
"<auto>"
  SelW s
SelWPath -> Text
"<path>"
  SelW s
SelWUnused -> Text
"<unused>"
  SelWSymbol (Proxy name
Proxy :: Proxy sel) -> forall (name :: Symbol). KnownSymbol name => Text
symbolText @sel
  SelWIndex (Proxy name
Proxy :: Proxy sel) -> [exon|<index for #{symbolText @sel}>|]

type ReifySel :: Sel -> Symbol -> Constraint
class KnownSymbol name => ReifySel sel name | sel -> name where
  reifySel :: SelW sel -> Text

instance KnownSymbol name => ReifySel ('SelSymbol name) name where
  reifySel :: SelW ('SelSymbol name) -> Text
reifySel (SelWSymbol Proxy name
Proxy) = forall (name :: Symbol). KnownSymbol name => Text
symbolText @name

instance (
    IndexName prefixSpec sel name
  ) => ReifySel ('SelIndex prefixSpec sel) name where
  reifySel :: SelW ('SelIndex prefixSpec sel) -> Text
reifySel (SelWIndex Proxy name
Proxy) = forall (name :: Symbol). KnownSymbol name => Text
symbolText @name

data TSel =
  TSel SelPrefix Symbol

type TSelW :: TSel -> Type
data TSelW sel where
  TSelW :: TypeName prefix tpe name => Proxy '(tpe, name) -> TSelW ('TSel prefix tpe)

showTSelW :: TSelW s -> Text
showTSelW :: forall (s :: TSel). TSelW s -> Text
showTSelW (TSelW (Proxy '(tpe, name)
Proxy :: Proxy '(tpe, name))) =
  [exon|<type name for #{symbolText @name}>|]

instance Show (TSelW s) where
  showsPrec :: Int -> TSelW s -> ShowS
showsPrec Int
d (TSelW (Proxy '(tpe, name)
Proxy :: Proxy '(tpe, name))) =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) [exon|TSelW #{showString (symbolString @name)}|]

type ReifyTSel :: TSel -> Symbol -> Constraint
class KnownSymbol name => ReifyTSel sel name | sel -> name where
  reifyTSel :: TSelW sel -> Text

instance (
    TypeName prefixSpec sel name
  ) => ReifyTSel ('TSel prefixSpec sel) name where
  reifyTSel :: TSelW ('TSel prefixSpec sel) -> Text
reifyTSel (TSelW Proxy '(tpe, name)
Proxy) = forall (name :: Symbol). KnownSymbol name => Text
symbolText @name

type MkTSel :: TSel -> Constraint
class MkTSel sel where
  mkTSel :: TSelW sel

instance (
    TypeName prefix tpe name
  ) => MkTSel ('TSel prefix tpe) where
  mkTSel :: TSelW ('TSel prefix tpe)
mkTSel = forall (prefix :: SelPrefix) (tpe :: Symbol) (name :: Symbol).
TypeName prefix tpe name =>
Proxy '(tpe, name) -> TSelW ('TSel prefix tpe)
TSelW forall {k} (t :: k). Proxy t
Proxy