module Data.Restricted (
Restricted
, Restriction (..)
, rvalue
, Nneg1
, N1
, N0
, N254
, Inf
) where
import Data.Int
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
data Restricted l u v = Restricted !v deriving Show
class Restriction l u v where
toRestricted :: v -> Maybe (Restricted l u v)
restrict :: v -> Restricted l u v
rvalue :: Restricted l u v -> v
rvalue (Restricted v) = v
data Nneg1
data N0
data N1
data N254
data Inf
instance Show Nneg1 where show _ = "Nneg1"
instance Show N0 where show _ = "N0"
instance Show N1 where show _ = "N1"
instance Show N254 where show _ = "N254"
instance Show Inf where show _ = "Inf"
instance (Integral a) => Restriction N0 Inf a where
toRestricted = toIntRLB 0
restrict = intRLB 0
instance (Integral a) => Restriction N0 Int32 a where
toRestricted = toIntR 0 (maxBound :: Int32)
restrict = intR 0 (maxBound :: Int32)
instance (Integral a) => Restriction N0 Int64 a where
toRestricted = toIntR 0 (maxBound :: Int64)
restrict = intR 0 (maxBound :: Int64)
instance (Integral a) => Restriction N1 Inf a where
toRestricted = toIntRLB 1
restrict = intRLB 1
instance (Integral a) => Restriction N1 Int32 a where
toRestricted = toIntR 1 (maxBound :: Int32)
restrict = intR 1 (maxBound :: Int32)
instance (Integral a) => Restriction N1 Int64 a where
toRestricted = toIntR 1 (maxBound :: Int64)
restrict = intR 1 (maxBound :: Int64)
instance (Integral a) => Restriction Nneg1 Inf a where
toRestricted = toIntRLB (1)
restrict = intRLB (1)
instance (Integral a) => Restriction Nneg1 Int32 a where
toRestricted = toIntR (1) (maxBound :: Int32)
restrict = intR (1) (maxBound :: Int32)
instance (Integral a) => Restriction Nneg1 Int64 a where
toRestricted = toIntR (1) (maxBound :: Int64)
restrict = intR (1) (maxBound :: Int64)
instance Restriction N1 N254 String where
toRestricted s | check (1, 254) (length s) = Just $ Restricted s
| otherwise = Nothing
restrict s | length s < 1 = Restricted " "
| otherwise = Restricted (take 254 s)
instance Restriction N1 N254 ByteString where
toRestricted s | check (1, 254) (B.length s) = Just $ Restricted s
| otherwise = Nothing
restrict s | B.length s < 1 = Restricted (B.singleton 0x20)
| otherwise = Restricted (B.take 254 s)
toIntR :: (Integral i, Integral j) => i -> j -> i -> Maybe (Restricted a b i)
toIntR lb ub i | check (lb, fromIntegral ub) i = Just $ Restricted i
| otherwise = Nothing
intR :: (Integral i, Integral j) => i -> j -> i -> Restricted a b i
intR lb ub = Restricted . lbfit lb . ubfit (fromIntegral ub)
toIntRLB :: Integral i => i -> i -> Maybe (Restricted a b i)
toIntRLB lb i | lbcheck lb i = Just $ Restricted i
| otherwise = Nothing
intRLB :: Integral i => i -> i -> Restricted a b i
intRLB lb = Restricted . lbfit lb
lbcheck :: Ord a => a -> a -> Bool
lbcheck lb a = a >= lb
ubcheck :: Ord a => a -> a -> Bool
ubcheck ub a = a <= ub
check :: Ord a => (a, a) -> a -> Bool
check (lb, ub) a = lbcheck lb a && ubcheck ub a
lbfit :: Integral a => a -> a -> a
lbfit lb a | a >= lb = a
| otherwise = lb
ubfit :: Integral a => a -> a -> a
ubfit ub a | a <= ub = a
| otherwise = ub