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 _ = (< 256) . ord
instance Property IsLatin1 α ⇒ Property IsLatin1 [α] where
holds _ = all isLatin1
instance Property IsLatin1 TS.Text where
holds _ = TS.all isLatin1
instance Property IsLatin1 TL.Text where
holds _ = TL.all isLatin1
isLatin1 ∷ Property IsLatin1 v ⇒ v → Bool
isLatin1 = holds IsLatin1
type Latin1 α = Checked IsLatin1 α
instance Eq α ⇒ Eq (Latin1 α) where
(==) = (==) `on` checked
instance Ord α ⇒ Ord (Latin1 α) where
compare = compare `on` checked
instance Show α ⇒ Show (Latin1 α) where
showsPrec p = showsPrec p . checked
instance Semigroup α ⇒ Semigroup (Latin1 α) where
x <> y = trustMe $ checked x <> checked y
sconcat = trustMe . sconcat . fmap checked
stimes n = trustMe . stimes n . checked
instance Monoid α ⇒ Monoid (Latin1 α) where
mempty = trustMe mempty
mappend x y = trustMe $ mappend (checked x) (checked y)
mconcat = trustMe . mconcat . fmap checked
instance IsString α ⇒ IsString (Latin1 α) where
fromString s | isLatin1 s = trustMe $ fromString s
| otherwise = error $ "Not a Latin-1 string: " ++ show s
instance Hashable α ⇒ Hashable (Latin1 α) where
#if MIN_VERSION_hashable(1,2,0)
hashWithSalt s = hashWithSalt s . checked
#else
hash = hash . checked
#endif
instance FoldCase (Latin1 Char) where
foldCase = trustMap toLower
instance FoldCase (Latin1 α) ⇒ FoldCase (Latin1 [α]) where
foldCase = trustMap $ map $ checked . foldCase . trustThat IsLatin1
instance FoldCase (Latin1 TS.Text) where
foldCase = trustMap $ TS.map toLower
instance FoldCase (Latin1 TL.Text) where
foldCase = trustMap $ TL.map toLower
asciiIsLatin1 ∷ Ascii α → Latin1 α
asciiIsLatin1 = trustMe . checked
maybeLatin1 ∷ Char → Maybe Word8
maybeLatin1 c | isLatin1 c = Just $ latin1 c
| otherwise = Nothing
latin1 ∷ Char → Word8
latin1 = fromIntegral . ord
isControl ∷ Char → Bool
isControl c = w < 32 || (w >= 127 && w <= 159)
where w = ord c
isPrintable ∷ Char → Bool
isPrintable c = A.isPrintable c || (w >= 160 && w < 256)
where w = ord c
isWhiteSpace ∷ Char → Bool
isWhiteSpace c = A.isWhiteSpace c || w == 133 || w == 160
where w = ord c
isLower ∷ Char → Bool
isLower c = A.isLower c || (w >= 223 && w < 256 && w /= 247)
where w = ord c
isUpper ∷ Char → Bool
isUpper c = A.isUpper c || (w >= 192 && w <= 222 && w /= 215)
where w = ord c
toLower ∷ Char → Char
toLower c | isUpper c = chr (ord c + 32)
| otherwise = c
toUpper ∷ Char → Char
toUpper c | w ← ord c
, A.isLower c || (w >= 224 && w <= 254 && w /= 247)
= chr (ord c 32)
| otherwise
= c
isAlpha ∷ Char → Bool
isAlpha c = isUpper c || isLower c
isAlphaNum ∷ Char → Bool
isAlphaNum c = A.isDecDigit c || isAlpha c
isControl8 ∷ Word8 → Bool
isControl8 w = w < 32 || (w >= 127 && w <= 159)
isPrintable8 ∷ Word8 → Bool
isPrintable8 w = A.isPrintable8 w || w >= 160
isWhiteSpace8 ∷ Word8 → Bool
isWhiteSpace8 w = A.isWhiteSpace8 w || w == 133 || w == 160
isLower8 ∷ Word8 → Bool
isLower8 w = A.isLower8 w || (w >= 223 && w /= 247)
isUpper8 ∷ Word8 → Bool
isUpper8 w = A.isUpper8 w || (w >= 192 && w <= 222 && w /= 215)
toLower8 ∷ Word8 → Word8
toLower8 w | isUpper8 w = w + 32
| otherwise = w
toUpper8 ∷ Word8 → Word8
toUpper8 w | A.isLower8 w || (w >= 224 && w /= 247 && w /= 255) = w 32
| otherwise = w
isAlpha8 ∷ Word8 → Bool
isAlpha8 w = isUpper8 w || isLower8 w
isAlphaNum8 ∷ Word8 → Bool
isAlphaNum8 w = A.isDecDigit8 w || isAlpha8 w