{-# LANGUAGE EmptyDataDecls         #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE TypeSynonymInstances   #-}
{-# LANGUAGE OverloadedStrings      #-}

-- |
-- Module      : Data.Restricted
-- Copyright   : (c) 2011-2013 Toralf Wittner
-- License     : MIT
-- Maintainer  : Toralf Wittner <tw@dtex.org>
-- Stability   : experimental
-- Portability : non-portable
--
-- Type-level restricted data.
-- This module allows for type declarations which embed certain restrictions,
-- such as value bounds. E.g. @Restricted N0 N1 Int@ denotes an 'Int' which can
-- only have values [0 .. 1]. When creating such a value, the constructor functions
-- 'restrict' or 'toRestricted' ensure that the restrictions are obeyed. Code
-- that consumes restricted types does not need to check the constraints.
--
-- /N.B./ This module is more or less tailored to be used within 'System.ZMQ3'.
-- Therefore the provided type level restrictions are limited.
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

-- | Type level restriction.
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
$cshowsPrec :: forall r v. Show v => Int -> Restricted r v -> ShowS
showsPrec :: Int -> Restricted r v -> ShowS
$cshow :: forall r v. Show v => Restricted r v -> String
show :: Restricted r v -> String
$cshowList :: forall r v. Show v => [Restricted r v] -> ShowS
showList :: [Restricted r v] -> ShowS
Show

-- | A uniform way to restrict values.
class Restriction r v where

    -- | Create a restricted value. Returns 'Nothing' if
    -- the given value does not satisfy all restrictions.
    toRestricted :: v -> Maybe (Restricted r v)

    -- | Create a restricted value. If the given value
    -- does not satisfy the restrictions, a modified
    -- variant is used instead, e.g. if an integer is
    -- larger than the upper bound, the upper bound
    -- value is used.
    restrict :: v -> Restricted r v

-- | Get the actual value.
rvalue :: Restricted r v -> v
rvalue :: forall r v. Restricted r v -> v
rvalue (Restricted v
v) = v
v

-- | type level -1
data Nneg1

-- | type-level   0
data N0

-- | type-level   1
data N1

-- | type-level 254
data N254

-- | type-level infinity
data Inf

-- | divisable by 4
data Div4

-- | divisable by 5
data Div5

instance Show Nneg1 where show :: Nneg1 -> String
show Nneg1
_ = String
"Nneg1"
instance Show N0    where show :: N0 -> String
show N0
_ = String
"N0"
instance Show N1    where show :: N1 -> String
show N1
_ = String
"N1"
instance Show N254  where show :: N254 -> String
show N254
_ = String
"N254"
instance Show Inf   where show :: Inf -> String
show Inf
_ = String
"Inf"
instance Show Div4  where show :: Div4 -> String
show Div4
_ = String
"Div4"
instance Show Div5  where show :: Div5 -> String
show Div5
_ = String
"Div5"

-- Natural numbers

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 a
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   a
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 a
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   a
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 a
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   a
0 (Int64
forall a. Bounded a => a
maxBound :: Int64)

-- Positive natural numbers

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 a
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   a
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 a
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   a
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 a
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   a
1 (Int64
forall a. Bounded a => a
maxBound :: Int64)

-- From -1 ranges

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 (-a
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   (-a
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 (-a
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   (-a
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 (-a
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   (-a
1) (Int64
forall a. Bounded a => a
maxBound :: Int64)

-- Other ranges

instance Restriction (N1, N254) String where
    toRestricted :: String -> Maybe (Restricted (N1, N254) String)
toRestricted String
s | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (Int
1, Int
254) (String -> Int
forall a. [a] -> 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 String
s | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> Restricted (N1, N254) String
forall r v. v -> Restricted r v
Restricted String
" "
               | Bool
otherwise    = String -> Restricted (N1, N254) String
forall r v. v -> Restricted r v
Restricted (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
254 String
s)

instance Restriction (N1, N254) ByteString where
    toRestricted :: ByteString -> Maybe (Restricted (N1, N254) ByteString)
toRestricted ByteString
s | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (Int
1, Int
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 ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = ByteString -> Restricted (N1, N254) ByteString
forall r v. v -> Restricted r v
Restricted (Word8 -> ByteString
B.singleton Word8
0x20)
               | Bool
otherwise      = ByteString -> Restricted (N1, N254) ByteString
forall r v. v -> Restricted r v
Restricted (Int -> ByteString -> ByteString
B.take Int
254 ByteString
s)

instance Restriction (N0, N254) ByteString where
    toRestricted :: ByteString -> Maybe (Restricted (N0, N254) ByteString)
toRestricted ByteString
s | (Int, Int) -> Int -> Bool
forall a. Ord a => (a, a) -> a -> Bool
check (Int
0, Int
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 ByteString
s = ByteString -> Restricted (N0, N254) ByteString
forall r v. v -> Restricted r v
Restricted (Int -> ByteString -> ByteString
B.take Int
254 ByteString
s)

-- Other constraints

instance Restriction Div4 ByteString where
    toRestricted :: ByteString -> Maybe (Restricted Div4 ByteString)
toRestricted ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 Int
4

instance Restriction Div5 ByteString where
    toRestricted :: ByteString -> Maybe (Restricted Div5 ByteString)
toRestricted ByteString
s | ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
5 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 Int
5

-- Helpers

toIntR :: (Integral i, Integral j) => i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR :: forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Maybe (Restricted (a, b) i)
toIntR i
lb j
ub 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 :: forall i j a b.
(Integral i, Integral j) =>
i -> j -> i -> Restricted (a, b) i
intR i
lb 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 :: forall i a b. Integral i => i -> i -> Maybe (Restricted (a, b) i)
toIntRLB i
lb 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 :: forall i a b. Integral i => i -> i -> Restricted (a, b) i
intRLB 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

-- Bounds checks

lbcheck :: Ord a => a -> a -> Bool
lbcheck :: forall a. Ord a => a -> a -> Bool
lbcheck a
lb a
a = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lb

ubcheck :: Ord a => a -> a -> Bool
ubcheck :: forall a. Ord a => a -> a -> Bool
ubcheck a
ub a
a = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
ub

check :: Ord a => (a, a) -> a -> Bool
check :: forall a. Ord a => (a, a) -> a -> Bool
check (a
lb, a
ub) 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

-- Fit

lbfit :: Integral a => a -> a -> a
lbfit :: forall a. Integral a => a -> a -> a
lbfit a
lb 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 :: forall a. Integral a => a -> a -> a
ubfit a
ub 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 :: forall r. Int -> ByteString -> Restricted r ByteString
fitByRem Int
r 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
== Int
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)