{-# 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 :: ByteString -> Text
fromBS = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
forall a b. OnError a b
ignore

instance FromBS [Char] where
  fromBS :: ByteString -> [Char]
fromBS = Text -> [Char]
T.unpack (Text -> [Char]) -> (ByteString -> Text) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a. FromBS a => ByteString -> a
fromBS

instance FromBS LT.Text where
  fromBS :: ByteString -> Text
fromBS = Text -> Text
LT.fromStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a. FromBS a => ByteString -> a
fromBS

instance FromBS LB.ByteString where
  fromBS :: ByteString -> ByteString
fromBS = ByteString -> ByteString
LB.fromStrict

instance FromBS ByteString where
  fromBS :: ByteString -> ByteString
fromBS = ByteString -> ByteString
forall a. a -> a
id

newtype ConfigKey = ConfigKey String
  deriving (Int -> ConfigKey -> ShowS
[ConfigKey] -> ShowS
ConfigKey -> [Char]
(Int -> ConfigKey -> ShowS)
-> (ConfigKey -> [Char])
-> ([ConfigKey] -> ShowS)
-> Show ConfigKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConfigKey] -> ShowS
$cshowList :: [ConfigKey] -> ShowS
show :: ConfigKey -> [Char]
$cshow :: ConfigKey -> [Char]
showsPrec :: Int -> ConfigKey -> ShowS
$cshowsPrec :: Int -> ConfigKey -> ShowS
Show)

instance Binary ConfigKey where
  get :: Get ConfigKey
get = do
    Word8
size <- Get Word8
getWord8
    ByteString
dat <- Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
size
    ConfigKey -> Get ConfigKey
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfigKey -> Get ConfigKey) -> ConfigKey -> Get ConfigKey
forall a b. (a -> b) -> a -> b
$ [Char] -> ConfigKey
ConfigKey ([Char] -> ConfigKey) -> [Char] -> ConfigKey
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
B.unpack ByteString
dat
  put :: ConfigKey -> Put
put (ConfigKey dat :: [Char]
dat) = do
    Word8 -> Put
putWord8 (Word8 -> Put) -> (Int -> Word8) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
dat
    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B.pack [Char]
dat

newtype LockName = LockName ByteString
  deriving ((forall x. LockName -> Rep LockName x)
-> (forall x. Rep LockName x -> LockName) -> Generic LockName
forall x. Rep LockName x -> LockName
forall x. LockName -> Rep LockName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LockName x -> LockName
$cfrom :: forall x. LockName -> Rep LockName x
Generic, LockName -> LockName -> Bool
(LockName -> LockName -> Bool)
-> (LockName -> LockName -> Bool) -> Eq LockName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LockName -> LockName -> Bool
$c/= :: LockName -> LockName -> Bool
== :: LockName -> LockName -> Bool
$c== :: LockName -> LockName -> Bool
Eq, Eq LockName
Eq LockName =>
(LockName -> LockName -> Ordering)
-> (LockName -> LockName -> Bool)
-> (LockName -> LockName -> Bool)
-> (LockName -> LockName -> Bool)
-> (LockName -> LockName -> Bool)
-> (LockName -> LockName -> LockName)
-> (LockName -> LockName -> LockName)
-> Ord LockName
LockName -> LockName -> Bool
LockName -> LockName -> Ordering
LockName -> LockName -> LockName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LockName -> LockName -> LockName
$cmin :: LockName -> LockName -> LockName
max :: LockName -> LockName -> LockName
$cmax :: LockName -> LockName -> LockName
>= :: LockName -> LockName -> Bool
$c>= :: LockName -> LockName -> Bool
> :: LockName -> LockName -> Bool
$c> :: LockName -> LockName -> Bool
<= :: LockName -> LockName -> Bool
$c<= :: LockName -> LockName -> Bool
< :: LockName -> LockName -> Bool
$c< :: LockName -> LockName -> Bool
compare :: LockName -> LockName -> Ordering
$ccompare :: LockName -> LockName -> Ordering
$cp1Ord :: Eq LockName
Ord, Int -> LockName -> ShowS
[LockName] -> ShowS
LockName -> [Char]
(Int -> LockName -> ShowS)
-> (LockName -> [Char]) -> ([LockName] -> ShowS) -> Show LockName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LockName] -> ShowS
$cshowList :: [LockName] -> ShowS
show :: LockName -> [Char]
$cshow :: LockName -> [Char]
showsPrec :: Int -> LockName -> ShowS
$cshowsPrec :: Int -> LockName -> ShowS
Show)

instance Hashable LockName

instance Binary LockName where
  get :: Get LockName
get = do
    Word8
size <- Get Word8
getWord8
    ByteString
dat <- Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
size
    LockName -> Get LockName
forall (m :: * -> *) a. Monad m => a -> m a
return (LockName -> Get LockName) -> LockName -> Get LockName
forall a b. (a -> b) -> a -> b
$ ByteString -> LockName
LockName ByteString
dat
  put :: LockName -> Put
put (LockName dat :: ByteString
dat) = do
    Word8 -> Put
putWord8 (Word8 -> Put) -> (Int -> Word8) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
dat
    ByteString -> Put
putByteString ByteString
dat

instance IsString LockName where
  fromString :: [Char] -> LockName
fromString = ByteString -> LockName
LockName (ByteString -> LockName)
-> ([Char] -> ByteString) -> [Char] -> LockName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString

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

instance (Validatable a) => Validatable [a] where
  validate :: [a] -> Either [Char] ()
validate [] = () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
  validate (x :: a
x:xs :: [a]
xs) = do
    a -> Either [Char] ()
forall a. Validatable a => a -> Either [Char] ()
validate a
x
    [a] -> Either [Char] ()
forall a. Validatable a => a -> Either [Char] ()
validate [a]
xs

instance Validatable ByteString where
  validate :: ByteString -> Either [Char] ()
validate bs :: ByteString
bs = [Char] -> Int32 -> Int32 -> Int -> Either [Char] ()
validateLength "Data" 0 Int32
forall a. Bounded a => a
maxBound (Int -> Either [Char] ()) -> Int -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs

validateLength :: String -> Int32 -> Int32 -> Int -> Either String ()
validateLength :: [Char] -> Int32 -> Int32 -> Int -> Either [Char] ()
validateLength n :: [Char]
n min' :: Int32
min' max' :: Int32
max' l' :: Int
l'
  | Int32
l Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
min' = [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is to short"
  | Int32
l Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
max' = [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is to long"
  | Bool
otherwise = () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
  where l :: Int32
l = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l'

validateNum :: (Ord a) => String -> a -> a -> a -> Either String ()
validateNum :: [Char] -> a -> a -> a -> Either [Char] ()
validateNum n :: [Char]
n min' :: a
min' max' :: a
max' l :: a
l
  | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
min' = [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is to small"
  | a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
max' = [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char]
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " is to big"
  | Bool
otherwise = () -> Either [Char] ()
forall a b. b -> Either a b
Right ()

instance Validatable LockName where
  validate :: LockName -> Either [Char] ()
validate (LockName bs :: ByteString
bs) = [Char] -> Int32 -> Int32 -> Int -> Either [Char] ()
validateLength "LockName" 1 255 (Int -> Either [Char] ()) -> Int -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs

instance Validatable ConfigKey where
  validate :: ConfigKey -> Either [Char] ()
validate (ConfigKey k :: [Char]
k) = [Char] -> Int32 -> Int32 -> Int -> Either [Char] ()
validateLength "ConfigKey" 1 255 (Int -> Either [Char] ()) -> Int -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
k

newtype Nid = Nid ByteString
  deriving ((forall x. Nid -> Rep Nid x)
-> (forall x. Rep Nid x -> Nid) -> Generic Nid
forall x. Rep Nid x -> Nid
forall x. Nid -> Rep Nid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nid x -> Nid
$cfrom :: forall x. Nid -> Rep Nid x
Generic, Nid -> Nid -> Bool
(Nid -> Nid -> Bool) -> (Nid -> Nid -> Bool) -> Eq Nid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nid -> Nid -> Bool
$c/= :: Nid -> Nid -> Bool
== :: Nid -> Nid -> Bool
$c== :: Nid -> Nid -> Bool
Eq, Eq Nid
Eq Nid =>
(Nid -> Nid -> Ordering)
-> (Nid -> Nid -> Bool)
-> (Nid -> Nid -> Bool)
-> (Nid -> Nid -> Bool)
-> (Nid -> Nid -> Bool)
-> (Nid -> Nid -> Nid)
-> (Nid -> Nid -> Nid)
-> Ord Nid
Nid -> Nid -> Bool
Nid -> Nid -> Ordering
Nid -> Nid -> Nid
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nid -> Nid -> Nid
$cmin :: Nid -> Nid -> Nid
max :: Nid -> Nid -> Nid
$cmax :: Nid -> Nid -> Nid
>= :: Nid -> Nid -> Bool
$c>= :: Nid -> Nid -> Bool
> :: Nid -> Nid -> Bool
$c> :: Nid -> Nid -> Bool
<= :: Nid -> Nid -> Bool
$c<= :: Nid -> Nid -> Bool
< :: Nid -> Nid -> Bool
$c< :: Nid -> Nid -> Bool
compare :: Nid -> Nid -> Ordering
$ccompare :: Nid -> Nid -> Ordering
$cp1Ord :: Eq Nid
Ord, Int -> Nid -> ShowS
[Nid] -> ShowS
Nid -> [Char]
(Int -> Nid -> ShowS)
-> (Nid -> [Char]) -> ([Nid] -> ShowS) -> Show Nid
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Nid] -> ShowS
$cshowList :: [Nid] -> ShowS
show :: Nid -> [Char]
$cshow :: Nid -> [Char]
showsPrec :: Int -> Nid -> ShowS
$cshowsPrec :: Int -> Nid -> ShowS
Show)

instance Hashable Nid

newtype Msgid = Msgid ByteString
  deriving ((forall x. Msgid -> Rep Msgid x)
-> (forall x. Rep Msgid x -> Msgid) -> Generic Msgid
forall x. Rep Msgid x -> Msgid
forall x. Msgid -> Rep Msgid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Msgid x -> Msgid
$cfrom :: forall x. Msgid -> Rep Msgid x
Generic, Msgid -> Msgid -> Bool
(Msgid -> Msgid -> Bool) -> (Msgid -> Msgid -> Bool) -> Eq Msgid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Msgid -> Msgid -> Bool
$c/= :: Msgid -> Msgid -> Bool
== :: Msgid -> Msgid -> Bool
$c== :: Msgid -> Msgid -> Bool
Eq, Eq Msgid
Eq Msgid =>
(Msgid -> Msgid -> Ordering)
-> (Msgid -> Msgid -> Bool)
-> (Msgid -> Msgid -> Bool)
-> (Msgid -> Msgid -> Bool)
-> (Msgid -> Msgid -> Bool)
-> (Msgid -> Msgid -> Msgid)
-> (Msgid -> Msgid -> Msgid)
-> Ord Msgid
Msgid -> Msgid -> Bool
Msgid -> Msgid -> Ordering
Msgid -> Msgid -> Msgid
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Msgid -> Msgid -> Msgid
$cmin :: Msgid -> Msgid -> Msgid
max :: Msgid -> Msgid -> Msgid
$cmax :: Msgid -> Msgid -> Msgid
>= :: Msgid -> Msgid -> Bool
$c>= :: Msgid -> Msgid -> Bool
> :: Msgid -> Msgid -> Bool
$c> :: Msgid -> Msgid -> Bool
<= :: Msgid -> Msgid -> Bool
$c<= :: Msgid -> Msgid -> Bool
< :: Msgid -> Msgid -> Bool
$c< :: Msgid -> Msgid -> Bool
compare :: Msgid -> Msgid -> Ordering
$ccompare :: Msgid -> Msgid -> Ordering
$cp1Ord :: Eq Msgid
Ord, Int -> Msgid -> ShowS
[Msgid] -> ShowS
Msgid -> [Char]
(Int -> Msgid -> ShowS)
-> (Msgid -> [Char]) -> ([Msgid] -> ShowS) -> Show Msgid
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Msgid] -> ShowS
$cshowList :: [Msgid] -> ShowS
show :: Msgid -> [Char]
$cshow :: Msgid -> [Char]
showsPrec :: Int -> Msgid -> ShowS
$cshowsPrec :: Int -> Msgid -> ShowS
Show)

instance Hashable Msgid


msgidLength :: Int
msgidLength :: Int
msgidLength = 4