{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.Symbol (
Symbol,
symbolToString,
consSymbol,
unconsSymbol,
KnownSymbol,
symbolVal,
symbolVal',
AppendSymbol,
CmpSymbol,
someSymbolVal,
SomeSymbol (..),
sameSymbol,
) where
import Control.DeepSeq (NFData (..))
import Data.Binary (Binary (..))
import Data.String (IsString (..))
import GHC.Exts (IsList (..), Proxy#)
import GHC.TypeLits
(AppendSymbol, CmpSymbol, KnownSymbol, SomeSymbol, Symbol, sameSymbol)
import Language.Haskell.TH.Syntax (Lift (..))
import Text.Printf (PrintfArg (..))
import Unsafe.Coerce (unsafeCoerce)
import qualified GHC.TypeLits as GHC
symbolToString :: Symbol -> String
symbolToString :: Symbol -> String
symbolToString = Symbol -> String
forall a b. a -> b
unsafeCoerce @Symbol @String
symbolFromString :: String -> Symbol
symbolFromString :: String -> Symbol
symbolFromString = String -> Symbol
forall a b. a -> b
unsafeCoerce @String @Symbol
emptySymbol :: Symbol
emptySymbol :: Symbol
emptySymbol = String -> Symbol
symbolFromString String
""
consSymbol :: Char -> Symbol -> Symbol
consSymbol :: Char -> Symbol -> Symbol
consSymbol Char
c Symbol
s = String -> Symbol
symbolFromString (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: Symbol -> String
symbolToString Symbol
s)
unconsSymbol :: Symbol -> Maybe (Char, Symbol)
unconsSymbol :: Symbol -> Maybe (Char, Symbol)
unconsSymbol Symbol
s = case Symbol -> String
symbolToString Symbol
s of
[] -> Maybe (Char, Symbol)
forall a. Maybe a
Nothing
Char
c:String
s' -> (Char, Symbol) -> Maybe (Char, Symbol)
forall a. a -> Maybe a
Just (Char
c, String -> Symbol
symbolFromString String
s')
instance Show Symbol where
showsPrec :: Int -> Symbol -> String -> String
showsPrec Int
d Symbol
s = Int -> String -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
d (Symbol -> String
symbolToString Symbol
s)
instance Read Symbol where
readsPrec :: Int -> ReadS Symbol
readsPrec Int
d String
s = [ (String -> Symbol
symbolFromString String
x, String
s') | ~(String
x, String
s') <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
d String
s ]
instance Eq Symbol where
Symbol
x == :: Symbol -> Symbol -> Bool
== Symbol
y = Symbol -> String
symbolToString Symbol
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol -> String
symbolToString Symbol
y
instance Ord Symbol where
compare :: Symbol -> Symbol -> Ordering
compare Symbol
x Symbol
y = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Symbol -> String
symbolToString Symbol
x) (Symbol -> String
symbolToString Symbol
y)
instance IsString Symbol where
fromString :: String -> Symbol
fromString = String -> Symbol
symbolFromString
instance Semigroup Symbol where
Symbol
x <> :: Symbol -> Symbol -> Symbol
<> Symbol
y = String -> Symbol
symbolFromString (Symbol -> String
symbolToString Symbol
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Symbol -> String
symbolToString Symbol
y)
instance Monoid Symbol where
mempty :: Symbol
mempty = Symbol
emptySymbol
mappend :: Symbol -> Symbol -> Symbol
mappend = Symbol -> Symbol -> Symbol
forall a. Semigroup a => a -> a -> a
(<>)
instance NFData Symbol where
rnf :: Symbol -> ()
rnf Symbol
s = String -> ()
forall a. NFData a => a -> ()
rnf (Symbol -> String
symbolToString Symbol
s)
instance Binary Symbol where
get :: Get Symbol
get = (String -> Symbol) -> Get String -> Get Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Symbol
symbolFromString Get String
forall t. Binary t => Get t
get
put :: Symbol -> Put
put Symbol
s = String -> Put
forall t. Binary t => t -> Put
put (Symbol -> String
symbolToString Symbol
s)
instance Lift Symbol where
liftTyped :: Symbol -> Q (TExp Symbol)
liftTyped Symbol
s = [|| symbolFromString s' ||] where s' :: String
s' = Symbol -> String
symbolToString Symbol
s
instance PrintfArg Symbol where
formatArg :: Symbol -> FieldFormatter
formatArg Symbol
s = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Symbol -> String
symbolToString Symbol
s)
instance IsList Symbol where
type Item Symbol = Char
fromList :: [Item Symbol] -> Symbol
fromList = String -> Symbol
[Item Symbol] -> Symbol
symbolFromString
toList :: Symbol -> [Item Symbol]
toList = Symbol -> String
Symbol -> [Item Symbol]
symbolToString
symbolVal :: forall n proxy. KnownSymbol n => proxy n -> Symbol
symbolVal :: proxy n -> Symbol
symbolVal proxy n
p = String -> Symbol
symbolFromString (proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
GHC.symbolVal proxy n
p)
symbolVal' :: forall n. KnownSymbol n => Proxy# n -> Symbol
symbolVal' :: Proxy# n -> Symbol
symbolVal' Proxy# n
p = String -> Symbol
symbolFromString (Proxy# n -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
GHC.symbolVal' Proxy# n
p)
someSymbolVal :: Symbol -> SomeSymbol
someSymbolVal :: Symbol -> SomeSymbol
someSymbolVal Symbol
s = String -> SomeSymbol
GHC.someSymbolVal (Symbol -> String
symbolToString Symbol
s)