{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Restricted (
Restricted
, Restriction (..)
, rvalue
, Nneg1
, N1
, N0
, N254
, Inf
, Div4
, Div5
) where
import Data.Int
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
newtype Restricted r v = Restricted v deriving Int -> Restricted r v -> ShowS
[Restricted r v] -> ShowS
Restricted r v -> String
(Int -> Restricted r v -> ShowS)
-> (Restricted r v -> String)
-> ([Restricted r v] -> ShowS)
-> Show (Restricted r v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r v. Show v => Int -> Restricted r v -> ShowS
forall r v. Show v => [Restricted r v] -> ShowS
forall r v. Show v => Restricted r v -> String
showList :: [Restricted r v] -> ShowS
$cshowList :: forall r v. Show v => [Restricted r v] -> ShowS
show :: Restricted r v -> String
$cshow :: forall r v. Show v => Restricted r v -> String
showsPrec :: Int -> Restricted r v -> ShowS
$cshowsPrec :: forall r v. Show v => Int -> Restricted r v -> ShowS
Show
class Restriction r v where
toRestricted :: v -> Maybe (Restricted r v)
restrict :: v -> Restricted r v
rvalue :: Restricted r v -> v
rvalue :: Restricted r v -> v
rvalue (Restricted v :: v
v) = v
v
data Nneg1
data N0
data N1
data N254
data Inf
data Div4
data Div5
instance Show Nneg1 where show :: Nneg1 -> String
show _ = "Nneg1"
instance Show N0 where show :: N0 -> String
show _ = "N0"
instance Show N1 where show :: N1 -> String
show _ = "N1"
instance Show N254 where show :: N254 -> String
show _ = "N254"
instance Show Inf where show :: Inf -> String
show _ = "Inf"
instance Show Div4 where show :: Div4 -> String
show _ = "Div4"
instance Show Div5 where show :: Div5 -> String
show _ = "Div5"
instance (Integral a) => Restriction (N0, Inf) a where
toRestricted :: a -> Maybe (Restricted (N0, Inf) a)
toRestricted = a -> a -> Maybe (Restricted (N0, Inf) a)
forall i a b. Integral i => i -> i -> Maybe (Restricted (a, b) i)
toIntRLB 0
restrict :: a -> Restricted (N0, Inf) a
restrict = a -> a -> Restricted (N0, Inf) a
forall i a b. Integral i => i -> i -> Restricted (a, b) i
intRLB 0
instance (Integral a) => Restriction (N0, Int32) a where
toRestricted :: a -> Maybe (Restricted (N0, Int32) a)
toRestricted = a -> Int32 -> a -> Maybe (Restricted (N0, Int32) a)
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR 0 (Int32
forall a. Bounded a => a
maxBound :: Int32)
restrict :: a -> Restricted (N0, Int32) a
restrict = a -> Int32 -> a -> Restricted (N0, Int32) a
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR 0 (Int32
forall a. Bounded a => a
maxBound :: Int32)
instance (Integral a) => Restriction (N0, Int64) a where
toRestricted :: a -> Maybe (Restricted (N0, Int64) a)
toRestricted = a -> Int64 -> a -> Maybe (Restricted (N0, Int64) a)
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR 0 (Int64
forall a. Bounded a => a
maxBound :: Int64)
restrict :: a -> Restricted (N0, Int64) a
restrict = a -> Int64 -> a -> Restricted (N0, Int64) a
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR 0 (Int64
forall a. Bounded a => a
maxBound :: Int64)
instance (Integral a) => Restriction (N1, Inf) a where
toRestricted :: a -> Maybe (Restricted (N1, Inf) a)
toRestricted = a -> a -> Maybe (Restricted (N1, Inf) a)
forall i a b. Integral i => i -> i -> Maybe (Restricted (a, b) i)
toIntRLB 1
restrict :: a -> Restricted (N1, Inf) a
restrict = a -> a -> Restricted (N1, Inf) a
forall i a b. Integral i => i -> i -> Restricted (a, b) i
intRLB 1
instance (Integral a) => Restriction (N1, Int32) a where
toRestricted :: a -> Maybe (Restricted (N1, Int32) a)
toRestricted = a -> Int32 -> a -> Maybe (Restricted (N1, Int32) a)
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR 1 (Int32
forall a. Bounded a => a
maxBound :: Int32)
restrict :: a -> Restricted (N1, Int32) a
restrict = a -> Int32 -> a -> Restricted (N1, Int32) a
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR 1 (Int32
forall a. Bounded a => a
maxBound :: Int32)
instance (Integral a) => Restriction (N1, Int64) a where
toRestricted :: a -> Maybe (Restricted (N1, Int64) a)
toRestricted = a -> Int64 -> a -> Maybe (Restricted (N1, Int64) a)
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR 1 (Int64
forall a. Bounded a => a
maxBound :: Int64)
restrict :: a -> Restricted (N1, Int64) a
restrict = a -> Int64 -> a -> Restricted (N1, Int64) a
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR 1 (Int64
forall a. Bounded a => a
maxBound :: Int64)
instance (Integral a) => Restriction (Nneg1, Inf) a where
toRestricted :: a -> Maybe (Restricted (Nneg1, Inf) a)
toRestricted = a -> a -> Maybe (Restricted (Nneg1, Inf) a)
forall i a b. Integral i => i -> i -> Maybe (Restricted (a, b) i)
toIntRLB (-1)
restrict :: a -> Restricted (Nneg1, Inf) a
restrict = a -> a -> Restricted (Nneg1, Inf) a
forall i a b. Integral i => i -> i -> Restricted (a, b) i
intRLB (-1)
instance (Integral a) => Restriction (Nneg1, Int32) a where
toRestricted :: a -> Maybe (Restricted (Nneg1, Int32) a)
toRestricted = a -> Int32 -> a -> Maybe (Restricted (Nneg1, Int32) a)
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR (-1) (Int32
forall a. Bounded a => a
maxBound :: Int32)
restrict :: a -> Restricted (Nneg1, Int32) a
restrict = a -> Int32 -> a -> Restricted (Nneg1, Int32) a
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR (-1) (Int32
forall a. Bounded a => a
maxBound :: Int32)
instance (Integral a) => Restriction (Nneg1, Int64) a where
toRestricted :: a -> Maybe (Restricted (Nneg1, Int64) a)
toRestricted = a -> Int64 -> a -> Maybe (Restricted (Nneg1, Int64) a)
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR (-1) (Int64
forall a. Bounded a => a
maxBound :: Int64)
restrict :: a -> Restricted (Nneg1, Int64) a
restrict = a -> Int64 -> a -> Restricted (Nneg1, Int64) a
forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR (-1) (Int64
forall a. Bounded a => a
maxBound :: Int64)
instance Restriction (N1, N254) String where
toRestricted :: String -> Maybe (Restricted (N1, N254) String)
toRestricted s :: String
s | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (1, 254) (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) = Restricted (N1, N254) String
-> Maybe (Restricted (N1, N254) String)
forall a. a -> Maybe a
Just (Restricted (N1, N254) String
-> Maybe (Restricted (N1, N254) String))
-> Restricted (N1, N254) String
-> Maybe (Restricted (N1, N254) String)
forall a b. (a -> b) -> a -> b
$ String -> Restricted (N1, N254) String
forall r v. v -> Restricted r v
Restricted String
s
| Bool
otherwise = Maybe (Restricted (N1, N254) String)
forall a. Maybe a
Nothing
restrict :: String -> Restricted (N1, N254) String
restrict s :: String
s | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = String -> Restricted (N1, N254) String
forall r v. v -> Restricted r v
Restricted " "
| Bool
otherwise = String -> Restricted (N1, N254) String
forall r v. v -> Restricted r v
Restricted (Int -> ShowS
forall a. Int -> [a] -> [a]
take 254 String
s)
instance Restriction (N1, N254) ByteString where
toRestricted :: ByteString -> Maybe (Restricted (N1, N254) ByteString)
toRestricted s :: ByteString
s | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (1, 254) (ByteString -> Int
B.length ByteString
s) = Restricted (N1, N254) ByteString
-> Maybe (Restricted (N1, N254) ByteString)
forall a. a -> Maybe a
Just (Restricted (N1, N254) ByteString
-> Maybe (Restricted (N1, N254) ByteString))
-> Restricted (N1, N254) ByteString
-> Maybe (Restricted (N1, N254) ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Restricted (N1, N254) ByteString
forall r v. v -> Restricted r v
Restricted ByteString
s
| Bool
otherwise = Maybe (Restricted (N1, N254) ByteString)
forall a. Maybe a
Nothing
restrict :: ByteString -> Restricted (N1, N254) ByteString
restrict s :: ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = ByteString -> Restricted (N1, N254) ByteString
forall r v. v -> Restricted r v
Restricted (Word8 -> ByteString
B.singleton 0x20)
| Bool
otherwise = ByteString -> Restricted (N1, N254) ByteString
forall r v. v -> Restricted r v
Restricted (Int -> ByteString -> ByteString
B.take 254 ByteString
s)
instance Restriction (N0, N254) ByteString where
toRestricted :: ByteString -> Maybe (Restricted (N0, N254) ByteString)
toRestricted s :: ByteString
s | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (0, 254) (ByteString -> Int
B.length ByteString
s) = Restricted (N0, N254) ByteString
-> Maybe (Restricted (N0, N254) ByteString)
forall a. a -> Maybe a
Just (Restricted (N0, N254) ByteString
-> Maybe (Restricted (N0, N254) ByteString))
-> Restricted (N0, N254) ByteString
-> Maybe (Restricted (N0, N254) ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Restricted (N0, N254) ByteString
forall r v. v -> Restricted r v
Restricted ByteString
s
| Bool
otherwise = Maybe (Restricted (N0, N254) ByteString)
forall a. Maybe a
Nothing
restrict :: ByteString -> Restricted (N0, N254) ByteString
restrict s :: ByteString
s = ByteString -> Restricted (N0, N254) ByteString
forall r v. v -> Restricted r v
Restricted (Int -> ByteString -> ByteString
B.take 254 ByteString
s)
instance Restriction Div4 ByteString where
toRestricted :: ByteString -> Maybe (Restricted Div4 ByteString)
toRestricted s :: ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Restricted Div4 ByteString -> Maybe (Restricted Div4 ByteString)
forall a. a -> Maybe a
Just (Restricted Div4 ByteString -> Maybe (Restricted Div4 ByteString))
-> Restricted Div4 ByteString -> Maybe (Restricted Div4 ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Restricted Div4 ByteString
forall r v. v -> Restricted r v
Restricted ByteString
s
| Bool
otherwise = Maybe (Restricted Div4 ByteString)
forall a. Maybe a
Nothing
restrict :: ByteString -> Restricted Div4 ByteString
restrict = Int -> ByteString -> Restricted Div4 ByteString
forall r. Int -> ByteString -> Restricted r ByteString
fitByRem 4
instance Restriction Div5 ByteString where
toRestricted :: ByteString -> Maybe (Restricted Div5 ByteString)
toRestricted s :: ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 5 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Restricted Div5 ByteString -> Maybe (Restricted Div5 ByteString)
forall a. a -> Maybe a
Just (Restricted Div5 ByteString -> Maybe (Restricted Div5 ByteString))
-> Restricted Div5 ByteString -> Maybe (Restricted Div5 ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Restricted Div5 ByteString
forall r v. v -> Restricted r v
Restricted ByteString
s
| Bool
otherwise = Maybe (Restricted Div5 ByteString)
forall a. Maybe a
Nothing
restrict :: ByteString -> Restricted Div5 ByteString
restrict = Int -> ByteString -> Restricted Div5 ByteString
forall r. Int -> ByteString -> Restricted r ByteString
fitByRem 5
toIntR :: (Integral i, Integral j) => i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR :: i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR lb :: i
lb ub :: j
ub i :: i
i | (i, i) -> i -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (i
lb, j -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral j
ub) i
i = Restricted (a, b) i -> Maybe (Restricted (a, b) i)
forall a. a -> Maybe a
Just (Restricted (a, b) i -> Maybe (Restricted (a, b) i))
-> Restricted (a, b) i -> Maybe (Restricted (a, b) i)
forall a b. (a -> b) -> a -> b
$ i -> Restricted (a, b) i
forall r v. v -> Restricted r v
Restricted i
i
| Bool
otherwise = Maybe (Restricted (a, b) i)
forall a. Maybe a
Nothing
intR :: (Integral i, Integral j) => i -> j -> i -> Restricted (a, b) i
intR :: i -> j -> i -> Restricted (a, b) i
intR lb :: i
lb ub :: j
ub = i -> Restricted (a, b) i
forall r v. v -> Restricted r v
Restricted (i -> Restricted (a, b) i) -> (i -> i) -> i -> Restricted (a, b) i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> i
forall a. Integral a => a -> a -> a
lbfit i
lb (i -> i) -> (i -> i) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> i
forall a. Integral a => a -> a -> a
ubfit (j -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral j
ub)
toIntRLB :: Integral i => i -> i -> Maybe (Restricted (a, b) i)
toIntRLB :: i -> i -> Maybe (Restricted (a, b) i)
toIntRLB lb :: i
lb i :: i
i | i -> i -> Bool
forall a. Ord a => a -> a -> Bool
lbcheck i
lb i
i = Restricted (a, b) i -> Maybe (Restricted (a, b) i)
forall a. a -> Maybe a
Just (Restricted (a, b) i -> Maybe (Restricted (a, b) i))
-> Restricted (a, b) i -> Maybe (Restricted (a, b) i)
forall a b. (a -> b) -> a -> b
$ i -> Restricted (a, b) i
forall r v. v -> Restricted r v
Restricted i
i
| Bool
otherwise = Maybe (Restricted (a, b) i)
forall a. Maybe a
Nothing
intRLB :: Integral i => i -> i -> Restricted (a, b) i
intRLB :: i -> i -> Restricted (a, b) i
intRLB lb :: i
lb = i -> Restricted (a, b) i
forall r v. v -> Restricted r v
Restricted (i -> Restricted (a, b) i) -> (i -> i) -> i -> Restricted (a, b) i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i -> i
forall a. Integral a => a -> a -> a
lbfit i
lb
lbcheck :: Ord a => a -> a -> Bool
lbcheck :: a -> a -> Bool
lbcheck lb :: a
lb a :: a
a = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lb
ubcheck :: Ord a => a -> a -> Bool
ubcheck :: a -> a -> Bool
ubcheck ub :: a
ub a :: a
a = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
ub
check :: Ord a => (a, a) -> a -> Bool
check :: (a, a) -> a -> Bool
check (lb :: a
lb, ub :: a
ub) a :: a
a = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
lbcheck a
lb a
a Bool -> Bool -> Bool
&& a -> a -> Bool
forall a. Ord a => a -> a -> Bool
ubcheck a
ub a
a
lbfit :: Integral a => a -> a -> a
lbfit :: a -> a -> a
lbfit lb :: a
lb a :: a
a | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lb = a
a
| Bool
otherwise = a
lb
ubfit :: Integral a => a -> a -> a
ubfit :: a -> a -> a
ubfit ub :: a
ub a :: a
a | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
ub = a
a
| Bool
otherwise = a
ub
fitByRem :: Int -> ByteString -> Restricted r ByteString
fitByRem :: Int -> ByteString -> Restricted r ByteString
fitByRem r :: Int
r s :: ByteString
s =
let len :: Int
len = ByteString -> Int
B.length ByteString
s
x :: Int
x = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
r
in if Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then ByteString -> Restricted r ByteString
forall r v. v -> Restricted r v
Restricted ByteString
s
else ByteString -> Restricted r ByteString
forall r v. v -> Restricted r v
Restricted (Int -> ByteString -> ByteString
B.take (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) ByteString
s)