{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Enum.Utf8
( EnumUtf8(..)
, Utf8Parsable(..)
, EnumUtf8Config(..)
, defaultEnumUtf8Config
) where
import Data.Array
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder as BB
import Data.Coerce
import Data.Hashable
import Data.Possibly
import qualified Data.HashMap.Strict as HM
import Data.String
import Text.Utf8
class Utf8Parsable a where
parseUtf8 :: Utf8 -> Possibly a
class ( Renderable e
, Bounded e
, Enum e
, Eq e
, Ord e
, Show e
, Utf8Parsable e
) => EnumUtf8 e where
configEnumUtf8 :: e -> EnumUtf8Config
configEnumUtf8 _ = defaultEnumUtf8Config
renderEnumUtf8 :: e -> Utf8
renderEnumUtf8 e = enumUtf8Array ! I e
parseEnumUtf8 :: Utf8 -> Possibly e
parseEnumUtf8 u = maybe (Left m) Right $ HM.lookup b hashmap_b
where
m = "parseEnumUtf8: enumeration not recognised: "++show b
b = utf8_to_bs u
toFieldEnumUtf8 :: e -> B.ByteString
toFieldEnumUtf8 e = enumByteStringArray ! I e
fromFieldEnumUtf8_ :: Monad m => B.ByteString -> m e
fromFieldEnumUtf8_ bs = maybe (fail msg) return $ HM.lookup bs hashmap_b
where
msg = "fromFieldEnumUtf8_: enumeration not recognised: "++show bs
hashWithSaltEnumUtf8 :: Int -> e -> Int
hashWithSaltEnumUtf8 n = hashWithSalt n . toFieldEnumUtf8
data EnumUtf8Config =
EnumUtf8Config
{ _etc_text_prep :: String -> String
, _etc_char_prep :: Char -> Char
}
defaultEnumUtf8Config :: EnumUtf8Config
defaultEnumUtf8Config =
EnumUtf8Config
{ _etc_text_prep = defaultTextPrep
, _etc_char_prep = defaultCharPrep
}
defaultTextPrep :: String -> String
defaultTextPrep s =
case dropWhile (/='_') s of
_:rst@(_:_) -> fromString rst
_ -> error $ "defaultTextPrep: bad data constructor: "++s
defaultCharPrep :: Char -> Char
defaultCharPrep c = case c of
'_' -> '-'
_ -> c
newtype I a = I { _I :: a }
deriving (Eq,Ord)
instance EnumUtf8 e => Ix (I e) where
range (l,h) = coerce [_I l.._I h]
index (l,_) x = fromEnum (_I x) - fromEnum (_I l)
inRange (l,h) x = _I l <= _I x && _I x <= _I h
enumUtf8Array :: forall e . EnumUtf8 e => Array (I e) Utf8
enumUtf8Array =
listArray (I minBound,I maxBound)
[ fromString $ map _etc_char_prep $ _etc_text_prep $ show e
| e <- [minBound..maxBound :: e]
]
where
EnumUtf8Config{..} = configEnumUtf8 (minBound :: e)
enumByteStringArray :: forall e . EnumUtf8 e => Array (I e) B.ByteString
enumByteStringArray =
listArray (I minBound,I maxBound)
[ utf8_to_bs $ renderEnumUtf8 e
| e <- [minBound..maxBound :: e]
]
hashmap_b :: EnumUtf8 e => HM.HashMap B.ByteString e
hashmap_b =
HM.fromList
[ (utf8_to_bs $ renderEnumUtf8 c,c)
| c <- [minBound..maxBound]
]
utf8_to_bs :: Utf8 -> B.ByteString
utf8_to_bs = BL.toStrict . BB.toLazyByteString . coerce