{-#LANGUAGE DataKinds #-}
{-#LANGUAGE DeriveDataTypeable #-}
{-#LANGUAGE DeriveGeneric #-}
{-#LANGUAGE GeneralizedNewtypeDeriving #-}
{-#LANGUAGE KindSignatures #-}
{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE StandaloneDeriving #-}
module Twilio.Types.SID where
import Control.DeepSeq (NFData)
import Control.Monad (MonadPlus, mzero)
import Data.Aeson
import Data.Binary (Binary)
import Data.Bits (countLeadingZeros)
import Data.Data (Data, Typeable)
import Data.Hashable (Hashable)
import Data.Ix (Ix)
import Data.Monoid ((<>))
import Data.String (IsString(fromString))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word64)
import GHC.Generics (Generic)
import GHC.Read (readPrec)
import Numeric (readHex, showHex)
import Text.ParserCombinators.ReadP (char, count, get, skipSpaces)
import Text.Read (ReadPrec, parens, readP_to_Prec, readPrec_to_S)
import Twilio.Types.Alpha
data SID (a :: Alpha) (b :: Alpha) = SID !Word64 !Word64
deriving (Bounded, Data, Eq, Generic, Ix, Ord, Typeable)
class IsSID sid where
getSID :: sid -> Text
parseSID :: Text -> Maybe sid
instance (IsAlpha a, IsAlpha b) => IsSID (SID a b) where
getSID = sidToText
parseSID = parseSIDFromText
instance Binary (SID a b)
instance Hashable (SID a b)
instance NFData (SID a b)
instance (IsAlpha a, IsAlpha b) => IsString (SID a b) where
fromString = read
instance (IsAlpha a, IsAlpha b) => Read (SID a b) where
readPrec = readSID
readSID :: forall a b. (IsAlpha a, IsAlpha b) => ReadPrec (SID a b)
readSID = parens . readP_to_Prec . const $ do
skipSpaces
char $ salphaToChar sa
char $ salphaToChar sb
chars1 <- count 16 get
chars2 <- count 16 get
case readHex chars1 of
[(word1, _)] -> do
case readHex chars2 of
[(word2, _)] -> pure $ SID word1 word2
_ -> mzero
_ -> mzero
where
sa :: SAlpha a
sa = promote :: SAlpha a
sb :: SAlpha b
sb = promote :: SAlpha b
instance (IsAlpha a, IsAlpha b) => Show (SID a b) where
show (SID word1 word2) = show (demote (promote :: SAlpha a))
<> show (demote (promote :: SAlpha b))
<> showHex64 word1
<> showHex64 word2
where
showHex64 :: Word64 -> String
showHex64 word64 = replicate padding '0' <> showHex word64 ""
where
padding = countLeadingZeros word64 `quot` 4
parseSIDFromText :: forall m a b. (MonadPlus m, IsAlpha a, IsAlpha b) => Text -> m (SID a b)
parseSIDFromText text = case readPrec_to_S readSID 0 $ T.unpack (T.take 34 text) of
[(sid, [])] -> pure sid
_ -> mzero
parseSIDFromJSON :: (MonadPlus m, IsAlpha a, IsAlpha b) => Value -> m (SID a b)
parseSIDFromJSON (String text) = parseSIDFromText text
parseSIDFromJSON _ = mzero
sidToJSON :: (IsAlpha a, IsAlpha b) => SID a b -> Value
sidToJSON = String . sidToText
sidToText :: (IsAlpha a, IsAlpha b) => SID a b -> Text
sidToText = T.pack . show
instance (IsAlpha a, IsAlpha b) => FromJSON (SID a b) where
parseJSON = parseSIDFromJSON
instance (IsAlpha a, IsAlpha b) => ToJSON (SID a b) where
toJSON = sidToJSON