Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
Strings can be encoded as 'Enc "r-ASCII"@ only if they contain only ASCII characters (first 128 characters of the Unicode character set).
This is sometimes referred to as ASCII-7 and future versions of type-encoding
may change "r-ASCII"
symbol annotation to reflect this.
B8.all ((< 128) . ord) . getPayload @ '["r-ASCII"] @() @B.ByteString
>>>
:set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds
>>>
encodeFAll . toEncoding () $ "Hello World" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)
Right (UnsafeMkEnc Proxy () "Hello World")
>>>
encodeFAll . toEncoding () $ "\194\160" :: Either EncodeEx (Enc '["r-ASCII"] () T.Text)
Left (EncodeEx "r-ASCII" (NonAsciiChar '\194'))
Since: 0.1.0.0
Synopsis
- newtype NonAsciiChar = NonAsciiChar Char
- encASCIIChar :: Encoding (Either EncodeEx) "r-ASCII" "r-ASCII" c Char
- encASCII :: Char8Find str => Encoding (Either EncodeEx) "r-ASCII" "r-ASCII" c str
- encImpl :: Char8Find str => str -> Either NonAsciiChar str
Documentation
>>>
:set -XDataKinds -XTypeApplications
>>>
import qualified Data.Text as T
>>>
import qualified Data.ByteString as B
>>>
import qualified Data.ByteString.Char8 as B8
>>>
import Test.QuickCheck
>>>
import Test.QuickCheck.Instances.ByteString()
>>>
import Data.TypedEncoding
>>>
:{
instance Arbitrary (Enc '["r-ASCII"] () B.ByteString) where arbitrary = fmap (unsafeSetPayload ()) . flip suchThat (B8.all isAscii) $ arbitrary :}
newtype NonAsciiChar Source #
Instances
Eq NonAsciiChar Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII (==) :: NonAsciiChar -> NonAsciiChar -> Bool # (/=) :: NonAsciiChar -> NonAsciiChar -> Bool # | |
Show NonAsciiChar Source # | |
Defined in Data.TypedEncoding.Instances.Restriction.ASCII showsPrec :: Int -> NonAsciiChar -> ShowS # show :: NonAsciiChar -> String # showList :: [NonAsciiChar] -> ShowS # |
Encoding
Decoding
Orphan instances
(Char8Find str, RecreateErr f, Applicative f) => Validate f "r-ASCII" "r-ASCII" () str Source # | |
validation :: Validation f "r-ASCII" "r-ASCII" () str Source # | |
Applicative f => Decode f "r-ASCII" "r-ASCII" c str Source # | |
Char8Find str => Encode (Either EncodeEx) "r-ASCII" "r-ASCII" c str Source # | |
Encode (Either EncodeEx) "r-ASCII" "r-ASCII" c Char Source # | |