-- |Various kinds of arrays (lists, vectors, bytestrings) with statically aserted length constraints encoded in their type.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- {-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Network.ONCRPC.XDR.Array
  ( KnownNat
  , KnownOrdering
  , OpaqueString(..)
  , opaqueLengthArray
  , unOpaqueLengthArray
  , LengthArray
  , FixedLengthArray
  , fixedLengthArrayLength
  , BoundedLengthArray
  , boundedLengthArrayBound
  , unLengthArray
  , unsafeLengthArray
  , lengthArray
  , lengthArray'
  , boundLengthArray
  , boundLengthArrayFromList
  , padLengthArray
  , constLengthArray
  , emptyFixedLengthArray
  , emptyBoundedLengthArray
  , expandBoundedLengthArray
  , boundFixedLengthArray
  , appendLengthArray
  , fromLengthList
  ) where

import           Prelude hiding (length, take, drop, replicate)
import           Control.Monad (guard)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Base16 as Hex
import qualified Data.List as List
import           Data.Maybe (fromMaybe, fromJust)
import           Data.Monoid (Monoid, (<>))
import           Data.Proxy (Proxy(..))
import           Data.Semigroup (Semigroup)
import           Data.String (IsString(..))
import qualified Data.Vector as V
import           Data.Word (Word8)
import           GHC.TypeLits (Nat, KnownNat, natVal, type (+), type CmpNat)
import           Text.Read (readPrec)

-- |A 'ByteString' that uses hex (base16) for 'Read'/'Show'.
newtype OpaqueString = OpaqueString{ OpaqueString -> ByteString
unOpaqueString :: BS.ByteString }
  deriving (OpaqueString -> OpaqueString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpaqueString -> OpaqueString -> Bool
$c/= :: OpaqueString -> OpaqueString -> Bool
== :: OpaqueString -> OpaqueString -> Bool
$c== :: OpaqueString -> OpaqueString -> Bool
Eq, Eq OpaqueString
OpaqueString -> OpaqueString -> Bool
OpaqueString -> OpaqueString -> Ordering
OpaqueString -> OpaqueString -> OpaqueString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OpaqueString -> OpaqueString -> OpaqueString
$cmin :: OpaqueString -> OpaqueString -> OpaqueString
max :: OpaqueString -> OpaqueString -> OpaqueString
$cmax :: OpaqueString -> OpaqueString -> OpaqueString
>= :: OpaqueString -> OpaqueString -> Bool
$c>= :: OpaqueString -> OpaqueString -> Bool
> :: OpaqueString -> OpaqueString -> Bool
$c> :: OpaqueString -> OpaqueString -> Bool
<= :: OpaqueString -> OpaqueString -> Bool
$c<= :: OpaqueString -> OpaqueString -> Bool
< :: OpaqueString -> OpaqueString -> Bool
$c< :: OpaqueString -> OpaqueString -> Bool
compare :: OpaqueString -> OpaqueString -> Ordering
$ccompare :: OpaqueString -> OpaqueString -> Ordering
Ord, NonEmpty OpaqueString -> OpaqueString
OpaqueString -> OpaqueString -> OpaqueString
forall b. Integral b => b -> OpaqueString -> OpaqueString
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> OpaqueString -> OpaqueString
$cstimes :: forall b. Integral b => b -> OpaqueString -> OpaqueString
sconcat :: NonEmpty OpaqueString -> OpaqueString
$csconcat :: NonEmpty OpaqueString -> OpaqueString
<> :: OpaqueString -> OpaqueString -> OpaqueString
$c<> :: OpaqueString -> OpaqueString -> OpaqueString
Semigroup, Semigroup OpaqueString
OpaqueString
[OpaqueString] -> OpaqueString
OpaqueString -> OpaqueString -> OpaqueString
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [OpaqueString] -> OpaqueString
$cmconcat :: [OpaqueString] -> OpaqueString
mappend :: OpaqueString -> OpaqueString -> OpaqueString
$cmappend :: OpaqueString -> OpaqueString -> OpaqueString
mempty :: OpaqueString
$cmempty :: OpaqueString
Monoid, OpaqueString -> Int
OpaqueString -> Int -> Ordering
forall a. (a -> Int) -> (a -> Int -> Ordering) -> HasLength a
compareLength :: OpaqueString -> Int -> Ordering
$ccompareLength :: OpaqueString -> Int -> Ordering
length :: OpaqueString -> Int
$clength :: OpaqueString -> Int
HasLength)

instance Show OpaqueString where
  show :: OpaqueString -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Hex.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpaqueString -> ByteString
unOpaqueString
  showsPrec :: Int -> OpaqueString -> ShowS
showsPrec Int
p = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Hex.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpaqueString -> ByteString
unOpaqueString

instance Read OpaqueString where
  readPrec :: ReadPrec OpaqueString
readPrec = do
    ByteString
b <- forall a. Read a => ReadPrec a
readPrec
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> OpaqueString
OpaqueString) forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Hex.decode ByteString
b

-- |Allows either hex or character input, dynamically.
instance IsString OpaqueString where
  fromString :: String -> OpaqueString
fromString String
s = ByteString -> OpaqueString
OpaqueString forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
_ -> ByteString
b) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
Hex.decode ByteString
b
    -- | all isHexDigit s = OpaqueString $ fst $ Hex.decode $ fromString s
    where
    b :: ByteString
b = forall a. IsString a => String -> a
fromString String
s

-- See also MonoFoldable
class HasLength a where
  length :: a -> Int
  -- |Equivalent to @'compare' . 'length'@ but allows more efficient implementations
  compareLength :: a -> Int -> Ordering
  compareLength = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasLength a => a -> Int
length

-- See also IsSquence
class (Monoid a, HasLength a) => Array a where
  type Elem a :: *
  take :: Int -> a -> a
  replicate :: Int -> Elem a -> a
  fromList :: [Elem a] -> a

instance HasLength [a] where
  length :: [a] -> Int
length = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length
  compareLength :: [a] -> Int -> Ordering
compareLength [] Int
n = forall a. Ord a => a -> a -> Ordering
compare Int
0 Int
n
  compareLength (a
_:[a]
l) Int
n = forall a. HasLength a => a -> Int -> Ordering
compareLength [a]
l (Int
n forall a. Num a => a -> a -> a
- Int
1)
instance Array [a] where
  type Elem [a] = a
  take :: Int -> [a] -> [a]
take = forall a. Int -> [a] -> [a]
List.take
  replicate :: Int -> Elem [a] -> [a]
replicate = forall a. Int -> a -> [a]
List.replicate
  fromList :: [Elem [a]] -> [a]
fromList = forall a. a -> a
id

instance HasLength (V.Vector a) where
  length :: Vector a -> Int
length = forall a. Vector a -> Int
V.length
instance Array (V.Vector a) where
  type Elem (V.Vector a) = a
  take :: Int -> Vector a -> Vector a
take = forall a. Int -> Vector a -> Vector a
V.take
  replicate :: Int -> Elem (Vector a) -> Vector a
replicate = forall a. Int -> a -> Vector a
V.replicate
  fromList :: [Elem (Vector a)] -> Vector a
fromList = forall a. [a] -> Vector a
V.fromList

instance HasLength BS.ByteString where
  length :: ByteString -> Int
length = ByteString -> Int
BS.length
instance Array BS.ByteString where
  type Elem BS.ByteString = Word8
  take :: Int -> ByteString -> ByteString
take = Int -> ByteString -> ByteString
BS.take
  replicate :: Int -> Elem ByteString -> ByteString
replicate = Int -> Word8 -> ByteString
BS.replicate
  fromList :: [Elem ByteString] -> ByteString
fromList = [Word8] -> ByteString
BS.pack

instance Array OpaqueString where
  type Elem OpaqueString = Word8
  take :: Int -> OpaqueString -> OpaqueString
take Int
n = ByteString -> OpaqueString
OpaqueString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpaqueString -> ByteString
unOpaqueString
  replicate :: Int -> Elem OpaqueString -> OpaqueString
replicate Int
n = ByteString -> OpaqueString
OpaqueString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ByteString
BS.replicate Int
n
  fromList :: [Elem OpaqueString] -> OpaqueString
fromList = ByteString -> OpaqueString
OpaqueString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack

instance HasLength BSL.ByteString where
  length :: ByteString -> Int
length = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
  compareLength :: ByteString -> Int -> Ordering
compareLength ByteString
b Int
n
    | ByteString -> Bool
BSL.null ByteString
b' = Ordering
LT
    | ByteString -> Bool
BSL.null (HasCallStack => ByteString -> ByteString
BSL.tail ByteString
b') = Ordering
EQ
    | Bool
otherwise = Ordering
GT
    where b' :: ByteString
b' = Int64 -> ByteString -> ByteString
BSL.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
- Int64
1) ByteString
b
instance Array BSL.ByteString where
  type Elem BSL.ByteString = Word8
  take :: Int -> ByteString -> ByteString
take = Int64 -> ByteString -> ByteString
BSL.take forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  replicate :: Int -> Elem ByteString -> ByteString
replicate = Int64 -> Word8 -> ByteString
BSL.replicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  fromList :: [Elem ByteString] -> ByteString
fromList = [Word8] -> ByteString
BSL.pack

class KnownOrdering (o :: Ordering) where
  orderingVal :: proxy o -> Ordering

instance KnownOrdering 'LT where orderingVal :: forall (proxy :: Ordering -> *). proxy 'LT -> Ordering
orderingVal proxy 'LT
_ = Ordering
LT
instance KnownOrdering 'EQ where orderingVal :: forall (proxy :: Ordering -> *). proxy 'EQ -> Ordering
orderingVal proxy 'EQ
_ = Ordering
EQ
instance KnownOrdering 'GT where orderingVal :: forall (proxy :: Ordering -> *). proxy 'GT -> Ordering
orderingVal proxy 'GT
_ = Ordering
GT

-- |Assertion that the contained array satisfies @'compareLength' a n = o@
newtype LengthArray (o :: Ordering) (n :: Nat) a = LengthArray{ forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray :: a }
  deriving (LengthArray o n a -> LengthArray o n a -> Bool
forall (o :: Ordering) (n :: Nat) a.
Eq a =>
LengthArray o n a -> LengthArray o n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LengthArray o n a -> LengthArray o n a -> Bool
$c/= :: forall (o :: Ordering) (n :: Nat) a.
Eq a =>
LengthArray o n a -> LengthArray o n a -> Bool
== :: LengthArray o n a -> LengthArray o n a -> Bool
$c== :: forall (o :: Ordering) (n :: Nat) a.
Eq a =>
LengthArray o n a -> LengthArray o n a -> Bool
Eq, LengthArray o n a -> LengthArray o n a -> Bool
LengthArray o n a -> LengthArray o n a -> Ordering
LengthArray o n a -> LengthArray o n a -> LengthArray o n a
forall {o :: Ordering} {n :: Nat} {a}.
Ord a =>
Eq (LengthArray o n a)
forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Bool
forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Ordering
forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> LengthArray o n a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LengthArray o n a -> LengthArray o n a -> LengthArray o n a
$cmin :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> LengthArray o n a
max :: LengthArray o n a -> LengthArray o n a -> LengthArray o n a
$cmax :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> LengthArray o n a
>= :: LengthArray o n a -> LengthArray o n a -> Bool
$c>= :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Bool
> :: LengthArray o n a -> LengthArray o n a -> Bool
$c> :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Bool
<= :: LengthArray o n a -> LengthArray o n a -> Bool
$c<= :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Bool
< :: LengthArray o n a -> LengthArray o n a -> Bool
$c< :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Bool
compare :: LengthArray o n a -> LengthArray o n a -> Ordering
$ccompare :: forall (o :: Ordering) (n :: Nat) a.
Ord a =>
LengthArray o n a -> LengthArray o n a -> Ordering
Ord, Int -> LengthArray o n a -> ShowS
forall (o :: Ordering) (n :: Nat) a.
Show a =>
Int -> LengthArray o n a -> ShowS
forall (o :: Ordering) (n :: Nat) a.
Show a =>
[LengthArray o n a] -> ShowS
forall (o :: Ordering) (n :: Nat) a.
Show a =>
LengthArray o n a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LengthArray o n a] -> ShowS
$cshowList :: forall (o :: Ordering) (n :: Nat) a.
Show a =>
[LengthArray o n a] -> ShowS
show :: LengthArray o n a -> String
$cshow :: forall (o :: Ordering) (n :: Nat) a.
Show a =>
LengthArray o n a -> String
showsPrec :: Int -> LengthArray o n a -> ShowS
$cshowsPrec :: forall (o :: Ordering) (n :: Nat) a.
Show a =>
Int -> LengthArray o n a -> ShowS
Show)

instance HasLength a => HasLength (LengthArray o n a) where
  length :: LengthArray o n a -> Int
length = forall a. HasLength a => a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray
  compareLength :: LengthArray o n a -> Int -> Ordering
compareLength = forall a. HasLength a => a -> Int -> Ordering
compareLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray

-- |Assertion that the contained array is exactly a static length
type FixedLengthArray n a = LengthArray 'EQ n a
-- |Assertion that the contained array is at most a static length (inclusive)
type BoundedLengthArray n a = LengthArray 'LT (n + 1) a

lengthArrayOrdering :: forall o n a . KnownOrdering o => LengthArray o n a -> Ordering
lengthArrayOrdering :: forall (o :: Ordering) (n :: Nat) a.
KnownOrdering o =>
LengthArray o n a -> Ordering
lengthArrayOrdering LengthArray o n a
_ = forall (o :: Ordering) (proxy :: Ordering -> *).
KnownOrdering o =>
proxy o -> Ordering
orderingVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy o)

lengthArrayBound :: forall o n a . KnownNat n => LengthArray o n a -> Int
lengthArrayBound :: forall (o :: Ordering) (n :: Nat) a.
KnownNat n =>
LengthArray o n a -> Int
lengthArrayBound LengthArray o n a
_ = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)

orderingOp :: Ordering -> Char
orderingOp :: Ordering -> Char
orderingOp Ordering
LT = Char
'<'
orderingOp Ordering
EQ = Char
'='
orderingOp Ordering
GT = Char
'>'

describeLengthArray :: (KnownOrdering o, KnownNat n) => LengthArray o n a -> String
describeLengthArray :: forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n) =>
LengthArray o n a -> String
describeLengthArray LengthArray o n a
a = Ordering -> Char
orderingOp (forall (o :: Ordering) (n :: Nat) a.
KnownOrdering o =>
LengthArray o n a -> Ordering
lengthArrayOrdering LengthArray o n a
a) forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall (o :: Ordering) (n :: Nat) a.
KnownNat n =>
LengthArray o n a -> Int
lengthArrayBound LengthArray o n a
a)

-- |Static length of a 'FixedLengthArray'
fixedLengthArrayLength :: KnownNat n => LengthArray 'EQ n a -> Int
fixedLengthArrayLength :: forall (n :: Nat) a. KnownNat n => LengthArray 'EQ n a -> Int
fixedLengthArrayLength = forall (o :: Ordering) (n :: Nat) a.
KnownNat n =>
LengthArray o n a -> Int
lengthArrayBound

-- |Static upper-bound (inclusive) of a 'BoundedLengthArray'
boundedLengthArrayBound :: KnownNat n => LengthArray 'LT n a -> Int
boundedLengthArrayBound :: forall (n :: Nat) a. KnownNat n => LengthArray 'LT n a -> Int
boundedLengthArrayBound = forall a. Num a => a -> a -> a
subtract Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a.
KnownNat n =>
LengthArray o n a -> Int
lengthArrayBound

-- |Unsafely create a 'LengthArray' without checking the length bound assertion.
-- May cause unpredictable behavior if the bound does not hold.
unsafeLengthArray :: a -> LengthArray o n a
unsafeLengthArray :: forall a (o :: Ordering) (n :: Nat). a -> LengthArray o n a
unsafeLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray

checkLengthArray :: (KnownOrdering o, KnownNat n, HasLength a) => LengthArray o n a -> Bool
checkLengthArray :: forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n, HasLength a) =>
LengthArray o n a -> Bool
checkLengthArray l :: LengthArray o n a
l@(LengthArray a
a) = forall a. HasLength a => a -> Int -> Ordering
compareLength a
a (forall (o :: Ordering) (n :: Nat) a.
KnownNat n =>
LengthArray o n a -> Int
lengthArrayBound LengthArray o n a
l) forall a. Eq a => a -> a -> Bool
== forall (o :: Ordering) (n :: Nat) a.
KnownOrdering o =>
LengthArray o n a -> Ordering
lengthArrayOrdering LengthArray o n a
l

-- |Safely create a 'LengthArray' out of an array if it conforms to the static length assertion.
lengthArray :: forall o n a . (KnownOrdering o, KnownNat n, HasLength a) => a -> Maybe (LengthArray o n a)
lengthArray :: forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n, HasLength a) =>
a -> Maybe (LengthArray o n a)
lengthArray a
a
  | forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n, HasLength a) =>
LengthArray o n a -> Bool
checkLengthArray LengthArray o n a
l = forall a. a -> Maybe a
Just LengthArray o n a
l
  | Bool
otherwise = forall a. Maybe a
Nothing
  where l :: LengthArray o n a
l = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray a
a :: LengthArray o n a

-- |Create a 'LengthArray' or runtime error if the assertion fails: @fromMaybe undefined . 'lengthArray'@
lengthArray' :: forall o n a . (KnownOrdering o, KnownNat n, HasLength a) => a -> LengthArray o n a
lengthArray' :: forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n, HasLength a) =>
a -> LengthArray o n a
lengthArray' a
a = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"lengthArray': fails check " forall a. [a] -> [a] -> [a]
++ forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n) =>
LengthArray o n a -> String
describeLengthArray (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LengthArray o n a)
la)) Maybe (LengthArray o n a)
la
  where la :: Maybe (LengthArray o n a)
la = forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n, HasLength a) =>
a -> Maybe (LengthArray o n a)
lengthArray a
a

-- |Create a 'BoundedLengthArray' by trimming the given array if necessary.
boundLengthArray :: (KnownNat n, Array a) => a -> LengthArray 'LT n a
boundLengthArray :: forall (n :: Nat) a.
(KnownNat n, Array a) =>
a -> LengthArray 'LT n a
boundLengthArray a
a = LengthArray 'LT n a
l where
  l :: LengthArray 'LT n a
l = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall a b. (a -> b) -> a -> b
$ forall a. Array a => Int -> a -> a
take (forall (n :: Nat) a. KnownNat n => LengthArray 'LT n a -> Int
boundedLengthArrayBound LengthArray 'LT n a
l) a
a

-- |Create a 'BoundedLengthArray' by trimming the given array if necessary.
boundLengthArrayFromList :: (KnownNat n, Array a) => [Elem a] -> LengthArray 'LT n a
boundLengthArrayFromList :: forall (n :: Nat) a.
(KnownNat n, Array a) =>
[Elem a] -> LengthArray 'LT n a
boundLengthArrayFromList [Elem a]
a = LengthArray 'LT n a
l where
  l :: LengthArray 'LT n a
l = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall a b. (a -> b) -> a -> b
$ forall a. Array a => [Elem a] -> a
fromList forall a b. (a -> b) -> a -> b
$ forall a. Array a => Int -> a -> a
take (forall (n :: Nat) a. KnownNat n => LengthArray 'LT n a -> Int
boundedLengthArrayBound LengthArray 'LT n a
l) [Elem a]
a

-- |Create a 'FixedLengthArray' by trimming or padding (on the right) as necessary.
padLengthArray :: (KnownNat n, Array a) => a -> Elem a -> LengthArray 'EQ n a
padLengthArray :: forall (n :: Nat) a.
(KnownNat n, Array a) =>
a -> Elem a -> LengthArray 'EQ n a
padLengthArray a
a Elem a
p = LengthArray 'EQ n a
l where
  a' :: a
a' = case forall a. HasLength a => a -> Int -> Ordering
compareLength a
a Int
n of
    Ordering
LT -> a
a forall a. Semigroup a => a -> a -> a
<> forall a. Array a => Int -> Elem a -> a
replicate (Int
n forall a. Num a => a -> a -> a
- forall a. HasLength a => a -> Int
length a
a) Elem a
p
    Ordering
EQ -> a
a
    Ordering
GT -> forall a. Array a => Int -> a -> a
take Int
n a
a
  n :: Int
n = forall (n :: Nat) a. KnownNat n => LengthArray 'EQ n a -> Int
fixedLengthArrayLength LengthArray 'EQ n a
l
  l :: LengthArray 'EQ n a
l = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray a
a'

-- |Create a 'FixedLengthArray' filled with the same value.
constLengthArray :: (KnownNat n, Array a) => Elem a -> LengthArray 'EQ n a
constLengthArray :: forall (n :: Nat) a.
(KnownNat n, Array a) =>
Elem a -> LengthArray 'EQ n a
constLengthArray Elem a
p = LengthArray 'EQ n a
l where
  l :: LengthArray 'EQ n a
l = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall a b. (a -> b) -> a -> b
$ forall a. Array a => Int -> Elem a -> a
replicate (forall (n :: Nat) a. KnownNat n => LengthArray 'EQ n a -> Int
fixedLengthArrayLength LengthArray 'EQ n a
l) Elem a
p

instance (KnownOrdering o, KnownNat n, IsString a, HasLength a) => IsString (LengthArray o n a) where
  fromString :: String -> LengthArray o n a
fromString String
s = forall a. a -> Maybe a -> a
fromMaybe
    (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"String " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" fails LengthArray check " forall a. [a] -> [a] -> [a]
++ forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n) =>
LengthArray o n a -> String
describeLengthArray (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LengthArray o n a)
ls))
    Maybe (LengthArray o n a)
ls
    where ls :: Maybe (LengthArray o n a)
ls = forall (o :: Ordering) (n :: Nat) a.
(KnownOrdering o, KnownNat n, HasLength a) =>
a -> Maybe (LengthArray o n a)
lengthArray forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
s

-- |An empty 'FixedLengthArray'.
emptyFixedLengthArray :: Array a => LengthArray 'EQ 0 a
emptyFixedLengthArray :: forall a. Array a => LengthArray 'EQ 0 a
emptyFixedLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall a. Monoid a => a
mempty

-- |An empty 'BoundedLengthArray'.
emptyBoundedLengthArray :: (CmpNat 0 n ~ 'LT, Array a) => LengthArray 'LT n a
emptyBoundedLengthArray :: forall (n :: Nat) a.
(CmpNat 0 n ~ 'LT, Array a) =>
LengthArray 'LT n a
emptyBoundedLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall a. Monoid a => a
mempty

-- |Grow the bound of a 'BoundedLengthArray'.
expandBoundedLengthArray :: (CmpNat n m ~ 'LT) => LengthArray 'LT n a -> LengthArray 'LT m a
expandBoundedLengthArray :: forall (n :: Nat) (m :: Nat) a.
(CmpNat n m ~ 'LT) =>
LengthArray 'LT n a -> LengthArray 'LT m a
expandBoundedLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray

-- |Convert a 'FixedLengthArray' to a 'BoundedLengthArray'.
boundFixedLengthArray :: (CmpNat n m ~ 'LT) => LengthArray 'EQ n a -> LengthArray 'LT m a
boundFixedLengthArray :: forall (n :: Nat) (m :: Nat) a.
(CmpNat n m ~ 'LT) =>
LengthArray 'EQ n a -> LengthArray 'LT m a
boundFixedLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray

-- |Append to two 'LengthArray's.
appendLengthArray :: Monoid a => LengthArray o n a -> LengthArray o m a -> LengthArray o (n + m) a
appendLengthArray :: forall a (o :: Ordering) (n :: Nat) (m :: Nat).
Monoid a =>
LengthArray o n a -> LengthArray o m a -> LengthArray o (n + m) a
appendLengthArray (LengthArray a
a) (LengthArray a
b) = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend a
a a
b

fromLengthList :: Array a => LengthArray o n [Elem a] -> LengthArray o n a
fromLengthList :: forall a (o :: Ordering) (n :: Nat).
Array a =>
LengthArray o n [Elem a] -> LengthArray o n a
fromLengthList = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a => [Elem a] -> a
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray

opaqueLengthArray :: LengthArray o n BS.ByteString -> LengthArray o n OpaqueString
opaqueLengthArray :: forall (o :: Ordering) (n :: Nat).
LengthArray o n ByteString -> LengthArray o n OpaqueString
opaqueLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> OpaqueString
OpaqueString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray

unOpaqueLengthArray :: LengthArray o n OpaqueString -> LengthArray o n BS.ByteString
unOpaqueLengthArray :: forall (o :: Ordering) (n :: Nat).
LengthArray o n OpaqueString -> LengthArray o n ByteString
unOpaqueLengthArray = forall (o :: Ordering) (n :: Nat) a. a -> LengthArray o n a
LengthArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpaqueString -> ByteString
unOpaqueString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (o :: Ordering) (n :: Nat) a. LengthArray o n a -> a
unLengthArray