{-# LANGUAGE UndecidableInstances #-} -- for RevCharsToSymbol'

module Singleraeh.Symbol where

import Singleraeh.List ( SList(..) )
import Singleraeh.Maybe ( SMaybe(..) )
import Singleraeh.Tuple ( STuple2(..) )
import GHC.TypeLits
import Unsafe.Coerce ( unsafeCoerce )

sConsSymbol :: SChar ch -> SSymbol str -> SSymbol (ConsSymbol ch str)
sConsSymbol :: forall (ch :: Char) (str :: Symbol).
SChar ch -> SSymbol str -> SSymbol (ConsSymbol ch str)
sConsSymbol SChar ch
ch SSymbol str
str =
    String
-> (forall (s :: Symbol). SSymbol s -> SSymbol (ConsSymbol ch str))
-> SSymbol (ConsSymbol ch str)
forall r. String -> (forall (s :: Symbol). SSymbol s -> r) -> r
withSomeSSymbol (SChar ch -> Char
forall (c :: Char). SChar c -> Char
fromSChar SChar ch
ch Char -> String -> String
forall a. a -> [a] -> [a]
: SSymbol str -> String
forall (s :: Symbol). SSymbol s -> String
fromSSymbol SSymbol str
str) SSymbol s -> SSymbol (ConsSymbol ch str)
forall a b. a -> b
forall (s :: Symbol). SSymbol s -> SSymbol (ConsSymbol ch str)
unsafeCoerce

-- TODO test!!!
sUnconsSymbol
    :: SSymbol str
    -> SMaybe (STuple2 SChar SSymbol) (UnconsSymbol str)
sUnconsSymbol :: forall (str :: Symbol).
SSymbol str -> SMaybe (STuple2 SChar SSymbol) (UnconsSymbol str)
sUnconsSymbol SSymbol str
sstr =
    case SSymbol str -> String
forall (s :: Symbol). SSymbol s -> String
fromSSymbol SSymbol str
sstr of
      []        -> SMaybe Any 'Nothing
-> SMaybe (STuple2 SChar SSymbol) (UnconsSymbol str)
forall a b. a -> b
unsafeCoerce SMaybe Any 'Nothing
forall {a} (sa :: a -> Type). SMaybe sa 'Nothing
SNothing
      Char
ch : String
str' -> SMaybe (STuple2 Any Any) ('Just '(Any, Any))
-> SMaybe (STuple2 SChar SSymbol) (UnconsSymbol str)
forall a b. a -> b
unsafeCoerce (SMaybe (STuple2 Any Any) ('Just '(Any, Any))
 -> SMaybe (STuple2 SChar SSymbol) (UnconsSymbol str))
-> SMaybe (STuple2 Any Any) ('Just '(Any, Any))
-> SMaybe (STuple2 SChar SSymbol) (UnconsSymbol str)
forall a b. (a -> b) -> a -> b
$ STuple2 Any Any '(Any, Any)
-> SMaybe (STuple2 Any Any) ('Just '(Any, Any))
forall {a} (sa :: a -> Type) (a1 :: a).
sa a1 -> SMaybe sa ('Just a1)
SJust (STuple2 Any Any '(Any, Any)
 -> SMaybe (STuple2 Any Any) ('Just '(Any, Any)))
-> STuple2 Any Any '(Any, Any)
-> SMaybe (STuple2 Any Any) ('Just '(Any, Any))
forall a b. (a -> b) -> a -> b
$ Any Any -> Any Any -> STuple2 Any Any '(Any, Any)
forall {a} {b} (sa :: a -> Type) (a1 :: a) (sb :: b -> Type)
       (b1 :: b).
sa a1 -> sb b1 -> STuple2 sa sb '(a1, b1)
STuple2
        (Char -> (forall (c :: Char). SChar c -> Any Any) -> Any Any
forall r. Char -> (forall (c :: Char). SChar c -> r) -> r
withSomeSChar Char
ch SChar c -> Any Any
forall (c :: Char). SChar c -> Any Any
forall a b. a -> b
unsafeCoerce)
        (String -> (forall (s :: Symbol). SSymbol s -> Any Any) -> Any Any
forall r. String -> (forall (s :: Symbol). SSymbol s -> r) -> r
withSomeSSymbol String
str' SSymbol s -> Any Any
forall a b. a -> b
forall (s :: Symbol). SSymbol s -> Any Any
unsafeCoerce)

-- | Re-construct the output from 'UnconsSymbol'.
type family ReconsSymbol msym where
    ReconsSymbol (Just '(ch, sym)) = ConsSymbol ch sym
    ReconsSymbol Nothing           = ""

sReconsSymbol
    :: SMaybe (STuple2 SChar SSymbol) msym
    -> SSymbol (ReconsSymbol msym)
sReconsSymbol :: forall (msym :: Maybe (Char, Symbol)).
SMaybe (STuple2 SChar SSymbol) msym -> SSymbol (ReconsSymbol msym)
sReconsSymbol = \case
  SJust (STuple2 SChar a1
ch SSymbol b1
sym) -> SChar a1 -> SSymbol b1 -> SSymbol (ConsSymbol a1 b1)
forall (ch :: Char) (str :: Symbol).
SChar ch -> SSymbol str -> SSymbol (ConsSymbol ch str)
sConsSymbol SChar a1
ch SSymbol b1
sym
  SMaybe (STuple2 SChar SSymbol) msym
SNothing               -> forall (s :: Symbol). KnownSymbol s => SSymbol s
SSymbol @""

-- TODO we can write this with @Foldl (FlipSym1 ConsSymbolSym) "" chs@, but
-- we need more singletons then. check it out later :)
type RevCharsToSymbol chs = RevCharsToSymbol' "" chs
type family RevCharsToSymbol' sym chs where
    RevCharsToSymbol' sym (ch : chs) = RevCharsToSymbol' (ConsSymbol ch sym) chs
    RevCharsToSymbol' sym '[]        = sym

revCharsToSymbol :: SList SChar chs -> SSymbol (RevCharsToSymbol chs)
revCharsToSymbol :: forall (chs :: String).
SList SChar chs -> SSymbol (RevCharsToSymbol chs)
revCharsToSymbol = SSymbol "" -> SList SChar chs -> SSymbol (RevCharsToSymbol' "" chs)
forall (str :: Symbol) (chs :: String).
SSymbol str
-> SList SChar chs -> SSymbol (RevCharsToSymbol' str chs)
revCharsToSymbol' (forall (s :: Symbol). KnownSymbol s => SSymbol s
SSymbol @"")

revCharsToSymbol'
    :: SSymbol str
    -> SList SChar chs -> SSymbol (RevCharsToSymbol' str chs)
revCharsToSymbol' :: forall (str :: Symbol) (chs :: String).
SSymbol str
-> SList SChar chs -> SSymbol (RevCharsToSymbol' str chs)
revCharsToSymbol' SSymbol str
sacc = \case
  SCons SChar a1
sch SList SChar as1
sstr -> SSymbol (ConsSymbol a1 str)
-> SList SChar as1
-> SSymbol (RevCharsToSymbol' (ConsSymbol a1 str) as1)
forall (str :: Symbol) (chs :: String).
SSymbol str
-> SList SChar chs -> SSymbol (RevCharsToSymbol' str chs)
revCharsToSymbol' (SChar a1 -> SSymbol str -> SSymbol (ConsSymbol a1 str)
forall (ch :: Char) (str :: Symbol).
SChar ch -> SSymbol str -> SSymbol (ConsSymbol ch str)
sConsSymbol SChar a1
sch SSymbol str
sacc) SList SChar as1
sstr
  SList SChar chs
SNil           -> SSymbol str
SSymbol (RevCharsToSymbol' str chs)
sacc