{-# 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
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

-- | 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 :: Restricted r v -> v
rvalue (Restricted v :: 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"
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"

-- 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 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)

-- 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 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)

-- 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 (-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)

-- Other ranges

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)

-- Other constraints

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

-- Helpers

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

-- Bounds checks

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

-- Fit

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)