{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Text.Latin1
(
IsLatin1(..)
, isLatin1
, Latin1
, asciiIsLatin1
, maybeLatin1
, latin1
, isControl
, isPrintable
, isWhiteSpace
, isLower
, isUpper
, toLower
, toUpper
, isAlpha
, isAlphaNum
, isControl8
, isPrintable8
, isWhiteSpace8
, isLower8
, isUpper8
, toLower8
, toUpper8
, isAlpha8
, isAlphaNum8
) where
import Data.Checked
import Data.Function (on)
import Data.Char (ord, chr)
import Data.String (IsString(..))
import Data.Word (Word8)
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Text.Ascii (Ascii)
import qualified Text.Ascii as A
import Data.Semigroup (Semigroup(..))
import Data.Monoid (Monoid(..))
import Data.CaseInsensitive (FoldCase(..))
import Data.Hashable (Hashable(..))
data IsLatin1 = IsLatin1
instance Property IsLatin1 Char where
holds :: IsLatin1 -> Char -> Bool
holds IsLatin1
_ = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE holds #-}
instance Property IsLatin1 α ⇒ Property IsLatin1 [α] where
holds :: IsLatin1 -> [α] -> Bool
holds IsLatin1
_ = (α -> Bool) -> [α] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all α -> Bool
forall v. Property IsLatin1 v => v -> Bool
isLatin1
{-# INLINE holds #-}
instance Property IsLatin1 TS.Text where
holds :: IsLatin1 -> Text -> Bool
holds IsLatin1
_ = (Char -> Bool) -> Text -> Bool
TS.all Char -> Bool
forall v. Property IsLatin1 v => v -> Bool
isLatin1
{-# INLINE holds #-}
instance Property IsLatin1 TL.Text where
holds :: IsLatin1 -> Text -> Bool
holds IsLatin1
_ = (Char -> Bool) -> Text -> Bool
TL.all Char -> Bool
forall v. Property IsLatin1 v => v -> Bool
isLatin1
{-# INLINE holds #-}
isLatin1 ∷ Property IsLatin1 v ⇒ v → Bool
isLatin1 :: v -> Bool
isLatin1 = IsLatin1 -> v -> Bool
forall p v. Property p v => p -> v -> Bool
holds IsLatin1
IsLatin1
{-# INLINE isLatin1 #-}
type Latin1 α = Checked IsLatin1 α
instance Eq α ⇒ Eq (Latin1 α) where
== :: Latin1 α -> Latin1 α -> Bool
(==) = α -> α -> Bool
forall a. Eq a => a -> a -> Bool
(==) (α -> α -> Bool) -> (Latin1 α -> α) -> Latin1 α -> Latin1 α -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Latin1 α -> α
forall p v. Checked p v -> v
checked
{-# INLINE (==) #-}
instance Ord α ⇒ Ord (Latin1 α) where
compare :: Latin1 α -> Latin1 α -> Ordering
compare = α -> α -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (α -> α -> Ordering)
-> (Latin1 α -> α) -> Latin1 α -> Latin1 α -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Latin1 α -> α
forall p v. Checked p v -> v
checked
{-# INLINE compare #-}
instance Show α ⇒ Show (Latin1 α) where
showsPrec :: Int -> Latin1 α -> ShowS
showsPrec Int
p = Int -> α -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (α -> ShowS) -> (Latin1 α -> α) -> Latin1 α -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latin1 α -> α
forall p v. Checked p v -> v
checked
instance Semigroup α ⇒ Semigroup (Latin1 α) where
Latin1 α
x <> :: Latin1 α -> Latin1 α -> Latin1 α
<> Latin1 α
y = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α) -> α -> Latin1 α
forall a b. (a -> b) -> a -> b
$ Latin1 α -> α
forall p v. Checked p v -> v
checked Latin1 α
x α -> α -> α
forall a. Semigroup a => a -> a -> a
<> Latin1 α -> α
forall p v. Checked p v -> v
checked Latin1 α
y
{-# INLINE (<>) #-}
sconcat :: NonEmpty (Latin1 α) -> Latin1 α
sconcat = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α)
-> (NonEmpty (Latin1 α) -> α) -> NonEmpty (Latin1 α) -> Latin1 α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty α -> α
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty α -> α)
-> (NonEmpty (Latin1 α) -> NonEmpty α) -> NonEmpty (Latin1 α) -> α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Latin1 α -> α) -> NonEmpty (Latin1 α) -> NonEmpty α
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Latin1 α -> α
forall p v. Checked p v -> v
checked
{-# INLINE sconcat #-}
stimes :: b -> Latin1 α -> Latin1 α
stimes b
n = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α) -> (Latin1 α -> α) -> Latin1 α -> Latin1 α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> α -> α
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n (α -> α) -> (Latin1 α -> α) -> Latin1 α -> α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latin1 α -> α
forall p v. Checked p v -> v
checked
{-# INLINE stimes #-}
instance Monoid α ⇒ Monoid (Latin1 α) where
mempty :: Latin1 α
mempty = α -> Latin1 α
forall v p. v -> Checked p v
trustMe α
forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
mappend :: Latin1 α -> Latin1 α -> Latin1 α
mappend Latin1 α
x Latin1 α
y = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α) -> α -> Latin1 α
forall a b. (a -> b) -> a -> b
$ α -> α -> α
forall a. Monoid a => a -> a -> a
mappend (Latin1 α -> α
forall p v. Checked p v -> v
checked Latin1 α
x) (Latin1 α -> α
forall p v. Checked p v -> v
checked Latin1 α
y)
{-# INLINE mappend #-}
mconcat :: [Latin1 α] -> Latin1 α
mconcat = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α) -> ([Latin1 α] -> α) -> [Latin1 α] -> Latin1 α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [α] -> α
forall a. Monoid a => [a] -> a
mconcat ([α] -> α) -> ([Latin1 α] -> [α]) -> [Latin1 α] -> α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Latin1 α -> α) -> [Latin1 α] -> [α]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Latin1 α -> α
forall p v. Checked p v -> v
checked
{-# INLINE mconcat #-}
instance IsString α ⇒ IsString (Latin1 α) where
fromString :: String -> Latin1 α
fromString String
s | String -> Bool
forall v. Property IsLatin1 v => v -> Bool
isLatin1 String
s = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α) -> α -> Latin1 α
forall a b. (a -> b) -> a -> b
$ String -> α
forall a. IsString a => String -> a
fromString String
s
| Bool
otherwise = String -> Latin1 α
forall a. HasCallStack => String -> a
error (String -> Latin1 α) -> String -> Latin1 α
forall a b. (a -> b) -> a -> b
$ String
"Not a Latin-1 string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
{-# INLINE fromString #-}
instance Hashable α ⇒ Hashable (Latin1 α) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt :: Int -> Latin1 α -> Int
hashWithSalt Int
s = Int -> α -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (α -> Int) -> (Latin1 α -> α) -> Latin1 α -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latin1 α -> α
forall p v. Checked p v -> v
checked
{-# INLINE hashWithSalt #-}
#else
hash = hash . checked
{-# INLINE hash #-}
#endif
instance FoldCase (Latin1 Char) where
foldCase :: Latin1 Char -> Latin1 Char
foldCase = (Char -> Char) -> Latin1 Char -> Latin1 Char
forall v p. (v -> v) -> Checked p v -> Checked p v
trustMap Char -> Char
toLower
{-# INLINE foldCase #-}
instance FoldCase (Latin1 α) ⇒ FoldCase (Latin1 [α]) where
foldCase :: Latin1 [α] -> Latin1 [α]
foldCase = ([α] -> [α]) -> Latin1 [α] -> Latin1 [α]
forall v p. (v -> v) -> Checked p v -> Checked p v
trustMap (([α] -> [α]) -> Latin1 [α] -> Latin1 [α])
-> ([α] -> [α]) -> Latin1 [α] -> Latin1 [α]
forall a b. (a -> b) -> a -> b
$ (α -> α) -> [α] -> [α]
forall a b. (a -> b) -> [a] -> [b]
map ((α -> α) -> [α] -> [α]) -> (α -> α) -> [α] -> [α]
forall a b. (a -> b) -> a -> b
$ Latin1 α -> α
forall p v. Checked p v -> v
checked (Latin1 α -> α) -> (α -> Latin1 α) -> α -> α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Latin1 α -> Latin1 α
forall s. FoldCase s => s -> s
foldCase (Latin1 α -> Latin1 α) -> (α -> Latin1 α) -> α -> Latin1 α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLatin1 -> α -> Latin1 α
forall p v. p -> v -> Checked p v
trustThat IsLatin1
IsLatin1
{-# INLINE foldCase #-}
instance FoldCase (Latin1 TS.Text) where
foldCase :: Latin1 Text -> Latin1 Text
foldCase = (Text -> Text) -> Latin1 Text -> Latin1 Text
forall v p. (v -> v) -> Checked p v -> Checked p v
trustMap ((Text -> Text) -> Latin1 Text -> Latin1 Text)
-> (Text -> Text) -> Latin1 Text -> Latin1 Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
TS.map Char -> Char
toLower
{-# INLINE foldCase #-}
instance FoldCase (Latin1 TL.Text) where
foldCase :: Latin1 Text -> Latin1 Text
foldCase = (Text -> Text) -> Latin1 Text -> Latin1 Text
forall v p. (v -> v) -> Checked p v -> Checked p v
trustMap ((Text -> Text) -> Latin1 Text -> Latin1 Text)
-> (Text -> Text) -> Latin1 Text -> Latin1 Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
TL.map Char -> Char
toLower
{-# INLINE foldCase #-}
asciiIsLatin1 ∷ Ascii α → Latin1 α
asciiIsLatin1 :: Ascii α -> Latin1 α
asciiIsLatin1 = α -> Latin1 α
forall v p. v -> Checked p v
trustMe (α -> Latin1 α) -> (Ascii α -> α) -> Ascii α -> Latin1 α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ascii α -> α
forall p v. Checked p v -> v
checked
{-# INLINE asciiIsLatin1 #-}
maybeLatin1 ∷ Char → Maybe Word8
maybeLatin1 :: Char -> Maybe Word8
maybeLatin1 Char
c | Char -> Bool
forall v. Property IsLatin1 v => v -> Bool
isLatin1 Char
c = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Char -> Word8
latin1 Char
c
| Bool
otherwise = Maybe Word8
forall a. Maybe a
Nothing
{-# INLINABLE maybeLatin1 #-}
latin1 ∷ Char → Word8
latin1 :: Char -> Word8
latin1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE latin1 #-}
isControl ∷ Char → Bool
isControl :: Char -> Bool
isControl Char
c = Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 Bool -> Bool -> Bool
|| (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
127 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
159)
where w :: Int
w = Char -> Int
ord Char
c
{-# INLINE isControl #-}
isPrintable ∷ Char → Bool
isPrintable :: Char -> Bool
isPrintable Char
c = Char -> Bool
A.isPrintable Char
c Bool -> Bool -> Bool
|| (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
160 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256)
where w :: Int
w = Char -> Int
ord Char
c
{-# INLINE isPrintable #-}
isWhiteSpace ∷ Char → Bool
isWhiteSpace :: Char -> Bool
isWhiteSpace Char
c = Char -> Bool
A.isWhiteSpace Char
c Bool -> Bool -> Bool
|| Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
133 Bool -> Bool -> Bool
|| Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
160
where w :: Int
w = Char -> Int
ord Char
c
{-# INLINE isWhiteSpace #-}
isLower ∷ Char → Bool
isLower :: Char -> Bool
isLower Char
c = Char -> Bool
A.isLower Char
c Bool -> Bool -> Bool
|| (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
223 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
247)
where w :: Int
w = Char -> Int
ord Char
c
{-# INLINE isLower #-}
isUpper ∷ Char → Bool
isUpper :: Char -> Bool
isUpper Char
c = Char -> Bool
A.isUpper Char
c Bool -> Bool -> Bool
|| (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
192 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
222 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
215)
where w :: Int
w = Char -> Int
ord Char
c
{-# INLINE isUpper #-}
toLower ∷ Char → Char
toLower :: Char -> Char
toLower Char
c | Char -> Bool
isUpper Char
c = Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
| Bool
otherwise = Char
c
{-# INLINABLE toLower #-}
toUpper ∷ Char → Char
toUpper :: Char -> Char
toUpper Char
c | Int
w ← Char -> Int
ord Char
c
, Char -> Bool
A.isLower Char
c Bool -> Bool -> Bool
|| (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
224 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
254 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
247)
= Int -> Char
chr (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
| Bool
otherwise
= Char
c
{-# INLINABLE toUpper #-}
isAlpha ∷ Char → Bool
isAlpha :: Char -> Bool
isAlpha Char
c = Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
c
{-# INLINABLE isAlpha #-}
isAlphaNum ∷ Char → Bool
isAlphaNum :: Char -> Bool
isAlphaNum Char
c = Char -> Bool
A.isDecDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlpha Char
c
{-# INLINABLE isAlphaNum #-}
isControl8 ∷ Word8 → Bool
isControl8 :: Word8 -> Bool
isControl8 Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32 Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
127 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
159)
{-# INLINE isControl8 #-}
isPrintable8 ∷ Word8 → Bool
isPrintable8 :: Word8 -> Bool
isPrintable8 Word8
w = Word8 -> Bool
A.isPrintable8 Word8
w Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
160
{-# INLINE isPrintable8 #-}
isWhiteSpace8 ∷ Word8 → Bool
isWhiteSpace8 :: Word8 -> Bool
isWhiteSpace8 Word8
w = Word8 -> Bool
A.isWhiteSpace8 Word8
w Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
133 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
160
{-# INLINE isWhiteSpace8 #-}
isLower8 ∷ Word8 → Bool
isLower8 :: Word8 -> Bool
isLower8 Word8
w = Word8 -> Bool
A.isLower8 Word8
w Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
223 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
247)
{-# INLINE isLower8 #-}
isUpper8 ∷ Word8 → Bool
isUpper8 :: Word8 -> Bool
isUpper8 Word8
w = Word8 -> Bool
A.isUpper8 Word8
w Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
192 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
222 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
215)
{-# INLINE isUpper8 #-}
toLower8 ∷ Word8 → Word8
toLower8 :: Word8 -> Word8
toLower8 Word8
w | Word8 -> Bool
isUpper8 Word8
w = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32
| Bool
otherwise = Word8
w
{-# INLINABLE toLower8 #-}
toUpper8 ∷ Word8 → Word8
toUpper8 :: Word8 -> Word8
toUpper8 Word8
w | Word8 -> Bool
A.isLower8 Word8
w Bool -> Bool -> Bool
|| (Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
224 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
247 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
255) = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
32
| Bool
otherwise = Word8
w
{-# INLINABLE toUpper8 #-}
isAlpha8 ∷ Word8 → Bool
isAlpha8 :: Word8 -> Bool
isAlpha8 Word8
w = Word8 -> Bool
isUpper8 Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isLower8 Word8
w
{-# INLINABLE isAlpha8 #-}
isAlphaNum8 ∷ Word8 → Bool
isAlphaNum8 :: Word8 -> Bool
isAlphaNum8 Word8
w = Word8 -> Bool
A.isDecDigit8 Word8
w Bool -> Bool -> Bool
|| Word8 -> Bool
isAlpha8 Word8
w
{-# INLINABLE isAlphaNum8 #-}