Internal.hs

{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}

module Periodic.Types.Internal
  ( FromBS (..)
  , ConfigKey (..)
  , LockName (..)
  , Validatable (..)
  , validateLength
  , validateNum
  , Nid (..)
  , Msgid (..)
  , msgidLength
  ) where

import           Data.Binary              (Binary (..))
import           Data.Binary.Get          (getByteString, getWord8)
import           Data.Binary.Put          (putByteString, putWord8)
import           Data.ByteString          (ByteString)
import qualified Data.ByteString.Char8    as B (length, pack, unpack)
import qualified Data.ByteString.Lazy     as LB (ByteString, fromStrict)
import           Data.Hashable
import           Data.Int                 (Int32)
import           Data.String              (IsString (..))
import           Data.Text                (Text)
import qualified Data.Text                as T (unpack)
import           Data.Text.Encoding       (decodeUtf8With)
import           Data.Text.Encoding.Error (ignore)
import qualified Data.Text.Lazy           as LT (Text, fromStrict)
import           GHC.Generics             (Generic)

class FromBS a where
  fromBS :: ByteString -> a

instance FromBS Text where
  fromBS = decodeUtf8With ignore

instance FromBS [Char] where
  fromBS = T.unpack . fromBS

instance FromBS LT.Text where
  fromBS = LT.fromStrict . fromBS

instance FromBS LB.ByteString where
  fromBS = LB.fromStrict

instance FromBS ByteString where
  fromBS = id

newtype ConfigKey = ConfigKey String
  deriving (Show)

instance Binary ConfigKey where
  get = do
    size <- getWord8
    dat <- getByteString $ fromIntegral size
    return $ ConfigKey $ B.unpack dat
  put (ConfigKey dat) = do
    putWord8 . fromIntegral $ length dat
    putByteString $ B.pack dat

newtype LockName = LockName ByteString
  deriving (Generic, Eq, Ord, Show)

instance Hashable LockName

instance Binary LockName where
  get = do
    size <- getWord8
    dat <- getByteString $ fromIntegral size
    return $ LockName dat
  put (LockName dat) = do
    putWord8 . fromIntegral $ B.length dat
    putByteString dat

instance IsString LockName where
  fromString = LockName . fromString

class Validatable a where
  validate :: a -> Either String ()

instance (Validatable a) => Validatable [a] where
  validate [] = Right ()
  validate (x:xs) = do
    validate x
    validate xs

instance Validatable ByteString where
  validate bs = validateLength "Data" 0 maxBound $ B.length bs

validateLength :: String -> Int32 -> Int32 -> Int -> Either String ()
validateLength n min' max' l'
  | l < min' = Left $ n ++ " is to short"
  | l > max' = Left $ n ++ " is to long"
  | otherwise = Right ()
  where l = fromIntegral l'

validateNum :: (Ord a) => String -> a -> a -> a -> Either String ()
validateNum n min' max' l
  | l < min' = Left $ n ++ " is to small"
  | l > max' = Left $ n ++ " is to big"
  | otherwise = Right ()

instance Validatable LockName where
  validate (LockName bs) = validateLength "LockName" 1 255 $ B.length bs

instance Validatable ConfigKey where
  validate (ConfigKey k) = validateLength "ConfigKey" 1 255 $ length k

newtype Nid = Nid ByteString
  deriving (Generic, Eq, Ord, Show)

instance Hashable Nid

newtype Msgid = Msgid ByteString
  deriving (Generic, Eq, Ord, Show)

instance Hashable Msgid


msgidLength :: Int
msgidLength = 4