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