OverloadedLabels for checked ByteString literals

SafeByteStringLiterals.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

import qualified Data.ByteString.Char8 as BS
import Data.Kind
import Data.Proxy
import GHC.OverloadedLabels
import GHC.TypeError
import GHC.TypeLits
import Data.Type.Ord

type Is8BitSymbol :: Symbol -> Constraint
type Is8BitSymbol s = Is8BitMaybe (UnconsSymbol s)

type Is8BitMaybe :: Maybe (Char, Symbol) -> Constraint
type family Is8BitMaybe _mb where
  Is8BitMaybe Nothing = ()
  Is8BitMaybe (Just '(c, s)) = (Is8BitChar c, Is8BitSymbol s)

type Is8BitChar :: Char -> Constraint
type Is8BitChar c = OrdCond (Compare (CharToNat c) 255)
                            (() :: Constraint)
                            (() :: Constraint)
                            (Unsatisfiable (Text "Invalid character in ByteString literal: " :<>: ShowType c))

instance (Is8BitSymbol lit, KnownSymbol lit) => IsLabel lit BS.ByteString where
  fromLabel = BS.pack (symbolVal (Proxy @lit))


good, bad :: BS.ByteString
good = #"ascii is fine"
bad = #"bla語"
{-
    • Invalid character in ByteString literal: '\35486'
    • In the expression: #"bla語"
      In an equation for ‘bad’: bad = #"bla語"
-}