Utf8.hs

{-# 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


-- | a class for 'T.Text' parsers.
class Utf8Parsable a where
  parseUtf8 :: Utf8 -> Possibly a

{- | our toolkit for enumerated types which should be defined as follows:

@
import Text.Enum.Utf8
import Text.Utf8

data Foo = FOO_bar | FOO_bar_baz
  deriving (Bounded,Enum,Eq,Ord,Show)

instance EnumUtf8     Foo
instance Renderable   Foo where render    = renderEnumUtf8
instance Utf8Parsable Foo where parseUtf8 = parseEnumUtf8

main :: IO ()
main = mapM_ (cvtLn . render) [minBound..maxBound::Foo]
@

-}
class ( Renderable    e
      , Bounded       e
      , Enum          e
      , Eq            e
      , Ord           e
      , Show          e
      , Utf8Parsable  e
      ) => EnumUtf8 e where

  -- | Configures the textual representation of @e@ generated by renderEnumUtf8.
  configEnumUtf8 :: e -> EnumUtf8Config
  configEnumUtf8 _ = defaultEnumUtf8Config

  -- | Generate the standard textual representation according to
  -- 'configEnumUtf8' by default.
  renderEnumUtf8 :: e -> Utf8
  renderEnumUtf8 e = enumUtf8Array ! I e

  -- | Parses an @e@ according to the 'renderEnumUtf8' render.
  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

  -- | A cassava field encoder, using 'the renderEnumUtf8' format.
  toFieldEnumUtf8 :: e -> B.ByteString
  toFieldEnumUtf8 e = enumByteStringArray ! I e

  -- | A cassava field parser using the 'renderEnumUtf8' format.
  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

  -- | For hashing @e@ with the 'renderEnumUtf8' representation.
  hashWithSaltEnumUtf8 :: Int -> e -> Int
  hashWithSaltEnumUtf8 n = hashWithSalt n . toFieldEnumUtf8


-------------------------------------------------------------------------------
-- EnumUtf8Config, defaultEnumUtf8Config
-------------------------------------------------------------------------------

-- | configures the default implementation of 'renderEnumUtf8'
data EnumUtf8Config =
  EnumUtf8Config
    { _etc_text_prep :: String -> String  -- ^ applied to the output of 'show';
                                          -- by default strips each data
                                          -- constructor up to and including
                                          -- the first '_'
    , _etc_char_prep :: Char -> Char      -- ^ applied to each character of
                                          -- the outpout of '_etc_text_prep'
    }

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


-------------------------------------------------------------------------------
-- arrays
-------------------------------------------------------------------------------

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

-- | array of texts constructed with 'configEnumUtf8'
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)

-- | array of 'B.ByteString' generated from 'renderEnumUtf8'
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.ByteString' 'HM.HashMap' based on 'renderEnumUtf8' representation
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_to_bs :: Utf8 -> B.ByteString
utf8_to_bs = BL.toStrict . BB.toLazyByteString . coerce