packages feed

foundation (empty) → 0.0.1

raw patch · 71 files changed

+9475/−0 lines, 71 filesdep +QuickCheckdep +Win32dep +basesetup-changed

Dependencies added: QuickCheck, Win32, base, criterion, foundation, ghc-prim, mtl, tasty, tasty-hunit, tasty-quickcheck

Files

+ Foundation.hs view
@@ -0,0 +1,178 @@+-- |+-- Module      : Foundation+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- I tried to picture clusters of information+-- As they moved through the computer+-- What do they look like?+--+-- Alternative Prelude+{-# LANGUAGE CPP #-}+module Foundation+    ( -- * Standard+      -- ** Operators+      (Prelude.$)+    , (Prelude.$!)+    , (Prelude.&&)+    , (Prelude.||)+    , (Control.Category..)+      -- ** Functions+    , Prelude.not+    , Prelude.otherwise+    , module Foundation.Tuple+    , Control.Category.id+    , Prelude.maybe+    , Prelude.either+    , Prelude.flip+    , Prelude.const+    , Prelude.error+    , Foundation.IO.Terminal.putStr+    , Foundation.IO.Terminal.putStrLn+    --, print+    , getArgs+    , Prelude.uncurry+    , Prelude.curry+    , Data.Tuple.swap+    , Prelude.until+    , Prelude.asTypeOf+    , Prelude.undefined+    , Prelude.seq+      -- ** Type classes+    , Prelude.Show (..)+    , Prelude.Ord (..)+    , Prelude.Eq (..)+    , Prelude.Bounded (..)+    , Prelude.Enum (..)+    , Prelude.Functor (..)+    , Control.Applicative.Applicative (..)+    , Prelude.Monad (..)+    , (Control.Monad.=<<)+    --, Foundation.String.IsString (..)+    , IsString(..)+    , IsList(..)+      -- ** Numeric type classes+    , Foundation.Number.Number (..)+    , Foundation.Number.Signed (..)+    , Foundation.Number.Additive (..)+    , Foundation.Number.Subtractive (..)+    , Foundation.Number.Multiplicative (..)+      -- ** Data types+    , Prelude.Maybe (..)+    , Prelude.Ordering (..)+    , Prelude.Bool (..)+    , Prelude.Char+    , Prelude.IO+    , Prelude.Either (..)+      -- ** Numbers+    , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64+    , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word+    , Prelude.Int+    , Prelude.Integer+    , Prelude.Rational+    , Prelude.Float+    , Prelude.Double+      -- ** Collection types+    , UArray+    , PrimType+    , Array+    , String+      -- ** Numeric functions+    -- , (Prelude.^)+    , (Prelude.^^)+    , Prelude.fromIntegral+    , Prelude.realToFrac+      -- ** Monoids+    , Monoid (..)+    , (<>)+      -- ** Folds and traversals+    , Data.Foldable.Foldable+    , Data.Foldable.asum+    , Data.Traversable.Traversable+      -- ** Maybe+    , Data.Maybe.mapMaybe+    , Data.Maybe.catMaybes+    , Data.Maybe.fromMaybe+    , Data.Maybe.isJust+    , Data.Maybe.isNothing+    , Data.Maybe.listToMaybe+    , Data.Maybe.maybeToList+      -- ** Either+    , Data.Either.partitionEithers+    , Data.Either.lefts+    , Data.Either.rights+      -- ** Function+    , Data.Function.on+      -- ** Applicative+    , (Control.Applicative.<$>)+    , (Control.Applicative.<|>)+      -- ** Monad+    , (Control.Monad.>=>)+      -- ** Exceptions+    , Control.Exception.Exception (..)+    , Data.Typeable.Typeable+    , Control.Exception.SomeException+    , Control.Exception.IOException+      -- ** Proxy+    , Foundation.Internal.Proxy.Proxy(..)+    , Foundation.Internal.Proxy.asProxyTypeOf+      -- ** Partial+    , Foundation.Partial.Partial+    , Foundation.Partial.partial+    , Foundation.Partial.PartialError+    , Foundation.Partial.fromPartial+      -- ** Old Prelude Strings as [Char] with bridge back and forth+    , LString+    ) where++import qualified Prelude+--import           Prelude (Char, (.), Eq, Bool, IO)++import           Data.Monoid (Monoid (..))+import           Control.Applicative+import qualified Control.Category+import qualified Control.Monad+import qualified Control.Exception+import qualified Data.Typeable++import qualified Data.Foldable+import qualified Data.Traversable++import           Data.Word (Word8, Word16, Word32, Word64, Word)+import           Data.Int (Int8, Int16, Int32, Int64)+import           Foundation.String (String)+import           Foundation.Array (UArray, Array, PrimType)+--import           Foundation.Collection+import qualified Foundation.IO.Terminal++import           GHC.Exts (IsString(..))+import           Foundation.Internal.IsList+import qualified Foundation.Internal.Proxy++import qualified Foundation.Number+import qualified Foundation.Partial+import           Foundation.Tuple++import qualified Data.Maybe+import qualified Data.Either+import qualified Data.Function+import qualified Data.Tuple++import qualified System.Environment+import qualified Data.List+#if MIN_VERSION_base(4,6,0)+import           System.IO.Error+#else+import           System.IO.Error hiding (catch, try)+#endif++import           Data.Monoid ((<>))++-- | Alias to Prelude String ([Char]) for compatibility purpose+type LString = Prelude.String++-- | Returns a list of the program's command line arguments (not including the program name).+getArgs :: Prelude.IO [String]+getArgs = (Data.List.map fromList <$> System.Environment.getArgs)
+ Foundation/Array.hs view
@@ -0,0 +1,30 @@+-- |+-- Module      : Foundation.Array+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Simple Array and Almost-Array-like data structure+--+-- Generally accessible in o(1)+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+module Foundation.Array+    ( Array+    , MArray+    , UArray+    , MUArray+    , Bitmap+    , MutableBitmap+    , PrimType+    -- exceptions+    , OutOfBound+    ) where++import           Foundation.Array.Common+import           Foundation.Array.Boxed+import           Foundation.Array.Unboxed+import           Foundation.Array.Unboxed.Mutable+import           Foundation.Array.Bitmap
+ Foundation/Array/Bitmap.hs view
@@ -0,0 +1,435 @@+-- |+-- Module      : Foundation.Array.Bitmap+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A simple abstraction to a set of Bits (Bitmap)+--+-- Largely a placeholder for a more performant implementation,+-- most operation goes through the List representation (e.g. [Bool])+-- to conduct even the most trivial operation, leading to a lots of+-- unnecessary churn.+--+{-# LANGUAGE BangPatterns #-}+module Foundation.Array.Bitmap+    ( Bitmap+    , MutableBitmap+    , empty+    , append+    , concat+    , unsafeIndex+    , index+    , read+    , unsafeRead+    , write+    , unsafeWrite+    , snoc+    , cons+    ) where++import           Foundation.Array.Unboxed (UArray)+import qualified Foundation.Array.Unboxed as A+import           Foundation.Array.Unboxed.Mutable (MUArray)+import           Foundation.Array.Common+import           Foundation.Internal.Base+import           Foundation.Internal.Types+import           Foundation.Primitive.Monad+import qualified Foundation.Collection as C+import           Foundation.Number+import           Data.Bits+import           GHC.ST+import qualified Data.List++data Bitmap = Bitmap Int (UArray Word32)++data MutableBitmap st = MutableBitmap Int (MUArray Word32 st)++bitsPerTy :: Int+bitsPerTy = 32++instance Show Bitmap where+    show v = show (toList v)+instance Eq Bitmap where+    (==) = equal+instance Ord Bitmap where+    compare = vCompare+instance Monoid Bitmap where+    mempty  = empty+    mappend = append+    mconcat = concat++type instance C.Element Bitmap = Bool++instance IsList Bitmap where+    type Item Bitmap = Bool+    fromList = vFromList+    toList = vToList++instance C.InnerFunctor Bitmap where+    imap = map++instance C.Foldable Bitmap where+    foldl = foldl+    foldr = foldr+    foldl' = foldl'+    foldr' = foldr'++instance C.Sequential Bitmap where+    null = null+    take = take+    drop = drop+    splitAt = splitAt+    revTake n = unoptimised (C.revTake n)+    revDrop n = unoptimised (C.revDrop n)+    splitOn = splitOn+    break = break+    span = span+    filter = filter+    reverse = reverse+    snoc = snoc+    cons = cons+    unsnoc = unsnoc+    uncons = uncons+    intersperse = intersperse+    find = find+    sortBy = sortBy+    length = length+    singleton = fromList . (:[])++instance C.IndexedCollection Bitmap where+    (!) l n+        | n < 0 || n >= length l = Nothing+        | otherwise              = Just $ index l n+    findIndex predicate c = loop 0+      where+        !len = length c+        loop i+            | i == len                    = Nothing+            | predicate (unsafeIndex c i) = Just i+            | otherwise                   = Nothing++instance C.MutableCollection MutableBitmap where+    type Collection MutableBitmap = Bitmap+    type MutableKey MutableBitmap = Int+    type MutableValue MutableBitmap = Bool++    thaw = thaw+    freeze = freeze+    unsafeThaw = unsafeThaw+    unsafeFreeze = unsafeFreeze++    mutUnsafeWrite = unsafeWrite+    mutUnsafeRead = unsafeRead+    mutWrite = write+    mutRead = read++bitmapIndex :: Int -> (Int, Int)+bitmapIndex !i = i `divMod` bitsPerTy+{-# INLINE bitmapIndex #-}++-- return the index in word32 quantity and mask to a bit in a bitmap+{-+bitmapAddr :: Int -> (# Int , Word #)+bitmapAddr !i = (# idx, mask #)+  where (!idx, !bitIdx) = bitmapIndex i+        !mask = case bitIdx of+                    0  -> 0x1+                    1  -> 0x2+                    2  -> 0x4+                    3  -> 0x8+                    4  -> 0x10+                    5  -> 0x20+                    6  -> 0x40+                    7  -> 0x80+                    8  -> 0x100+                    9  -> 0x200+                    10 -> 0x400+                    11 -> 0x800+                    12 -> 0x1000+                    13 -> 0x2000+                    14 -> 0x4000+                    15 -> 0x8000+                    16 -> 0x10000+                    17 -> 0x20000+                    18 -> 0x40000+                    19 -> 0x80000+                    20 -> 0x100000+                    21 -> 0x200000+                    22 -> 0x400000+                    23 -> 0x800000+                    24 -> 0x1000000+                    25 -> 0x2000000+                    26 -> 0x4000000+                    27 -> 0x8000000+                    28 -> 0x10000000+                    29 -> 0x20000000+                    30 -> 0x40000000+                    _  -> 0x80000000+-}++thaw :: PrimMonad prim => Bitmap -> prim (MutableBitmap (PrimState prim))+thaw (Bitmap len ba) = MutableBitmap len `fmap` C.thaw ba++freeze :: PrimMonad prim => MutableBitmap (PrimState prim) -> prim Bitmap+freeze (MutableBitmap len mba) = Bitmap len `fmap` C.freeze mba++unsafeThaw :: PrimMonad prim => Bitmap -> prim (MutableBitmap (PrimState prim))+unsafeThaw (Bitmap len ba) = MutableBitmap len `fmap` C.unsafeThaw ba++unsafeFreeze :: PrimMonad prim => MutableBitmap (PrimState prim) -> prim Bitmap+unsafeFreeze (MutableBitmap len mba) = Bitmap len `fmap` C.unsafeFreeze mba++unsafeWrite :: PrimMonad prim => MutableBitmap (PrimState prim) -> Int -> Bool -> prim ()+unsafeWrite (MutableBitmap _ ma) i v = do+    let (idx, bitIdx) = bitmapIndex i+    w <- A.unsafeRead ma idx+    let w' = if v then setBit w bitIdx else clearBit w bitIdx+    A.unsafeWrite ma idx w'+{-# INLINE unsafeWrite #-}++unsafeRead :: PrimMonad prim => MutableBitmap (PrimState prim) -> Int -> prim Bool+unsafeRead (MutableBitmap _ ma) i = do+    let (idx, bitIdx) = bitmapIndex i+    flip testBit bitIdx `fmap` A.unsafeRead ma idx+{-# INLINE unsafeRead #-}++write :: PrimMonad prim => MutableBitmap (PrimState prim) -> Int -> Bool -> prim ()+write mb n val+    | n < 0 || n >= len = primThrow (OutOfBound OOB_Write n len)+    | otherwise         = unsafeWrite mb n val+  where+    len = mutableLength mb+{-# INLINE write #-}++read :: PrimMonad prim => MutableBitmap (PrimState prim) -> Int -> prim Bool+read mb n+    | n < 0 || n >= len = primThrow (OutOfBound OOB_Read n len)+    | otherwise         = unsafeRead mb n+  where len = mutableLength mb+{-# INLINE read #-}++-- | Return the element at a specific index from a Bitmap.+--+-- If the index @n is out of bounds, an error is raised.+index :: Bitmap -> Int -> Bool+index bits n+    | n < 0 || n >= len = throw (OutOfBound OOB_Index n len)+    | otherwise         = unsafeIndex bits n+  where len = length bits+{-# INLINE index #-}++-- | Return the element at a specific index from an array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'index' if unsure.+unsafeIndex :: Bitmap -> Int -> Bool+unsafeIndex (Bitmap _ ba) n =+    let (idx, bitIdx) = bitmapIndex n+     in testBit (A.unsafeIndex ba idx) bitIdx++{-# INLINE unsafeIndex #-}++-----------------------------------------------------------------------+-- higher level collection implementation+-----------------------------------------------------------------------+length :: Bitmap -> Int+length (Bitmap len _) = len++mutableLength :: MutableBitmap st -> Int+mutableLength (MutableBitmap len _) = len++empty :: Bitmap+empty = Bitmap 0 A.empty++-- | make an array from a list of elements.+vFromList :: [Bool] -> Bitmap+vFromList allBools = runST $ do+    mba <- A.new nbElements+    let mbitmap = MutableBitmap len mba+    loop mbitmap 0 allBools+  where+    loop mb _ []     = unsafeFreeze mb+    loop mb i (x:xs) = unsafeWrite mb i x >> loop mb (i+1) xs++{-+    runST $ do+    mba <- A.new nbElements+    ba  <- loop mba (0 :: Int) allBools+    return (Bitmap len ba)+  where+    loop mba _ [] = A.unsafeFreeze mba+    loop mba i l  = do+        let (l1, l2) = C.splitAt bitsPerTy l+            w = toPacked l1+        A.unsafeWrite mba i w+        loop mba (i+1) l2++    toPacked :: [Bool] -> Word32+    toPacked l =+        C.foldl (.|.) 0 $ Prelude.zipWith (\b w -> if b then (1 `shiftL` w) else 0) l (C.reverse [0..31])+-}++    nbElements :: Size Word32+    nbElements = Size (len `divUp` bitsPerTy)++    divUp a b+        | d == 0    = c+        | otherwise = c+1+      where+        (c,d) = a `divMod` b++    len        = C.length allBools++-- | transform an array to a list.+vToList :: Bitmap -> [Bool]+vToList a = loop 0+  where len = length a+        loop i | i == len  = []+               | otherwise = unsafeIndex a i : loop (i+1)++-- | Check if two vectors are identical+equal :: Bitmap -> Bitmap -> Bool+equal a b+    | la /= lb  = False+    | otherwise = loop 0+  where+    !la = length a+    !lb = length b+    loop n | n == la    = True+           | otherwise = (unsafeIndex a n == unsafeIndex b n) && loop (n+1)++-- | Compare 2 vectors+vCompare :: Bitmap -> Bitmap -> Ordering+vCompare a b = loop 0+  where+    !la = length a+    !lb = length b+    loop n+        | n == la   = if la == lb then EQ else LT+        | n == lb   = GT+        | otherwise =+            case unsafeIndex a n `compare` unsafeIndex b n of+                EQ -> loop (n+1)+                r  -> r++-- | Append 2 arrays together by creating a new bigger array+--+-- TODO completely non optimized+append :: Bitmap -> Bitmap -> Bitmap+append a b = fromList $ toList a `mappend` toList b++-- TODO completely non optimized+concat :: [Bitmap] -> Bitmap+concat l = fromList $ mconcat $ fmap toList l++null :: Bitmap -> Bool+null (Bitmap nbBits _) = nbBits == 0++take :: Int -> Bitmap -> Bitmap+take nbElems bits@(Bitmap nbBits ba)+    | nbElems <= 0     = empty+    | nbElems >= nbBits = bits+    | otherwise        = Bitmap nbElems ba -- TODO : although it work right now, take on the underlaying ba too++drop :: Int -> Bitmap -> Bitmap+drop nbElems bits@(Bitmap nbBits _)+    | nbElems <= 0      = bits+    | nbElems >= nbBits = empty+    | otherwise         = unoptimised (C.drop nbElems) bits+        -- TODO: decide if we have drop easy by having a bit offset in the data structure+        -- or if we need to shift stuff around making all the indexing slighlty more complicated++splitAt :: Int -> Bitmap -> (Bitmap, Bitmap)+splitAt n v = (take n v, drop n v)++-- unoptimised+splitOn :: (Bool -> Bool) -> Bitmap -> [Bitmap]+splitOn f bits = fmap fromList $ C.splitOn f $ toList bits++-- unoptimised+break :: (Bool -> Bool) -> Bitmap -> (Bitmap, Bitmap)+break predicate v = findBreak 0+  where+    findBreak i+        | i == length v = (v, empty)+        | otherwise     =+            if predicate (unsafeIndex v i)+                then splitAt i v+                else findBreak (i+1)++span :: (Bool -> Bool) -> Bitmap -> (Bitmap, Bitmap)+span p = break (not . p)++map :: (Bool -> Bool) -> Bitmap -> Bitmap+map f bits = unoptimised (fmap f) bits++--mapIndex :: (Int -> Bool -> Bool) -> Bitmap -> Bitmap+--mapIndex f Bitmap =++cons :: Bool -> Bitmap -> Bitmap+cons v l = unoptimised (C.cons v) l++snoc :: Bitmap -> Bool -> Bitmap+snoc l v = unoptimised (flip C.snoc v) l++-- unoptimised+uncons :: Bitmap -> Maybe (Bool, Bitmap)+uncons b = fmap (\(v, l) -> (v, fromList l)) $ C.uncons $ toList b++-- unoptimised+unsnoc :: Bitmap -> Maybe (Bitmap, Bool)+unsnoc b = fmap (\(l, v) -> (fromList l, v)) $ C.unsnoc $ toList b++intersperse :: Bool -> Bitmap -> Bitmap+intersperse b = unoptimised (C.intersperse b)++find :: (Bool -> Bool) -> Bitmap -> Maybe Bool+find predicate vec = loop 0+  where+    !len = length vec+    loop i+        | i == len  = Nothing+        | otherwise =+            let e = unsafeIndex vec i+             in if predicate e then Just e else loop (i+1)++sortBy :: (Bool -> Bool -> Ordering) -> Bitmap -> Bitmap+sortBy by bits = unoptimised (C.sortBy by) bits++filter :: (Bool -> Bool) -> Bitmap -> Bitmap+filter predicate vec = unoptimised (Data.List.filter predicate) vec++reverse :: Bitmap -> Bitmap+reverse bits = unoptimised C.reverse bits++foldl :: (a -> Bool -> a) -> a -> Bitmap -> a+foldl f initialAcc vec = loop 0 initialAcc+  where+    len = length vec+    loop i acc+        | i == len  = acc+        | otherwise = loop (i+1) (f acc (unsafeIndex vec i))++foldr :: (Bool -> a -> a) -> a -> Bitmap -> a+foldr f initialAcc vec = loop 0+  where+    len = length vec+    loop i+        | i == len  = initialAcc+        | otherwise = unsafeIndex vec i `f` loop (i+1)++foldr' :: (Bool -> a -> a) -> a -> Bitmap -> a+foldr' = foldr++foldl' :: (a -> Bool -> a) -> a -> Bitmap -> a+foldl' f initialAcc vec = loop 0 initialAcc+  where+    len = length vec+    loop i !acc+        | i == len  = acc+        | otherwise = loop (i+1) (f acc (unsafeIndex vec i))++unoptimised :: ([Bool] -> [Bool]) -> Bitmap -> Bitmap+unoptimised f = vFromList . f . vToList
+ Foundation/Array/Boxed.hs view
@@ -0,0 +1,607 @@+-- |+-- Module      : Foundation.Array.Boxed+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Simple boxed array abstraction+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE UnboxedTuples #-}+module Foundation.Array.Boxed+    ( Array+    , MArray+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.ST+import           Foundation.Number+import           Foundation.Internal.Base+import           Foundation.Internal.Types+import           Foundation.Primitive.Types+import           Foundation.Primitive.Monad+import           Foundation.Array.Common+import qualified Foundation.Collection as C+import qualified Prelude++-- | Array of a+data Array a = Array (Array# a)+    deriving (Typeable)++-- | Mutable Array of a+data MArray a st = MArray (MutableArray# st a)+    deriving (Typeable)++instance Functor Array where+    fmap = map++instance Monoid (Array a) where+    mempty  = empty+    mappend = append+    mconcat = concat++instance Show a => Show (Array a) where+    show v = show (toList v)++instance Eq a => Eq (Array a) where+    (==) = equal+instance Ord a => Ord (Array a) where+    compare = vCompare++type instance C.Element (Array ty) = ty++instance IsList (Array ty) where+    type Item (Array ty) = ty+    fromList = vFromList+    toList = vToList++instance C.InnerFunctor (Array ty)++instance C.Sequential (Array ty) where+    null = null+    take = take+    drop = drop+    splitAt = splitAt+    revTake = revTake+    revDrop = revDrop+    revSplitAt = revSplitAt+    splitOn = splitOn+    break = break+    intersperse = intersperse+    span = span+    reverse = reverse+    filter = filter+    unsnoc = unsnoc+    uncons = uncons+    snoc = snoc+    cons = cons+    find = find+    sortBy = sortBy+    length = length+    singleton = fromList . (:[])++instance C.MutableCollection (MArray ty) where+    type Collection (MArray ty) = Array ty+    type MutableKey (MArray ty) = Int+    type MutableValue (MArray ty) = ty++    thaw = thaw+    freeze = freeze+    unsafeThaw = unsafeThaw+    unsafeFreeze = unsafeFreeze++    mutUnsafeWrite = unsafeWrite+    mutUnsafeRead = unsafeRead+    mutWrite = write+    mutRead = read++instance C.IndexedCollection (Array ty) where+    (!) l n+        | n < 0 || n >= length l = Nothing+        | otherwise              = Just $ index l n+    findIndex predicate c = loop 0+      where+        !len = length c+        loop i+            | i == len  = Nothing+            | otherwise =+                if predicate (unsafeIndex c i) then Just i else Nothing++instance C.Zippable (Array ty) where+    -- TODO Use an array builder once available+    zipWith f a b = runST $ do+        mv <- new len+        go mv 0 f (toList a) (toList b)+        unsafeFreeze mv+      where+        !len = Size $ min (C.length a) (C.length b)+        go _  _  _ []       _        = return ()+        go _  _  _ _        []       = return ()+        go mv i f' (a':as') (b':bs') = do+            write mv i (f' a' b')+            go mv (i + 1) f' as' bs'++instance C.BoxedZippable (Array ty)++-- | return the numbers of elements in a mutable array+mutableLength :: MArray ty st -> Int+mutableLength (MArray ma) = I# (sizeofMutableArray# ma)+{-# INLINE mutableLength #-}++-- | Return the element at a specific index from an array.+--+-- If the index @n is out of bounds, an error is raised.+index :: Array ty -> Int -> ty+index array n+    | n < 0 || n >= len = throw (OutOfBound OOB_Index n len)+    | otherwise         = unsafeIndex array n+  where len = length array+{-# INLINE index #-}++-- | Return the element at a specific index from an array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'index' if unsure.+unsafeIndex :: Array ty -> Int -> ty+unsafeIndex (Array a) (I# n) = let (# v #) = indexArray# a n in v+{-# INLINE unsafeIndex #-}++-- | read a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+read :: PrimMonad prim => MArray ty (PrimState prim) -> Int -> prim ty+read array n+    | n < 0 || n >= len = primThrow (OutOfBound OOB_Read n len)+    | otherwise         = unsafeRead array n+  where len = mutableLength array+{-# INLINE read #-}++-- | read from a cell in a mutable array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'read' if unsure.+unsafeRead :: PrimMonad prim => MArray ty (PrimState prim) -> Int -> prim ty+unsafeRead (MArray ma) (I# i) = primitive $ \s1 -> readArray# ma i s1+--readArray# :: MutableArray# s a -> Int# -> State# s -> (#State# s, a#)+{-# INLINE unsafeRead #-}++-- | Write to a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+write :: PrimMonad prim => MArray ty (PrimState prim) -> Int -> ty -> prim ()+write array n val+    | n < 0 || n >= len = primThrow (OutOfBound OOB_Write n len)+    | otherwise         = unsafeWrite array n val+  where len = mutableLength array+{-# INLINE write #-}++-- | write to a cell in a mutable array without bounds checking.+--+-- Writing with invalid bounds will corrupt memory and your program will+-- become unreliable. use 'write' if unsure.+unsafeWrite :: PrimMonad prim => MArray ty (PrimState prim) -> Int -> ty -> prim ()+unsafeWrite (MArray ma) (I# i) v = primitive $ \s1 -> let !s2 = writeArray# ma i v s1 in (# s2, () #)+{-# INLINE unsafeWrite #-}++-- | Freeze a mutable array into an array.+--+-- the MArray must not be changed after freezing.+unsafeFreeze :: PrimMonad prim => MArray ty (PrimState prim) -> prim (Array ty)+unsafeFreeze (MArray ma) = primitive $ \s1 ->+    case unsafeFreezeArray# ma s1 of+        (# s2, a #) -> (# s2, Array a #)+{-# INLINE unsafeFreeze #-}++-- | Thaw an immutable array.+--+-- The Array must not be used after thawing.+unsafeThaw :: PrimMonad prim => Array ty -> prim (MArray ty (PrimState prim))+unsafeThaw (Array a) = primitive $ \st -> (# st, MArray (unsafeCoerce# a) #)+{-# INLINE unsafeThaw #-}++-- | Thaw an array to a mutable array.+--+-- the array is not modified, instead a new mutable array is created+-- and every values is copied, before returning the mutable array.+thaw :: PrimMonad prim => Array ty -> prim (MArray ty (PrimState prim))+thaw array = do+    m <- new (lengthSize array)+    unsafeCopyAtRO m (Offset 0) array (Offset 0) (lengthSize array)+    return m+{-# INLINE thaw #-}++freeze :: PrimMonad prim => MArray ty (PrimState prim) -> prim (Array ty)+freeze marray = do+    m <- new sz+    copyAt m (Offset 0) marray (Offset 0) sz+    unsafeFreeze m+  where+    sz = Size $ mutableLength marray++-- | Copy a number of elements from an array to another array with offsets+copyAt :: PrimMonad prim+       => MArray ty (PrimState prim) -- ^ destination array+       -> Offset ty                  -- ^ offset at destination+       -> MArray ty (PrimState prim) -- ^ source array+       -> Offset ty                  -- ^ offset at source+       -> Size ty                    -- ^ number of elements to copy+       -> prim ()+copyAt dst od src os n = loop od os+  where !endIndex = os `offsetPlusE` n+        loop (Offset d) s@(Offset i)+            | s == endIndex = return ()+            | otherwise     = unsafeRead src i >>= unsafeWrite dst d >> loop (Offset $ d+1) (Offset $ i+1)++-- | Copy @n@ sequential elements from the specified offset in a source array+--   to the specified position in a destination array.+--+--   This function does not check bounds. Accessing invalid memory can return+--   unpredictable and invalid values.+unsafeCopyAtRO :: PrimMonad prim+               => MArray ty (PrimState prim) -- ^ destination array+               -> Offset ty                  -- ^ offset at destination+               -> Array ty                   -- ^ source array+               -> Offset ty                  -- ^ offset at source+               -> Size ty                    -- ^ number of elements to copy+               -> prim ()+unsafeCopyAtRO dst od src os n = loop od os+  where !endIndex = os `offsetPlusE` n+        loop (Offset d) s@(Offset i)+            | s == endIndex = return ()+            | otherwise     = unsafeWrite dst d (unsafeIndex src i) >> loop (Offset $ d+1) (Offset $ i+1)++-- | Allocate a new array with a fill function that has access to the elements of+--   the source array.+unsafeCopyFrom :: Array ty -- ^ Source array+               -> Size ty  -- ^ Length of the destination array+               -> (Array ty -> Offset ty -> MArray ty s -> ST s ())+               -- ^ Function called for each element in the source array+               -> ST s (Array ty) -- ^ Returns the filled new array+unsafeCopyFrom v' newLen f = new newLen >>= fill (Offset 0) f >>= unsafeFreeze+  where len = lengthSize v'+        endIdx = Offset 0 `offsetPlusE` len+        fill i f' r'+            | i == endIdx = return r'+            | otherwise   = do f' v' i r'+                               fill (i + Offset 1) f' r'++-- | Create a new mutable array of size @n.+--+-- all the cells are uninitialized and could contains invalid values.+--+-- All mutable arrays are allocated on a 64 bits aligned addresses+-- and always contains a number of bytes multiples of 64 bits.+new :: PrimMonad prim => Size ty -> prim (MArray ty (PrimState prim))+new (Size (I# n)) = primitive $ \s1 ->+    case newArray# n (error "vector: internal error uninitialized vector") s1 of+        (# s2, ma #) -> (# s2, MArray ma #)++-- | Create a new array of size @n by settings each cells through the+-- function @f.+create :: Int         -- ^ the size of the array+       -> (Int -> ty) -- ^ the function that set the value at the index+       -> Array ty   -- ^ the array created+create n initializer = runST (new (Size n) >>= iter initializer)+  where+    iter :: PrimMonad prim => (Int -> ty) -> MArray ty (PrimState prim) -> prim (Array ty)+    iter f ma = loop (Offset 0)+      where+        !end = Offset 0 `offsetPlusE` Size n+        loop s@(Offset i)+            | s == end  = unsafeFreeze ma+            | otherwise = unsafeWrite ma i (f i) >> loop (Offset $ i+1)+        {-# INLINE loop #-}+    {-# INLINE iter #-}++-----------------------------------------------------------------------+-- higher level collection implementation+-----------------------------------------------------------------------+equal :: Eq a => Array a -> Array a -> Bool+equal a b = (len == length b) && eachEqual 0+  where+    len = length a+    eachEqual !i+        | i == len                           = True+        | unsafeIndex a i /= unsafeIndex b i = False+        | otherwise                          = eachEqual (i+1)++vCompare :: Ord a => Array a -> Array a -> Ordering+vCompare a b = loop 0+  where+    !la = length a+    !lb = length b+    loop n+        | n == la   = if la == lb then EQ else LT+        | n == lb   = GT+        | otherwise =+            case unsafeIndex a n `compare` unsafeIndex b n of+                EQ -> loop (n+1)+                r  -> r++empty :: Array a+empty = runST $ onNewArray 0 (\_ s -> s)++length :: Array a -> Int+length (Array a) = I# (sizeofArray# a)++lengthSize :: Array a -> Size a+lengthSize (Array a) = Size $ I# (sizeofArray# a)++vFromList :: [a] -> Array a+vFromList l = runST (new len >>= loop 0 l)+  where+    len = Size $ C.length l+    loop _ []     ma = unsafeFreeze ma+    loop i (x:xs) ma = unsafeWrite ma i x >> loop (i+1) xs ma++vToList :: Array a -> [a]+vToList v = fmap (unsafeIndex v) [0..(length v - 1)]++-- | Append 2 arrays together by creating a new bigger array+append :: Array ty -> Array ty -> Array ty+append a b = runST $ do+    r  <- new (la+lb)+    ma <- unsafeThaw a+    mb <- unsafeThaw b+    copyAt r (Offset 0) ma (Offset 0) la+    copyAt r (sizeAsOffset la) mb (Offset 0) lb+    unsafeFreeze r+  where la = lengthSize a+        lb = lengthSize b++concat :: [Array ty] -> Array ty+concat l = runST $ do+    r <- new (Size $ Prelude.sum $ fmap length l)+    loop r (Offset 0) l+    unsafeFreeze r+  where loop _ _ []     = return ()+        loop r i (x:xs) = do+            mx <- unsafeThaw x+            copyAt r i mx (Offset 0) lx+            loop r (i `offsetPlusE` lx) xs+          where lx = lengthSize x++{-+modify :: PrimMonad m+       => Array a+       -> (MArray (PrimState m) a -> m ())+       -> m (Array a)+modify (Array a) f = primitive $ \st -> do+    case thawArray# a 0# (sizeofArray# a) st of+        (# st2, mv #) ->+            case internal_ (f $ MArray mv) st2 of+                st3 ->+                    case unsafeFreezeArray# mv st3 of+                        (# st4, a' #) -> (# st4, Array a' #)+-}++-----------------------------------------------------------------------+-- helpers++onNewArray :: PrimMonad m+           => Int+           -> (MutableArray# (PrimState m) a -> State# (PrimState m) -> State# (PrimState m))+           -> m (Array a)+onNewArray (I# len) f = primitive $ \st -> do+    case newArray# len (error "onArray") st of { (# st2, mv #) ->+    case f mv st2                           of { st3           ->+    case unsafeFreezeArray# mv st3          of { (# st4, a #)  ->+        (# st4, Array a #) }}}++-----------------------------------------------------------------------+++null :: Array ty -> Bool+null = (==) 0 . length++take ::  Int -> Array ty -> Array ty+take nbElems v+    | nbElems <= 0 = empty+    | otherwise    = runST $ do+        muv <- new n+        unsafeCopyAtRO muv (Offset 0) v (Offset 0) n+        unsafeFreeze muv+  where+    n = Size $ min nbElems (length v)++drop ::  Int -> Array ty -> Array ty+drop nbElems v+    | nbElems <= 0 = v+    | otherwise    = runST $ do+        muv <- new n+        unsafeCopyAtRO muv (Offset 0) v (Offset offset) n+        unsafeFreeze muv+  where+    offset = min nbElems (length v)+    n = Size (length v - offset)++splitAt ::  Int -> Array ty -> (Array ty, Array ty)+splitAt n v = (take n v, drop n v)++revTake :: Int -> Array ty -> Array ty+revTake nbElems v = drop (length v - nbElems) v++revDrop :: Int -> Array ty -> Array ty+revDrop nbElems v = take (length v - nbElems) v++revSplitAt :: Int -> Array ty -> (Array ty, Array ty)+revSplitAt n v = (drop idx v, take idx v)+  where idx = length v - n++splitOn ::  (ty -> Bool) -> Array ty -> [Array ty]+splitOn predicate vec+    | len == Size 0 = []+    | otherwise     = loop (Offset 0) (Offset 0)+  where+    !len = lengthSize vec+    !endIdx = Offset 0 `offsetPlusE` len+    loop prevIdx idx@(Offset i)+        | idx == endIdx = [runST $ sub vec prevIdx idx]+        | otherwise     =+            let e = unsafeIndex vec i+                idx' = idx + Offset 1+             in if predicate e+                    then runST (sub vec prevIdx idx) : loop idx' idx'+                    else loop prevIdx idx'++sub :: PrimMonad prim => Array ty -> Offset ty -> Offset ty -> prim (Array ty)+sub vec startIdx expectedEndIdx+    | startIdx == endIdx           = return empty+    | startIdx >= sizeAsOffset len = return empty+    | otherwise                    = new sz >>= loop startIdx (Offset 0)+  where+    !len = lengthSize vec+    loop os@(Offset s) od@(Offset d) mv+        | os == endIdx = unsafeFreeze mv+        | otherwise    = unsafeWrite mv d (unsafeIndex vec s) >> loop (os+Offset 1) (od+Offset 1) mv+    !sz  = endIdx - startIdx+    !endIdx = min expectedEndIdx (sizeAsOffset $ lengthSize vec)++break ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)+break predicate v = findBreak 0+  where+    findBreak i+        | i == length v = (v, empty)+        | otherwise     =+            if predicate (unsafeIndex v i)+                then splitAt i v+                else findBreak (i+1)++intersperse :: ty -> Array ty -> Array ty+intersperse sep v+    | len <= Size 1 = v+    | otherwise     = runST $ unsafeCopyFrom v ((len + len) - Size 1) (go (Offset 0 `offsetPlusE` (len - Size 1)) sep)+  where len = lengthSize v+        -- terminate 1 before the end++        go :: Offset ty -> ty -> Array ty -> Offset ty -> MArray ty s -> ST s ()+        go endI sep' oldV oldI@(Offset oi) newV+            | oldI == endI = unsafeWrite newV dst e+            | otherwise    = do+                unsafeWrite newV dst e+                unsafeWrite newV (dst + 1) sep'+          where+            e = unsafeIndex oldV oi+            (Offset dst) = oldI + oldI++span ::  (ty -> Bool) -> Array ty -> (Array ty, Array ty)+span p = break (not . p)++map :: (a -> b) -> Array a -> Array b+map f a = create (length a) (\i -> f $ unsafeIndex a i)++{-+mapIndex :: (Int -> a -> b) -> Array a -> Array b+mapIndex f a = create (length a) (\i -> f i $ unsafeIndex a i)+-}++cons ::  ty -> Array ty -> Array ty+cons e vec+    | len == Size 0 = C.singleton e+    | otherwise     = runST $ do+        mv <- new (len + Size 1)+        unsafeWrite mv 0 e+        unsafeCopyAtRO mv (Offset 1) vec (Offset 0) len+        unsafeFreeze mv+  where+    !len = lengthSize vec++snoc ::  Array ty -> ty -> Array ty+snoc vec e+    | len == Size 0 = C.singleton e+    | otherwise     = runST $ do+        mv <- new (len + Size 1)+        unsafeCopyAtRO mv (Offset 0) vec (Offset 0) len+        unsafeWrite mv lastI e+        unsafeFreeze mv+  where+    !len@(Size lastI) = lengthSize vec++uncons :: Array ty -> Maybe (ty, Array ty)+uncons vec+    | len == 0  = Nothing+    | otherwise = Just (unsafeIndex vec 0, drop 1 vec)+  where+    !len = length vec++unsnoc :: Array ty -> Maybe (Array ty, ty)+unsnoc vec+    | len == 0  = Nothing+    | otherwise = Just (take (len - 1) vec, unsafeIndex vec (len-1))+  where+    !len = length vec++find ::  (ty -> Bool) -> Array ty -> Maybe ty+find predicate vec = loop 0+  where+    !len = length vec+    loop i+        | i == len  = Nothing+        | otherwise =+            let e = unsafeIndex vec i+             in if predicate e then Just e else loop (i+1)++sortBy ::  (ty -> ty -> Ordering) -> Array ty -> Array ty+sortBy xford vec = runST (thaw vec >>= doSort xford)+  where+    len = length vec+    doSort :: PrimMonad prim => (ty -> ty -> Ordering) -> MArray ty (PrimState prim) -> prim (Array ty)+    doSort ford ma = qsort 0 (len - 1) >> unsafeFreeze ma+      where+        qsort lo hi+            | lo >= hi  = return ()+            | otherwise = do+                p <- partition lo hi+                qsort lo (p-1)+                qsort (p+1) hi+        partition lo hi = do+            pivot <- unsafeRead ma hi+            let loop i j+                    | j == hi   = return i+                    | otherwise = do+                        aj <- unsafeRead ma j+                        i' <- if ford aj pivot == GT+                                then return i+                                else do+                                    ai <- unsafeRead ma i+                                    unsafeWrite ma j ai+                                    unsafeWrite ma i aj+                                    return $ i + 1+                        loop i' (j+1)++            i <- loop lo lo+            ai  <- unsafeRead ma i+            ahi <- unsafeRead ma hi+            unsafeWrite ma hi ai+            unsafeWrite ma i ahi+            return i++filter :: (ty -> Bool) -> Array ty -> Array ty+filter predicate vec = runST (new len >>= copyFilterFreeze predicate (unsafeIndex vec))+  where+    !len = lengthSize vec+    !end = Offset 0 `offsetPlusE` len+    copyFilterFreeze :: PrimMonad prim => (ty -> Bool) -> (Int -> ty) -> MArray ty (PrimState prim) -> prim (Array ty)+    copyFilterFreeze predi getVec mvec = loop (Offset 0) (Offset 0) >>= freezeUntilIndex mvec+      where+        loop d@(Offset di) s@(Offset si)+            | s == end    = return d+            | predi v     = unsafeWrite mvec di v >> loop (d+Offset 1) (s+Offset 1)+            | otherwise   = loop d (s+Offset 1)+          where+            v = getVec si++freezeUntilIndex :: PrimMonad prim => MArray ty (PrimState prim) -> Offset ty -> prim (Array ty)+freezeUntilIndex mvec d = do+    m <- new (offsetAsSize d)+    copyAt m (Offset 0) mvec (Offset 0) (offsetAsSize d)+    unsafeFreeze m++reverse :: Array ty -> Array ty+reverse a = create len toEnd+  where+    len = length a+    toEnd i = unsafeIndex a (len - i - 1)
+ Foundation/Array/Common.hs view
@@ -0,0 +1,46 @@+-- |+-- Module      : Foundation.Array.Common+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Common part for vectors+--+{-# LANGUAGE DeriveDataTypeable #-}+module Foundation.Array.Common+    ( OutOfBound(..)+    , OutOfBoundOperation(..)++    , InvalidRecast(..)+    , RecastSourceSize(..)+    , RecastDestinationSize(..)+    ) where++import           Foundation.Internal.Base++-- | The type of operation that triggers an OutOfBound exception.+--+-- * OOB_Index: reading an immutable vector+-- * OOB_Read: reading a mutable vector+-- * OOB_Write: write a mutable vector+data OutOfBoundOperation = OOB_Read | OOB_Write | OOB_MemSet | OOB_Index+    deriving (Show,Eq,Typeable)++-- | Exception during an operation accessing the vector out of bound+--+-- Represent the type of operation, the index accessed, and the total length of the vector.+data OutOfBound = OutOfBound OutOfBoundOperation Int Int+    deriving (Show,Typeable)++instance Exception OutOfBound++newtype RecastSourceSize      = RecastSourceSize Int+    deriving (Show,Eq,Typeable)+newtype RecastDestinationSize = RecastDestinationSize Int+    deriving (Show,Eq,Typeable)++data InvalidRecast = InvalidRecast RecastSourceSize RecastDestinationSize+    deriving (Show,Typeable)++instance Exception InvalidRecast
+ Foundation/Array/Internal.hs view
@@ -0,0 +1,20 @@+-- |+-- Module      : Foundation.Array.Internal+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Give access to Array non public functions which+-- can be used to make certains optimisations.+--+-- Most of what is available here has no guarantees of stability.+-- Anything can be removed and changed.+--+module Foundation.Array.Internal+    ( UArray(..)+    , fromForeignPtr+    , recast+    ) where++import           Foundation.Array.Unboxed
+ Foundation/Array/Unboxed.hs view
@@ -0,0 +1,807 @@+-- |+-- Module      : Foundation.Array.Unboxed+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A simple array abstraction that allow to use typed+-- array of bytes where the array is pinned in memory+-- to allow easy use with Foreign interfaces, ByteString+-- and always aligned to 64 bytes.+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ViewPatterns #-}+module Foundation.Array.Unboxed+    ( UArray(..)+    , PrimType(..)+    -- * methods+    , copy+    , unsafeCopyAtRO+    -- * internal methods+    -- , copyAddr+    , recast+    , unsafeRecast+    , length+    , lengthSize+    , freeze+    , unsafeFreeze+    , thaw+    , unsafeThaw+    -- * Creation+    , new+    , empty+    , create+    , createFromIO+    , sub+    , withPtr+    , withMutablePtr+    , unsafeFreezeShrink+    , freezeShrink+    , unsafeSlide+    -- * accessors+    , update+    , unsafeUpdate+    , unsafeIndex+    , unsafeIndexer+    , unsafeRead+    , unsafeWrite+    -- * Functions+    , map+    , mapIndex+    , findIndex+    , index+    , null+    , take+    , drop+    , splitAt+    , revDrop+    , revTake+    , revSplitAt+    , splitOn+    , splitElem+    , break+    , breakElem+    , intersperse+    , span+    , cons+    , snoc+    , uncons+    , unsnoc+    , find+    , sortBy+    , filter+    , reverse+    , foldl+    , foldr+    , foldl'+    , foreignMem+    , fromForeignPtr+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.Word+import           GHC.ST+import           GHC.Ptr+import           GHC.ForeignPtr (ForeignPtr)+import qualified Prelude+import           Foundation.Internal.Base+import           Foundation.Internal.Primitive+import           Foundation.Internal.Proxy+import           Foundation.Internal.Types+import           Foundation.Primitive.Monad+import           Foundation.Primitive.Types+import           Foundation.Primitive.FinalPtr+import           Foundation.Primitive.Utils+import           Foundation.Array.Common+import           Foundation.Array.Unboxed.Mutable+import           Foundation.Number+import qualified Data.List++-- | An array of type built on top of GHC primitive.+--+-- The elements need to have fixed sized and the representation is a+-- packed contiguous array in memory that can easily be passed+-- to foreign interface+data UArray ty =+      UVecBA {-# UNPACK #-} !(Offset ty)+             {-# UNPACK #-} !(Size ty)+             {-# UNPACK #-} !PinnedStatus {- unpinned / pinned flag -}+                            ByteArray#+    | UVecAddr {-# UNPACK #-} !(Offset ty)+               {-# UNPACK #-} !(Size ty)+                              !(FinalPtr ty)++instance (PrimType ty, Show ty) => Show (UArray ty) where+    show v = show (toList v)+instance (PrimType ty, Eq ty) => Eq (UArray ty) where+    (==) = equal+instance (PrimType ty, Ord ty) => Ord (UArray ty) where+    compare = vCompare++instance PrimType ty => Monoid (UArray ty) where+    mempty  = empty+    mappend = append+    mconcat = concat++instance PrimType ty => IsList (UArray ty) where+    type Item (UArray ty) = ty+    fromList = vFromList+    toList = vToList++vectorProxyTy :: UArray ty -> Proxy ty+vectorProxyTy _ = Proxy++-- | Copy every cells of an existing array to a new array+copy :: PrimType ty => UArray ty -> UArray ty+copy array = runST (thaw array >>= unsafeFreeze)++-- | Thaw an array to a mutable array.+--+-- the array is not modified, instead a new mutable array is created+-- and every values is copied, before returning the mutable array.+thaw :: (PrimMonad prim, PrimType ty) => UArray ty -> prim (MUArray ty (PrimState prim))+thaw array = do+    ma <- new (lengthSize array)+    unsafeCopyAtRO ma azero array (Offset 0) (lengthSize array)+    return ma+{-# INLINE thaw #-}++-- | Return the element at a specific index from an array.+--+-- If the index @n is out of bounds, an error is raised.+index :: PrimType ty => UArray ty -> Int -> ty+index array n+    | n < 0 || n >= len = throw (OutOfBound OOB_Index n len)+    | otherwise         = unsafeIndex array n+  where len = length array+{-# INLINE index #-}++-- | Return the element at a specific index from an array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'index' if unsure.+unsafeIndex :: PrimType ty => UArray ty -> Int -> ty+unsafeIndex (UVecBA start _ _ ba) n = primBaIndex ba (start + Offset n)+unsafeIndex v@(UVecAddr start _ fptr) n = withUnsafeFinalPtr fptr (primAddrIndex' v start)+  where+    primAddrIndex' :: PrimType ty => UArray ty -> Offset ty -> Ptr a -> IO ty+    primAddrIndex' _ start' (Ptr addr) = return (primAddrIndex addr (start' + Offset n))+{-# INLINE unsafeIndex #-}++unsafeIndexer :: (PrimMonad prim, PrimType ty) => UArray ty -> ((Offset ty -> ty) -> prim a) -> prim a+unsafeIndexer (UVecBA start _ _ ba) f = f (\n -> primBaIndex ba (start + n))+unsafeIndexer (UVecAddr start _ fptr) f = withFinalPtr fptr (\ptr -> f (primAddrIndex' start ptr))+  where+    primAddrIndex' :: PrimType ty => Offset ty -> Ptr a -> (Offset ty -> ty)+    primAddrIndex' start' (Ptr addr) = \n -> primAddrIndex addr (start' + n)+    {-# INLINE primAddrIndex' #-}+{-# NOINLINE unsafeIndexer #-}++{-# SPECIALIZE [3] unsafeIndexer :: UArray Word8 -> ((Offset Word8 -> Word8) -> ST s a) -> ST s a #-}++foreignMem :: PrimType ty+           => FinalPtr ty -- ^ the start pointer with a finalizer+           -> Int         -- ^ the number of elements (in elements, not bytes)+           -> UArray ty+foreignMem fptr nb = UVecAddr (Offset 0) (Size nb) fptr++fromForeignPtr :: PrimType ty+               => (ForeignPtr ty, Int, Int) -- ForeignPtr, an offset in prim elements, a size in prim elements+               -> UArray ty+fromForeignPtr (fptr, ofs, len)   = UVecAddr (Offset ofs) (Size len) (toFinalPtrForeign fptr)++-- | return the number of elements of the array.+length :: PrimType ty => UArray ty -> Int+length a = let (Size len) = lengthSize a in len+{-# INLINE[1] length #-}++lengthSize :: PrimType ty => UArray ty -> Size ty+lengthSize (UVecAddr _ len _) = len+lengthSize (UVecBA _ len _ _) = len+{-# INLINE[1] lengthSize #-}++-- TODO Optimise with copyByteArray#+-- | Copy @n@ sequential elements from the specified offset in a source array+--   to the specified position in a destination array.+--+--   This function does not check bounds. Accessing invalid memory can return+--   unpredictable and invalid values.+unsafeCopyAtRO :: (PrimMonad prim, PrimType ty)+               => MUArray ty (PrimState prim) -- ^ destination array+               -> Offset ty                   -- ^ offset at destination+               -> UArray ty                   -- ^ source array+               -> Offset ty                   -- ^ offset at source+               -> Size ty                     -- ^ number of elements to copy+               -> prim ()+unsafeCopyAtRO (MUVecMA dstStart _ _ dstMba) ed uvec@(UVecBA srcStart _ _ srcBa) es n =+    primitive $ \st -> (# copyByteArray# srcBa os dstMba od nBytes st, () #)+  where+    sz = primSizeInBytes (vectorProxyTy uvec)+    !(Offset (I# os))   = offsetOfE sz (srcStart+es)+    !(Offset (I# od))   = offsetOfE sz (dstStart+ed)+    !(Size (I# nBytes)) = sizeOfE sz n+unsafeCopyAtRO (MUVecMA dstStart _ _ dstMba) ed uvec@(UVecAddr srcStart _ srcFptr) es n =+    withFinalPtr srcFptr $ \srcPtr ->+        let !(Ptr srcAddr) = srcPtr `plusPtr` os+         in primitive $ \s -> (# compatCopyAddrToByteArray# srcAddr dstMba od nBytes s, () #)+  where+    sz  = primSizeInBytes (vectorProxyTy uvec)+    !(Offset os)        = offsetOfE sz (srcStart+es)+    !(Offset (I# od))   = offsetOfE sz (dstStart+ed)+    !(Size (I# nBytes)) = sizeOfE sz n+unsafeCopyAtRO dst od src os n = loop od os+  where+    !(Offset endIndex) = os `offsetPlusE` n+    loop (Offset d) (Offset i)+        | i == endIndex = return ()+        | otherwise     = unsafeWrite dst d (unsafeIndex src i) >> loop (Offset $ d+1) (Offset $ i+1)++-- | Allocate a new array with a fill function that has access to the elements of+--   the source array.+unsafeCopyFrom :: PrimType ty+               => UArray ty -- ^ Source array+               -> Int -- ^ Length of the destination array+               -> (UArray ty -> Int -> MUArray ty s -> ST s ())+               -- ^ Function called for each element in the source array+               -> ST s (UArray ty) -- ^ Returns the filled new array+unsafeCopyFrom v' newLen f = new (Size newLen) >>= fill 0 f >>= unsafeFreeze+  where len = length v'+        fill i f' r'+            | i == len  = return r'+            | otherwise = do f' v' i r'+                             fill (i + 1) f' r'++-- | Freeze a mutable array into an array.+--+-- the MUArray must not be changed after freezing.+unsafeFreeze :: PrimMonad prim => MUArray ty (PrimState prim) -> prim (UArray ty)+unsafeFreeze (MUVecMA start len pinnedState mba) = primitive $ \s1 ->+    case unsafeFreezeByteArray# mba s1 of+        (# s2, ba #) -> (# s2, UVecBA start len pinnedState ba #)+unsafeFreeze (MUVecAddr start len fptr) = return $ UVecAddr start len fptr+{-# INLINE unsafeFreeze #-}++unsafeFreezeShrink :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> Size ty -> prim (UArray ty)+unsafeFreezeShrink (MUVecMA start _ pinnedState mba) n = unsafeFreeze (MUVecMA start n pinnedState mba)+unsafeFreezeShrink (MUVecAddr start _ fptr) n = unsafeFreeze (MUVecAddr start n fptr)++freeze :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> prim (UArray ty)+freeze ma = do+    ma' <- new len+    copyAt ma' (Offset 0) ma (Offset 0) len+    unsafeFreeze ma'+  where len = Size $ mutableLength ma++freezeShrink :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> Int -> prim (UArray ty)+freezeShrink ma n = do+    ma' <- new (Size n)+    copyAt ma' (Offset 0) ma (Offset 0) (Size n)+    unsafeFreeze ma'++unsafeSlide :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> Int -> Int -> prim ()+unsafeSlide mua s e = doSlide mua (Offset s) (Offset e)+  where+    doSlide :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> Offset ty -> Offset ty -> prim ()+    doSlide (MUVecMA mbStart _ _ mba) start end  =+        primMutableByteArraySlideToStart mba (primOffsetOfE $ mbStart+start) (primOffsetOfE end)+    doSlide (MUVecAddr mbStart _ fptr) start end = withFinalPtr fptr $ \(Ptr addr) ->+        primMutableAddrSlideToStart addr (primOffsetOfE $ mbStart+start) (primOffsetOfE end)++-- | Thaw an immutable array.+--+-- The UArray must not be used after thawing.+unsafeThaw :: (PrimType ty, PrimMonad prim) => UArray ty -> prim (MUArray ty (PrimState prim))+unsafeThaw (UVecBA start len pinnedState ba) = primitive $ \st -> (# st, MUVecMA start len pinnedState (unsafeCoerce# ba) #)+unsafeThaw (UVecAddr start len fptr) = return $ MUVecAddr start len fptr+{-# INLINE unsafeThaw #-}++-- | Create a new array of size @n by settings each cells through the+-- function @f.+create :: PrimType ty+       => Int         -- ^ the size of the array+       -> (Int -> ty) -- ^ the function that set the value at the index+       -> UArray ty  -- ^ the array created+create n initializer+    | n == 0    = empty+    | otherwise = runST (new (Size n) >>= iter initializer)+  where+    iter :: (PrimType ty, PrimMonad prim) => (Int -> ty) -> MUArray ty (PrimState prim) -> prim (UArray ty)+    iter f ma = loop 0+      where+        loop i+            | i == n    = unsafeFreeze ma+            | otherwise = unsafeWrite ma i (f i) >> loop (i+1)+        {-# INLINE loop #-}+    {-# INLINE iter #-}++-- | Create a pinned array that is filled by a 'filler' function (typically an IO call like hGetBuf)+createFromIO :: PrimType ty+             => Int                -- ^ the size of the array+             -> (Ptr ty -> IO Int) -- ^ filling function that+             -> IO (UArray ty)+createFromIO size filler+    | size == 0 = return empty+    | otherwise = do+        mba <- newPinned (Size size)+        r   <- withMutablePtr mba $ \p -> filler p+        case r of+            0             -> return empty -- make sure we don't keep our array referenced by using empty+            _ | r < 0     -> error "filler returned negative number"+              | otherwise -> unsafeFreezeShrink mba (Size r)++-----------------------------------------------------------------------+-- higher level collection implementation+-----------------------------------------------------------------------++empty :: PrimType ty => UArray ty+empty = UVecAddr (Offset 0) (Size 0) (FinalPtr $ error "empty de-referenced")++singleton :: PrimType ty => ty -> UArray ty+singleton ty = create 1 (\_ -> ty)++-- | make an array from a list of elements.+vFromList :: PrimType ty => [ty] -> UArray ty+vFromList l = runST $ do+    ma <- new (Size len)+    iter 0 l $ \i x -> unsafeWrite ma i x+    unsafeFreeze ma+  where len = Data.List.length l+        iter _ [] _ = return ()+        iter i (x:xs) z = z i x >> iter (i+1) xs z++-- | transform an array to a list.+vToList :: PrimType ty => UArray ty -> [ty]+vToList a+    | null a    = []+    | otherwise = runST (unsafeIndexer a go)+  where+    !len = length a+    go :: (Offset ty -> ty) -> ST s [ty]+    go getIdx = return $ loop azero+      where+        loop i | i == Offset len = []+               | otherwise        = getIdx i : loop (i+Offset 1)+    {-# INLINE go #-}++-- | Check if two vectors are identical+equal :: (PrimType ty, Eq ty) => UArray ty -> UArray ty -> Bool+equal a b+    | la /= lb  = False+    | otherwise = loop 0+  where+    !la = length a+    !lb = length b+    loop n | n == la    = True+           | otherwise = (unsafeIndex a n == unsafeIndex b n) && loop (n+1)++{-+sizeEqual :: PrimType ty => UArray ty -> UArray ty -> Bool+sizeEqual a b = length a == length b -- TODO optimise with direct comparaison of bytes or elements when possible+-}++-- | Compare 2 vectors+vCompare :: (Ord ty, PrimType ty) => UArray ty -> UArray ty -> Ordering+vCompare a b = loop 0+  where+    !la = length a+    !lb = length b+    loop n+        | n == la   = if la == lb then EQ else LT+        | n == lb   = GT+        | otherwise =+            case unsafeIndex a n `compare` unsafeIndex b n of+                EQ -> loop (n+1)+                r  -> r++-- | Append 2 arrays together by creating a new bigger array+append :: PrimType ty => UArray ty -> UArray ty -> UArray ty+append a b+    | la == azero = b+    | lb == azero = a+    | otherwise = runST $ do+        r  <- new (la+lb)+        ma <- unsafeThaw a+        mb <- unsafeThaw b+        copyAt r (Offset 0) ma (Offset 0) la+        copyAt r (sizeAsOffset la) mb (Offset 0) lb+        unsafeFreeze r+  where+    !la = lengthSize a+    !lb = lengthSize b++concat :: PrimType ty => [UArray ty] -> UArray ty+concat [] = empty+concat l  =+    case filterAndSum (Size 0) [] l of+        (_,[])            -> empty+        (_,[x])           -> x+        (totalLen,chunks) -> runST $ do+            r <- new totalLen+            doCopy r (Offset 0) chunks+            unsafeFreeze r+  where+    -- TODO would go faster not to reverse but pack from the end instead+    filterAndSum !totalLen acc []     = (totalLen, Prelude.reverse acc)+    filterAndSum !totalLen acc (x:xs)+        | len == Size 0 = filterAndSum totalLen acc xs+        | otherwise      = filterAndSum (len+totalLen) (x:acc) xs+      where len = lengthSize x++    doCopy _ _ []     = return ()+    doCopy r i (x:xs) = do+        unsafeCopyAtRO r i x (Offset 0) lx+        doCopy r (i `offsetPlusE` lx) xs+      where lx = lengthSize x++-- | update an array by creating a new array with the updates.+--+-- the operation copy the previous array, modify it in place, then freeze it.+update :: PrimType ty+       => UArray ty+       -> [(Int, ty)]+       -> UArray ty+update array modifiers = runST (thaw array >>= doUpdate modifiers)+  where doUpdate l ma = loop l+          where loop []         = unsafeFreeze ma+                loop ((i,v):xs) = write ma i v >> loop xs+                {-# INLINE loop #-}+        {-# INLINE doUpdate #-}++unsafeUpdate :: PrimType ty+             => UArray ty+             -> [(Int, ty)]+             -> UArray ty+unsafeUpdate array modifiers = runST (thaw array >>= doUpdate modifiers)+  where doUpdate l ma = loop l+          where loop []         = unsafeFreeze ma+                loop ((i,v):xs) = unsafeWrite ma i v >> loop xs+                {-# INLINE loop #-}+        {-# INLINE doUpdate #-}++withPtr :: PrimType ty+        => UArray ty+        -> (Ptr ty -> IO a)+        -> IO a+withPtr vec@(UVecAddr start _ fptr)  f =+    withFinalPtr fptr (\ptr -> f (ptr `plusPtr` os))+  where+    sz           = primSizeInBytes (vectorProxyTy vec)+    !(Offset os) = offsetOfE sz start+withPtr vec@(UVecBA start _ pstatus a) f+    | isPinned pstatus = f (Ptr (byteArrayContents# a) `plusPtr` os)+    | otherwise        = do+        -- TODO don't copy the whole vector, and just allocate+copy the slice.+        let !sz# = sizeofByteArray# a+        a' <- primitive $ \s -> do+            case newAlignedPinnedByteArray# sz# 8# s of { (# s2, mba #) ->+            case copyByteArray# a 0# mba 0# sz# s2 of { s3 ->+            case unsafeFreezeByteArray# mba s3 of { (# s4, ba #) ->+                (# s4, Ptr (byteArrayContents# ba) `plusPtr` os #) }}}+        f a'+  where+    sz           = primSizeInBytes (vectorProxyTy vec)+    !(Offset os) = offsetOfE sz start++withMutablePtr :: PrimType ty+               => MUArray ty RealWorld+               -> (Ptr ty -> IO a)+               -> IO a+withMutablePtr muvec f = do+    v <- unsafeFreeze muvec+    withPtr v f++recast :: (PrimType a, PrimType b) => UArray a -> UArray b+recast = recast_ Proxy Proxy+  where+    recast_ :: (PrimType a, PrimType b)+            => Proxy a -> Proxy b -> UArray a -> UArray b+    recast_ pa pb array+        | aTypeSize == bTypeSize = unsafeRecast array+        | missing   == 0         = unsafeRecast array+        | otherwise = throw $ InvalidRecast+                          (RecastSourceSize      alen)+                          (RecastDestinationSize $ alen + missing)+      where+        aTypeSize@(Size as) = primSizeInBytes pa+        bTypeSize@(Size bs) = primSizeInBytes pb+        alen = length array * as+        missing = alen `mod` bs++unsafeRecast :: (PrimType a, PrimType b) => UArray a -> UArray b+unsafeRecast (UVecBA start len pinStatus b) = UVecBA (primOffsetRecast start) (sizeRecast len) pinStatus b+unsafeRecast (UVecAddr start len a) = UVecAddr (primOffsetRecast start) (sizeRecast len) (castFinalPtr a)++null :: UArray ty -> Bool+null (UVecBA _ sz _ _) = sz == Size 0+null (UVecAddr _ l _)  = l == Size 0++take :: PrimType ty => Int -> UArray ty -> UArray ty+take nbElems v+    | nbElems <= 0 = empty+    | n == vlen    = v+    | otherwise    =+        case v of+            UVecBA start _ pinst ba -> UVecBA start n pinst ba+            UVecAddr start _ fptr   -> UVecAddr start n fptr+  where+    n = min (Size nbElems) vlen+    vlen = lengthSize v++drop :: PrimType ty => Int -> UArray ty -> UArray ty+drop nbElems v+    | nbElems <= 0 = v+    | n == vlen    = empty+    | otherwise    =+        case v of+            UVecBA start len pinst ba -> UVecBA (start `offsetPlusE` n) (len - n) pinst ba+            UVecAddr start len fptr   -> UVecAddr (start `offsetPlusE` n) (len - n) fptr+  where+    n = min (Size nbElems) vlen+    vlen = lengthSize v++splitAt :: PrimType ty => Int -> UArray ty -> (UArray ty, UArray ty)+splitAt nbElems v+    | nbElems <= 0   = (empty, v)+    | n == Size vlen = (v, empty)+    | otherwise      =+        case v of+            UVecBA start len pinst ba -> ( UVecBA start                   n         pinst ba+                                         , UVecBA (start `offsetPlusE` n) (len - n) pinst ba)+            UVecAddr start len fptr    -> ( UVecAddr start                   n         fptr+                                          , UVecAddr (start `offsetPlusE` n) (len - n) fptr)+  where+    n    = Size $ min nbElems vlen+    vlen = length v++splitElem :: PrimType ty => ty -> UArray ty -> (# UArray ty, UArray ty #)+splitElem !ty r@(UVecBA start len pinst ba)+    | k == end   = (# r, empty #)+    | k == start = (# empty, r #)+    | otherwise  =+        (# UVecBA start (offsetAsSize k) pinst ba+        ,  UVecBA (start `offsetPlusE` (offsetAsSize k)) (len - offsetAsSize k) pinst ba+        #)+  where+    !end = start `offsetPlusE` len+    !k = loop start+    loop !i | i < end && t /= ty = loop (i+Offset 1)+            | otherwise          = i+        where !t                 = primBaIndex ba i+splitElem ty r@(UVecAddr start len fptr)+    | k == end  = (# r, empty #)+    | otherwise =+        (# UVecAddr start (offsetAsSize k) fptr+        ,  UVecAddr (start `offsetPlusE` offsetAsSize k) (len - offsetAsSize k) fptr #)+  where+    !(Ptr addr) = withFinalPtrNoTouch fptr id+    !end = start `offsetPlusE` len+    !k = loop start+    loop !i | i < end && t /= ty = loop (i+Offset 1)+            | otherwise          = i+        where t                  = primAddrIndex addr i+{-# SPECIALIZE [3] splitElem :: Word8 -> UArray Word8 -> (# UArray Word8, UArray Word8 #) #-}+{-# SPECIALIZE [3] splitElem :: Word32 -> UArray Word32 -> (# UArray Word32, UArray Word32 #) #-}++revTake :: PrimType ty => Int -> UArray ty -> UArray ty+revTake nbElems v = drop (length v - nbElems) v++revDrop :: PrimType ty => Int -> UArray ty -> UArray ty+revDrop nbElems v = take (length v - nbElems) v++revSplitAt :: PrimType ty => Int -> UArray ty -> (UArray ty, UArray ty)+revSplitAt n v = (drop idx v, take idx v)+  where idx = length v - n++splitOn :: PrimType ty => (ty -> Bool) -> UArray ty -> [UArray ty]+splitOn xpredicate ivec+    | len == 0  = []+    | otherwise = runST $ unsafeIndexer ivec (go ivec xpredicate)+  where+    !len = length ivec+    go :: PrimType ty => UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> ST s [UArray ty]+    go v predicate getIdx = return (loop azero azero)+      where+        loop !prevIdx@(Offset prevIdxo) !idx@(Offset idxo)+            | idx == Offset len = [sub v prevIdxo idxo]+            | otherwise          =+                let e = getIdx idx+                    idx' = idx + Offset 1+                 in if predicate e+                        then sub v prevIdxo idxo : loop idx' idx'+                        else loop prevIdx idx'+    {-# INLINE go #-}++sub :: PrimType ty => UArray ty -> Int -> Int -> UArray ty+sub vec startIdx expectedEndIdx+    | startIdx >= endIdx = empty+    | otherwise          =+        case vec of+            UVecBA start _ pinst ba -> UVecBA (start + Offset startIdx) newLen pinst ba+            UVecAddr start _ fptr   -> UVecAddr (start + Offset startIdx) newLen fptr+  where+    newLen = Offset endIdx - Offset startIdx+    endIdx = min expectedEndIdx len+    len = length vec++findIndex :: PrimType ty => ty -> UArray ty -> Maybe Int+findIndex tyOuter ba = runST $ unsafeIndexer ba (go tyOuter)+  where+    !len = length ba++    go :: PrimType ty => ty -> (Offset ty -> ty) -> ST s (Maybe Int)+    go ty getIdx = loop (Offset 0)+      where+        loop ofs@(Offset i)+            | ofs == Offset len = return Nothing+            | getIdx ofs == ty  = return $ Just i+            | otherwise         = loop (ofs + Offset 1)+{-# SPECIALIZE [3] findIndex :: Word8 -> UArray Word8 -> Maybe Int #-}++break :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)+break xpredicate xv+    | len == 0  = (empty, empty)+    | otherwise = runST $ unsafeIndexer xv (go xv xpredicate)+  where+    !len = length xv+    go :: PrimType ty => UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> ST s (UArray ty, UArray ty)+    go v predicate getIdx = return (findBreak $ Offset 0)+      where+        findBreak !i@(Offset io)+            | i == Offset len     = (v, empty)+            | predicate (getIdx i) = splitAt io v+            | otherwise            = findBreak (i + Offset 1)+        {-# INLINE findBreak #-}+    {-# INLINE go #-}+{-# NOINLINE [2] break #-}+{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> UArray Word8 -> (UArray Word8, UArray Word8) #-}++{-# RULES "break (== ty)" [3] forall (x :: forall ty . PrimType ty => ty) . break (== x) = breakElem x #-}+{-# RULES "break (ty ==)" [3] forall (x :: forall ty . PrimType ty => ty) . break (x ==) = breakElem x #-}+{-# RULES "break (== ty)" [3] forall (x :: Word8) . break (== x) = breakElem x #-}++breakElem :: PrimType ty => ty -> UArray ty -> (UArray ty, UArray ty)+breakElem xelem xv = let (# v1, v2 #) = splitElem xelem xv in (v1, v2)+{-# SPECIALIZE [2] breakElem :: Word8 -> UArray Word8 -> (UArray Word8, UArray Word8) #-}+{-# SPECIALIZE [2] breakElem :: Word32 -> UArray Word32 -> (UArray Word32, UArray Word32) #-}++intersperse :: PrimType ty => ty -> UArray ty -> UArray ty+intersperse sep v+    | len <= 1  = v+    | otherwise = runST $ unsafeCopyFrom v (len * 2 - 1) (go sep)+  where len = length v+        go :: PrimType ty => ty -> UArray ty -> Int -> MUArray ty s -> ST s ()+        go sep' oldV oldI newV+            | oldI == len - 1 = unsafeWrite newV newI e+            | otherwise       = do+                unsafeWrite newV newI e+                unsafeWrite newV (newI + 1) sep'+          where+            e = unsafeIndex oldV oldI+            newI = oldI * 2++span :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)+span p = break (not . p)++map :: (PrimType a, PrimType b) => (a -> b) -> UArray a -> UArray b+map f a = create (length a) (\i -> f $ unsafeIndex a i)++mapIndex :: (PrimType a, PrimType b) => (Int -> a -> b) -> UArray a -> UArray b+mapIndex f a = create (length a) (\i -> f i $ unsafeIndex a i)++cons :: PrimType ty => ty -> UArray ty -> UArray ty+cons e vec+    | len == Size 0 = singleton e+    | otherwise     = runST $ do+        muv <- new (len + Size 1)+        unsafeCopyAtRO muv (Offset 1) vec (Offset 0) len+        unsafeWrite muv 0 e+        unsafeFreeze muv+  where+    !len = lengthSize vec++snoc :: PrimType ty => UArray ty -> ty -> UArray ty+snoc vec e+    | len == Size 0 = singleton e+    | otherwise     = runST $ do+        muv <- new (len + Size 1)+        unsafeCopyAtRO muv (Offset 0) vec (Offset 0) len+        unsafeWrite muv (length vec) e+        unsafeFreeze muv+  where+     !len = lengthSize vec++uncons :: PrimType ty => UArray ty -> Maybe (ty, UArray ty)+uncons vec+    | nbElems == 0 = Nothing+    | otherwise    = Just (unsafeIndex vec 0, sub vec 1 nbElems)+  where+    !nbElems = length vec++unsnoc :: PrimType ty => UArray ty -> Maybe (UArray ty, ty)+unsnoc vec+    | nbElems == 0 = Nothing+    | otherwise    = Just (sub vec 0 lastElem, unsafeIndex vec lastElem)+  where+    !lastElem = nbElems - 1+    !nbElems = length vec++find :: PrimType ty => (ty -> Bool) -> UArray ty -> Maybe ty+find predicate vec = loop 0+  where+    !len = length vec+    loop i+        | i == len  = Nothing+        | otherwise =+            let e = unsafeIndex vec i+             in if predicate e then Just e else loop (i+1)++sortBy :: PrimType ty => (ty -> ty -> Ordering) -> UArray ty -> UArray ty+sortBy xford vec = runST (thaw vec >>= doSort xford)+  where+    len = length vec+    doSort :: (PrimType ty, PrimMonad prim) => (ty -> ty -> Ordering) -> MUArray ty (PrimState prim) -> prim (UArray ty)+    doSort ford ma = qsort 0 (len - 1) >> unsafeFreeze ma+      where+        qsort lo hi+            | lo >= hi  = return ()+            | otherwise = do+                p <- partition lo hi+                qsort lo (p-1)+                qsort (p+1) hi+        partition lo hi = do+            pivot <- unsafeRead ma hi+            let loop i j+                    | j == hi   = return i+                    | otherwise = do+                        aj <- unsafeRead ma j+                        i' <- if ford aj pivot == GT+                                then return i+                                else do+                                    ai <- unsafeRead ma i+                                    unsafeWrite ma j ai+                                    unsafeWrite ma i aj+                                    return $ i + 1+                        loop i' (j+1)++            i <- loop lo lo+            ai  <- unsafeRead ma i+            ahi <- unsafeRead ma hi+            unsafeWrite ma hi ai+            unsafeWrite ma i ahi+            return i++filter :: PrimType ty => (ty -> Bool) -> UArray ty -> UArray ty+filter predicate vec = vFromList $ Data.List.filter predicate $ vToList vec++reverse :: PrimType ty => UArray ty -> UArray ty+reverse a = create len toEnd+  where+    len = length a+    toEnd i = unsafeIndex a (len - i - 1)++foldl :: PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a+foldl f initialAcc vec = loop 0 initialAcc+  where+    len = length vec+    loop i acc+        | i == len  = acc+        | otherwise = loop (i+1) (f acc (unsafeIndex vec i))++foldr :: PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a+foldr f initialAcc vec = loop 0+  where+    len = length vec+    loop i+        | i == len  = initialAcc+        | otherwise = unsafeIndex vec i `f` loop (i+1)++foldl' :: PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a+foldl' f initialAcc vec = loop 0 initialAcc+  where+    len = length vec+    loop i !acc+        | i == len  = acc+        | otherwise = loop (i+1) (f acc (unsafeIndex vec i))
+ Foundation/Array/Unboxed/Builder.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Foundation.Array.Unboxed.Builder+    ( ArrayBuilder+    , appendTy+    , build+    ) where++import           Foundation.Array.Unboxed+import           Foundation.Array.Unboxed.Mutable+import           Foundation.Internal.Base+import           Foundation.Internal.MonadTrans+import           Foundation.Internal.Types+import           Foundation.Number+import           Foundation.Primitive.Monad+import           Foundation.Primitive.Types+import qualified Data.List++-- | A Array being built chunks by chunks+--+-- The previous buffers are in reverse order, and+-- this contains the current buffer and the state of+-- progress packing ty inside.+data ArrayBuildingState ty st = ArrayBuildingState+    { prevBuffers   :: [UArray ty]+    , currentBuffer :: MUArray ty st+    , currentOffset :: !(Offset ty)+    , chunkSize     :: !(Size ty)+    }++newtype ArrayBuilder ty st a = ArrayBuilder { runArrayBuilder :: State (ArrayBuildingState ty (PrimState st)) st a }+    deriving (Functor,Applicative,Monad)++appendTy :: (PrimMonad st, PrimType ty, Monad st) => ty -> ArrayBuilder ty st ()+appendTy v = ArrayBuilder $ State $ \st ->+    if offsetAsSize (currentOffset st) == chunkSize st+        then do+            newChunk <- new (chunkSize st)+            cur <- unsafeFreeze (currentBuffer st)+            write newChunk 0 v+            return ((), st { prevBuffers   = cur : prevBuffers st+                           , currentOffset = Offset 1+                           , currentBuffer = newChunk+                           })+        else do+            let (Offset ofs) = currentOffset st+            write (currentBuffer st) ofs v+            return ((), st { currentOffset = currentOffset st + Offset 1 })++build :: (PrimMonad prim, PrimType ty)+      => Int                     -- ^ size of chunks (elements)+      -> ArrayBuilder ty prim () -- ^ ..+      -> prim (UArray ty)+build sizeChunksI origab = call origab (Size sizeChunksI)+  where+    call :: (PrimType ty, PrimMonad prim)+         => ArrayBuilder ty prim () -> Size ty -> prim (UArray ty)+    call ab sizeChunks = do+        m        <- new sizeChunks+        ((), st) <- runState (runArrayBuilder ab) (ArrayBuildingState [] m (Offset 0) sizeChunks)+        current <- unsafeFreezeShrink (currentBuffer st) (offsetAsSize $ currentOffset st)+        return $ mconcat $ Data.List.reverse (current:prevBuffers st)
+ Foundation/Array/Unboxed/ByteArray.hs view
@@ -0,0 +1,37 @@+module Foundation.Array.Unboxed.ByteArray+    ( MutableByteArray+    , mutableByteArraySet+    , mutableByteArraySetBetween+    , mutableByteArrayMove+    ) where++import Foundation.Internal.Base+import Foundation.Primitive.Monad+import Foundation.Array.Common+import Foundation.Array.Unboxed.Mutable+import Foundation.Number+import Control.Monad (forM_)+import qualified Foundation.Collection as C++-- | Mutable Byte Array alias+type MutableByteArray st = MUArray Word8 st++mutableByteArraySet :: PrimMonad prim => MUArray Word8 (PrimState prim) -> Word8 -> prim ()+mutableByteArraySet mba val = do+    -- naive haskell way. TODO: call memset or a 32-bit/64-bit method+    forM_ [0..(len-1)] $ \i -> C.mutUnsafeWrite mba i val+  where+    len = mutableLength mba++mutableByteArraySetBetween :: PrimMonad prim => MUArray Word8 (PrimState prim) -> Word8 -> Int -> Int -> prim ()+mutableByteArraySetBetween mba val offset size+    | offset < 0                        = throw (OutOfBound OOB_MemSet offset len)+    | offset > len || offset+size > len = throw (OutOfBound OOB_MemSet (offset+size) len)+    | otherwise =+        -- TODO same as mutableByteArraySet+        forM_ [offset..(offset+size-1)] $ \i -> C.mutUnsafeWrite mba i val+  where+    len = mutableLength mba++mutableByteArrayMove :: PrimMonad prim => MUArray Word8 (PrimState prim) -> Int -> Int -> Int -> prim ()+mutableByteArrayMove _mba _ofs _sz = undefined
+ Foundation/Array/Unboxed/Mutable.hs view
@@ -0,0 +1,212 @@+-- |+-- Module      : Foundation.Array.Unboxed.Mutable+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A simple array abstraction that allow to use typed+-- array of bytes where the array is pinned in memory+-- to allow easy use with Foreign interfaces, ByteString+-- and always aligned to 64 bytes.+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+module Foundation.Array.Unboxed.Mutable+    ( MUArray(..)+    -- * Property queries+    , sizeInMutableBytesOfContent+    , mutableLength+    , mutableSame+    -- * Allocation & Copy+    , new+    , newPinned+    , newNative+    , mutableForeignMem+    , copyAt+    -- , copyAddr+    -- * Reading and Writing cells+    , unsafeWrite+    , unsafeRead+    , write+    , read+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.Ptr+import           Foundation.Internal.Base+import           Foundation.Internal.Types+import           Foundation.Internal.Primitive+import           Foundation.Internal.Proxy+import           Foundation.Primitive.Monad+import           Foundation.Primitive.Types+import           Foundation.Primitive.FinalPtr+import           Foundation.Array.Common+import           Foundation.Number+-- import           Foreign.Marshal.Utils (copyBytes)++-- | A Mutable array of types built on top of GHC primitive.+--+-- Element in this array can be modified in place.+data MUArray ty st =+      MUVecMA {-# UNPACK #-} !(Offset ty)+              {-# UNPACK #-} !(Size ty)+              {-# UNPACK #-} !PinnedStatus+                             (MutableByteArray# st)+    | MUVecAddr {-# UNPACK #-} !(Offset ty)+                {-# UNPACK #-} !(Size ty)+                               !(FinalPtr ty)++mutableArrayProxyTy :: MUArray ty st -> Proxy ty+mutableArrayProxyTy _ = Proxy++sizeInMutableBytesOfContent :: PrimType ty => MUArray ty s -> Size8+sizeInMutableBytesOfContent = primSizeInBytes . mutableArrayProxyTy+{-# INLINE sizeInMutableBytesOfContent #-}++-- | read a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+read :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Int -> prim ty+read array n+    | n < 0 || n >= len = primThrow (OutOfBound OOB_Read n len)+    | otherwise         = unsafeRead array n+  where len = mutableLength array+{-# INLINE read #-}++-- | read from a cell in a mutable array without bounds checking.+--+-- Reading from invalid memory can return unpredictable and invalid values.+-- use 'read' if unsure.+unsafeRead :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Int -> prim ty+unsafeRead (MUVecMA start _ _ mba) i = primMbaRead mba (start+.i)+unsafeRead (MUVecAddr start _ fptr) i = withFinalPtr fptr $ \(Ptr addr) -> primAddrRead addr (start+.i)+{-# INLINE unsafeRead #-}++-- | Write to a cell in a mutable array.+--+-- If the index is out of bounds, an error is raised.+write :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Int -> ty -> prim ()+write array n val+    | n < 0 || n >= len = primThrow (OutOfBound OOB_Write n len)+    | otherwise         = unsafeWrite array n val+  where+    len = mutableLength array+{-# INLINE write #-}++-- | write to a cell in a mutable array without bounds checking.+--+-- Writing with invalid bounds will corrupt memory and your program will+-- become unreliable. use 'write' if unsure.+unsafeWrite :: (PrimMonad prim, PrimType ty) => MUArray ty (PrimState prim) -> Int -> ty -> prim ()+unsafeWrite (MUVecMA start _ _ mba)  i v = primMbaWrite mba (start+.i) v+unsafeWrite (MUVecAddr start _ fptr) i v = withFinalPtr fptr $ \(Ptr addr) -> primAddrWrite addr (start+.i) v+{-# INLINE unsafeWrite #-}++-- | Create a new pinned mutable array of size @n.+--+-- all the cells are uninitialized and could contains invalid values.+--+-- All mutable arrays are allocated on a 64 bits aligned addresses+newPinned :: (PrimMonad prim, PrimType ty) => Size ty -> prim (MUArray ty (PrimState prim))+newPinned n = newFake n Proxy+  where newFake :: (PrimMonad prim, PrimType ty) => Size ty -> Proxy ty -> prim (MUArray ty (PrimState prim))+        newFake sz ty = primitive $ \s1 ->+            case newAlignedPinnedByteArray# bytes 8# s1 of+                (# s2, mba #) -> (# s2, MUVecMA (Offset 0) sz pinned mba #)+          where+                !(Size (I# bytes)) = sizeOfE (primSizeInBytes ty) sz+        {-# INLINE newFake #-}+{-# INLINE new #-}++newUnpinned :: (PrimMonad prim, PrimType ty) => Size ty -> prim (MUArray ty (PrimState prim))+newUnpinned n = newFake n Proxy+  where newFake :: (PrimMonad prim, PrimType ty) => Size ty -> Proxy ty -> prim (MUArray ty (PrimState prim))+        newFake sz ty = primitive $ \s1 ->+            case newByteArray# bytes s1 of+                (# s2, mba #) -> (# s2, MUVecMA (Offset 0) sz unpinned mba #)+          where+                !(Size (I# bytes)) = sizeOfE (primSizeInBytes ty) sz+        {-# INLINE newFake #-}++-- | Create a new mutable array of size @n.+--+-- TODO: heuristic to allocated unpinned (< 1K for example)+new :: (PrimMonad prim, PrimType ty) => Size ty -> prim (MUArray ty (PrimState prim))+new sz@(Size n)+    | n > 0     = newPinned sz+    | otherwise = newUnpinned sz+++mutableSame :: MUArray ty st -> MUArray ty st -> Bool+mutableSame (MUVecMA sa ea _ ma) (MUVecMA sb eb _ mb) = and [ sa == sb, ea == eb, bool# (sameMutableByteArray# ma mb)]+mutableSame (MUVecAddr s1 e1 f1) (MUVecAddr s2 e2 f2) = and [ s1 == s2, e1 == e2, finalPtrSameMemory f1 f2 ]+mutableSame (MUVecMA {})     (MUVecAddr {})   = False+mutableSame (MUVecAddr {})   (MUVecMA {})     = False+++newNative :: (PrimMonad prim, PrimType ty) => Size ty -> (MutableByteArray# (PrimState prim) -> prim ()) -> prim (MUArray ty (PrimState prim))+newNative n f = do+    muvec <- new n+    case muvec of+        (MUVecMA _ _ _ mba) -> f mba >> return muvec+        (MUVecAddr {})      -> error "internal error: unboxed new only supposed to allocate natively"++mutableForeignMem :: (PrimMonad prim, PrimType ty)+                  => FinalPtr ty -- ^ the start pointer with a finalizer+                  -> Int         -- ^ the number of elements (in elements, not bytes)+                  -> prim (MUArray ty (PrimState prim))+mutableForeignMem fptr nb = return $ MUVecAddr (Offset 0) (Size nb) fptr++-- | Copy a number of elements from an array to another array with offsets+copyAt :: (PrimMonad prim, PrimType ty)+       => MUArray ty (PrimState prim) -- ^ destination array+       -> Offset ty                  -- ^ offset at destination+       -> MUArray ty (PrimState prim) -- ^ source array+       -> Offset ty                  -- ^ offset at source+       -> Size ty                    -- ^ number of elements to copy+       -> prim ()+copyAt (MUVecMA dstStart _ _ dstMba) ed uvec@(MUVecMA srcStart _ _ srcBa) es n =+    primitive $ \st -> (# copyMutableByteArray# srcBa os dstMba od nBytes st, () #)+  where+    !sz                 = primSizeInBytes (mutableArrayProxyTy uvec)+    !(Offset (I# os))   = offsetOfE sz (srcStart + es)+    !(Offset (I# od))   = offsetOfE sz (dstStart + ed)+    !(Size (I# nBytes)) = sizeOfE sz n+copyAt (MUVecMA dstStart _ _ dstMba) ed muvec@(MUVecAddr srcStart _ srcFptr) es n =+    withFinalPtr srcFptr $ \srcPtr ->+        let !(Ptr srcAddr) = srcPtr `plusPtr` os+         in primitive $ \s -> (# compatCopyAddrToByteArray# srcAddr dstMba od nBytes s, () #)+  where+    !sz                 = primSizeInBytes (mutableArrayProxyTy muvec)+    !(Offset os)        = offsetOfE sz (srcStart + es)+    !(Offset (I# od))   = offsetOfE sz (dstStart + ed)+    !(Size (I# nBytes)) = sizeOfE sz n+copyAt dst od src os n = loop od os+  where+    !(Offset endIndex) = os `offsetPlusE` n+    loop !(Offset d) !(Offset i)+        | i == endIndex = return ()+        | otherwise     = unsafeRead src i >>= unsafeWrite dst d >> loop (Offset $ d+1) (Offset $ i+1)++{-+copyAddr :: (PrimMonad prim, PrimType ty)+         => MUArray ty (PrimState prim) -- ^ destination array+         -> Offset ty                  -- ^ offset at destination+         -> Ptr Word8                   -- ^ source ptr+         -> Offset ty                  -- ^ offset at source+         -> Size ty                    -- ^ number of elements to copy+         -> prim ()+copyAddr (MUVecMA dstStart _ _ dst) dstOfs (Ptr src) srcOfs sz = primitive $ \s ->+    (# compatCopyAddrToByteArray# (plusAddr# src os) dst od sz s, () #)+copyAddr (MUVecAddr start _ fptr) od src os sz =+    withFinalPtr fptr $ \dst ->+        unsafePrimFromIO $ copyBytes (dst `plusPtr` od) (src `plusPtr` os) sz+        --memcpy addr to addr+        -}++-- | return the numbers of elements in a mutable array+mutableLength :: PrimType ty => MUArray ty st -> Int+mutableLength (MUVecMA _ (Size end) _ _) = end+mutableLength (MUVecAddr _ (Size end) _) = end
+ Foundation/Collection.hs view
@@ -0,0 +1,32 @@+-- |+-- Module      : Foundation.Collection+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Different collections (list, vector, string, ..) unified under 1 API.+-- an API to rules them all, and in the darkness bind them.+--+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+module Foundation.Collection+    ( BoxedZippable(..)+    , Element+    , InnerFunctor(..)+    , Foldable(..)+    , Sequential(..)+    , MutableCollection(..)+    , IndexedCollection(..)+    , KeyedCollection(..)+    , Zippable(..)+    ) where++import           Foundation.Collection.Element+import           Foundation.Collection.Foldable+import           Foundation.Collection.Indexed+import           Foundation.Collection.InnerFunctor+import           Foundation.Collection.Keyed+import           Foundation.Collection.Mutable+import           Foundation.Collection.Sequential+import           Foundation.Collection.Zippable
+ Foundation/Collection/Element.hs view
@@ -0,0 +1,17 @@+-- |+-- Module      : Foundation.Array.Element+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.Collection.Element+    ( Element+    ) where++import Foundation.Array.Unboxed (UArray)++-- | Element type of a collection+type family Element container+type instance Element [a] = a+type instance Element (UArray ty) = ty
+ Foundation/Collection/Foldable.hs view
@@ -0,0 +1,56 @@+-- |+-- Module      : Foundation.Primitive.Foldable+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A mono-morphic re-thinking of the Foldable class+--+module Foundation.Collection.Foldable+    ( Foldable(..)+    ) where++import           Foundation.Internal.Base+import           Foundation.Collection.Element+import qualified Data.List+import qualified Foundation.Array.Unboxed as UV++-- | Give the ability to fold a collection on itself+class Foldable collection where+    -- | Left-associative fold of a structure.+    --+    -- In the case of lists, foldl, when applied to a binary operator, a starting value (typically the left-identity of the operator), and a list, reduces the list using the binary operator, from left to right:+    --+    -- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+    -- Note that to produce the outermost application of the operator the entire input list must be traversed. This means that foldl' will diverge if given an infinite list.+    --+    -- Also note that if you want an efficient left-fold, you probably want to use foldl' instead of foldl. The reason for this is that latter does not force the "inner" results (e.g. z f x1 in the above example) before applying them to the operator (e.g. to (f x2)). This results in a thunk chain O(n) elements long, which then must be evaluated from the outside-in.+    foldl :: (a -> Element collection -> a) -> a -> collection -> a+++    -- | Left-associative fold of a structure but with strict application of the operator.+    foldl' :: (a -> Element collection -> a) -> a -> collection -> a++    -- | Right-associative fold of a structure.+    --+    -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)+    foldr :: (Element collection -> a -> a) -> a -> collection -> a++    -- | Right-associative fold of a structure, but with strict application of the operator.+    foldr' :: (Element collection -> a -> a) -> a -> collection -> a+    foldr' f z0 xs = foldl f' id xs z0 where f' k x z = k $! f x z++----------------------------+-- Foldable instances+----------------------------++instance Foldable [a] where+    foldl = Data.List.foldl+    foldr = Data.List.foldr+    foldl' = Data.List.foldl'++instance UV.PrimType ty => Foldable (UV.UArray ty) where+    foldl = UV.foldl+    foldr = UV.foldr+    foldl' = UV.foldl'
+ Foundation/Collection/Indexed.hs view
@@ -0,0 +1,42 @@+-- |+-- Module      : Foundation.Array.Indexed+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+module Foundation.Collection.Indexed+    ( IndexedCollection(..)+    ) where++import           Foundation.Internal.Base+import           Foundation.Collection.Element+import qualified Data.List+import qualified Foundation.Array.Unboxed as UV++-- | Collection of elements that can indexed by int+class IndexedCollection c where+    (!) :: c -> Int -> Maybe (Element c)+    findIndex :: (Element c -> Bool) -> c -> Maybe Int++instance IndexedCollection [a] where+    (!) l n+        | n < 0     = Nothing+        | otherwise = case Data.List.drop n l of+                        []  -> Nothing+                        x:_ -> Just x+    findIndex = Data.List.findIndex++instance UV.PrimType ty => IndexedCollection (UV.UArray ty) where+    (!) l n+        | n < 0 || n >= UV.length l = Nothing+        | otherwise                 = Just $ UV.index l n+    findIndex predicate c = loop 0+      where+        !len = UV.length c+        loop i+            | i == len                       = Nothing+            | predicate (UV.unsafeIndex c i) = Just i+            | otherwise                      = Nothing
+ Foundation/Collection/InnerFunctor.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DefaultSignatures #-}+module Foundation.Collection.InnerFunctor+    ( InnerFunctor(..)+    ) where++import Foundation.Internal.Base+import Foundation.Collection.Element+import qualified Foundation.Array.Unboxed as UV++-- | A monomorphic functor that maps the inner values to values of the same type+class InnerFunctor c where+    imap :: (Element c -> Element c) -> c -> c+    default imap :: (Functor f, Element (f a) ~ a, f a ~ c) => (a -> a) -> f a -> f a+    imap = fmap++instance InnerFunctor [a]++instance UV.PrimType ty => InnerFunctor (UV.UArray ty) where+    imap = UV.map
+ Foundation/Collection/Keyed.hs view
@@ -0,0 +1,26 @@+-- |+-- Module      : Foundation.Array.Keyed+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+module Foundation.Collection.Keyed+    ( KeyedCollection(..)+    ) where++import           Foundation.Internal.Base+import qualified Data.List++-- | Collection of things that can be looked up by Key+class KeyedCollection c where+    type Key c+    type Value c+    lookup :: Key c -> c -> Maybe (Value c)++instance Eq k => KeyedCollection [(k, v)] where+    type Key [(k,v)] = k+    type Value [(k,v)] = v+    lookup = Data.List.lookup
+ Foundation/Collection/List.hs view
@@ -0,0 +1,60 @@+-- |+-- Module      : Foundation.Array.List+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.Collection.List+    ( wordsWhen+    , revTake+    , revDrop+    , revSplitAt+    , uncons+    , unsnoc+    ) where++import qualified Data.List+import           Data.Tuple (swap)+import           Foundation.Internal.Base+import           Foundation.Number++-- | Simple helper to split a list repeatly when the predicate match+wordsWhen     :: (x -> Bool) -> [x] -> [[x]]+wordsWhen _ [] = []+wordsWhen p is = loop is+  where+    loop s =+        let (w, s') = Data.List.break p s+         in case s' of+                []   -> [w]+                _:xs -> w : loop xs++revTake :: Int -> [a] -> [a]+revTake n l = Data.List.drop (len - n) l+  where+    len = Data.List.length l++revDrop :: Int -> [a] -> [a]+revDrop n l = Data.List.take (len - n) l+  where+    len = Data.List.length l++revSplitAt :: Int -> [a] -> ([a],[a])+revSplitAt n l = swap $ Data.List.splitAt (len - n) l+  where+    len = Data.List.length l++uncons :: [a] -> Maybe (a, [a])+uncons []     = Nothing+uncons (x:xs) = Just (x,xs)++unsnoc :: [a] -> Maybe ([a], a)+unsnoc []       = Nothing+unsnoc [x]      = Just ([], x)+unsnoc [x,y]    = Just ([x], y)+unsnoc (x:xs@(_:_)) = Just $ loop [x] xs+  where+    loop acc [y]    = (Data.List.reverse acc, y)+    loop acc (y:ys) = loop (y:acc) ys+    loop _   _      = error "impossible"
+ Foundation/Collection/Mutable.hs view
@@ -0,0 +1,52 @@+-- |+-- Module      : Foundation.Array.Mutable+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.Collection.Mutable+    ( MutableCollection(..)+    ) where++import Foundation.Primitive.Monad+import Foundation.Internal.Base++import qualified Foundation.Array.Unboxed.Mutable as MUV+import qualified Foundation.Array.Unboxed as UV++-- | Collection of things that can be made mutable, modified and then freezed into an immutable collection+class MutableCollection c where+    -- unfortunately: cannot set mutUnsafeWrite to default to mutWrite .. same for read..+    {-# MINIMAL thaw, freeze, mutWrite, mutRead, mutUnsafeWrite, mutUnsafeRead #-}+    type Collection c+    type MutableKey c+    type MutableValue c++    unsafeThaw   :: PrimMonad prim => Collection c -> prim (c (PrimState prim))+    unsafeThaw = thaw+    unsafeFreeze :: PrimMonad prim => c (PrimState prim) -> prim (Collection c)+    unsafeFreeze = freeze++    thaw   :: PrimMonad prim => Collection c -> prim (c (PrimState prim))+    freeze :: PrimMonad prim => c (PrimState prim) -> prim (Collection c)++    mutUnsafeWrite :: PrimMonad prim => c (PrimState prim) -> MutableKey c -> MutableValue c -> prim ()+    mutWrite       :: PrimMonad prim => c (PrimState prim) -> MutableKey c -> MutableValue c -> prim ()+    mutUnsafeRead :: PrimMonad prim => c (PrimState prim) -> MutableKey c -> prim (MutableValue c)+    mutRead       :: PrimMonad prim => c (PrimState prim) -> MutableKey c -> prim (MutableValue c)++instance UV.PrimType ty => MutableCollection (MUV.MUArray ty) where+    type Collection (MUV.MUArray ty) = UV.UArray ty+    type MutableKey (MUV.MUArray ty) = Int+    type MutableValue (MUV.MUArray ty) = ty++    thaw = UV.thaw+    freeze = UV.freeze+    unsafeThaw = UV.unsafeThaw+    unsafeFreeze = UV.unsafeFreeze++    mutUnsafeWrite = MUV.unsafeWrite+    mutUnsafeRead = MUV.unsafeRead+    mutWrite = MUV.write+    mutRead = MUV.read
+ Foundation/Collection/Sequential.hs view
@@ -0,0 +1,171 @@+-- |+-- Module      : Foundation.Collection.Sequential+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Different collections (list, vector, string, ..) unified under 1 API.+-- an API to rules them all, and in the darkness bind them.+--+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ConstrainedClassMethods #-}+module Foundation.Collection.Sequential+    ( Sequential(..)+    ) where++import           Foundation.Internal.Base+import           Foundation.Collection.Element+import qualified Foundation.Collection.List as ListExtra+import qualified Data.List+import qualified Foundation.Array.Unboxed as UV++-- | A set of methods for ordered colection+class (IsList c, Item c ~ Element c, Monoid c) => Sequential c where+    {-# MINIMAL null, ((take, drop) | splitAt)+              , ((revTake, revDrop) | revSplitAt)+              , splitOn+              , (break | span)+              , intersperse+              , filter, reverse+              , uncons, unsnoc, snoc, cons+              , find, sortBy, length, singleton #-}++    -- | Check if a collection is empty+    null :: c -> Bool++    -- | Take the first @n elements of a collection+    take :: Int -> c -> c+    take n = fst . splitAt n++    -- | Take the last @n elements of a collection+    revTake :: Int -> c -> c+    revTake n = fst . revSplitAt n++    -- | Drop the first @n elements of a collection+    drop :: Int -> c -> c+    drop n = snd . splitAt n++    -- | Drop the last @n elements of a collection+    revDrop :: Int -> c -> c+    revDrop n = snd . revSplitAt n++    -- | Split the collection at the @n'th elements+    splitAt :: Int -> c -> (c,c)+    splitAt n c = (take n c, drop n c)++    -- | Split the collection at the @n'th elements from the end+    revSplitAt :: Int -> c -> (c,c)+    revSplitAt n c = (revTake n c, revDrop n c)++    -- | Split on a specific elements returning a list of colletion+    splitOn :: (Element c -> Bool) -> c -> [c]++    -- | Split a collection when the predicate return true+    break :: (Element c -> Bool) -> c -> (c,c)+    break predicate = span (not . predicate)++    -- | Split a collection when the predicate return true+    breakElem :: Eq (Element c) => Element c -> c -> (c,c)+    breakElem c = break (== c)++    -- | The 'intersperse' function takes an element and a list and+    -- \`intersperses\' that element between the elements of the list.+    -- For example,+    --+    -- > intersperse ',' "abcde" == "a,b,c,d,e"+    intersperse :: Element c -> c -> c++    -- | 'intercalate' @xs xss@ is equivalent to @('mconcat' ('intersperse' xs xss))@.+    -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the+    -- result.+    intercalate :: Monoid (Item c) => Element c -> c -> Element c+    intercalate xs xss = mconcatCollection (intersperse xs xss)++    -- | Split a collection while the predicate return true+    span :: (Element c -> Bool) -> c -> (c,c)+    span predicate = break (not . predicate)++    -- | Filter all the elements that satisfy the predicate+    filter :: (Element c -> Bool) -> c -> c++    -- | Reverse a collection+    reverse :: c -> c++    -- | Decompose a collection into its first element and the remaining collection.+    -- If the collection is empty, returns Nothing.+    uncons :: c -> Maybe (Element c, c)++    -- | Decompose a collection into a collection without its last element, and the last element+    -- If the collection is empty, returns Nothing.+    unsnoc :: c -> Maybe (c, Element c)++    -- | Prepend an element to an ordered collection+    snoc :: c -> Element c -> c++    -- | Append an element to an ordered collection+    cons :: Element c -> c -> c++    -- | Find an element in an ordered collection+    find :: (Element c -> Bool) -> c -> Maybe (Element c)++    -- | Sort an ordered collection using the specified order function+    sortBy :: (Element c -> Element c -> Ordering) -> c -> c++    -- | Length of a collection (number of Element c)+    length :: c -> Int++    -- | Create a collection with a single element+    singleton :: Element c -> c++-- Temporary utility functions+mconcatCollection :: (Monoid (Item c), Sequential c) => c -> Element c+mconcatCollection c = mconcat (toList c)++instance Sequential [a] where+    null = Data.List.null+    take = Data.List.take+    drop = Data.List.drop+    revTake = ListExtra.revTake+    revDrop = ListExtra.revDrop+    splitAt = Data.List.splitAt+    revSplitAt = ListExtra.revSplitAt+    splitOn = ListExtra.wordsWhen+    break = Data.List.break+    intersperse = Data.List.intersperse+    span = Data.List.span+    filter = Data.List.filter+    reverse = Data.List.reverse+    uncons = ListExtra.uncons+    unsnoc = ListExtra.unsnoc+    snoc c e = c `mappend` [e]+    cons e c = e : c+    find = Data.List.find+    sortBy = Data.List.sortBy+    length = Data.List.length+    singleton = (:[])++instance UV.PrimType ty => Sequential (UV.UArray ty) where+    null = UV.null+    take = UV.take+    revTake = UV.revTake+    drop = UV.drop+    revDrop = UV.revDrop+    splitAt = UV.splitAt+    revSplitAt = UV.revSplitAt+    splitOn = UV.splitOn+    break = UV.break+    breakElem = UV.breakElem+    intersperse = UV.intersperse+    span = UV.span+    filter = UV.filter+    reverse = UV.reverse+    uncons = UV.uncons+    unsnoc = UV.unsnoc+    snoc = UV.snoc+    cons = UV.cons+    find = UV.find+    sortBy = UV.sortBy+    length = UV.length+    singleton = fromList . (:[])
+ Foundation/Collection/Zippable.hs view
@@ -0,0 +1,278 @@+-- |+-- Module      : Foundation.Collection.Zippable+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--+-- Common functions (e. g. 'zip', 'zipWith') that are useful for combining+-- multiple collections.+--+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Foundation.Collection.Zippable+    ( BoxedZippable(..)+    , Zippable(..)+    ) where++import qualified Foundation.Array.Unboxed as UV+import qualified Foundation.Array.Unboxed.Builder as UVB+import           Foundation.Collection.Element+import           Foundation.Collection.Sequential+import           Foundation.Internal.Base+import           Foundation.Number+import qualified Prelude+import           GHC.ST++class Sequential col => Zippable col where++  -- | 'zipWith' generalises 'zip' by zipping with the function given as the+  --   first argument, instead of a tupling function. For example, @'zipWith' (+)@+  --   is applied to two collections to produce the collection of corresponding+  --   sums.+  zipWith :: (Sequential a, Sequential b)+          => (Element a -> Element b -> Element col)+          -> a -> b -> col+  zipWith f a b = go f (toList a, toList b)+    where go f' = maybe mempty (\(x, xs) -> uncurry2 f' x `cons` go f' xs) . uncons2++  -- | Like 'zipWith', but works with 3 collections.+  zipWith3 :: (Sequential a, Sequential b, Sequential c)+           => (Element a -> Element b -> Element c -> Element col)+           -> a -> b -> c -> col+  zipWith3 f a b c = go f (toList a, toList b, toList c)+    where go f' = maybe mempty (\(x, xs) -> uncurry3 f' x `cons` go f' xs) . uncons3++  -- | Like 'zipWith', but works with 4 collections.+  zipWith4 :: (Sequential a, Sequential b, Sequential c, Sequential d)+           => (Element a -> Element b -> Element c -> Element d -> Element col)+           -> a -> b -> c -> d -> col+  zipWith4 fn a b c d = go fn (toList a, toList b, toList c, toList d)+    where go f' = maybe mempty (\(x, xs) -> uncurry4 f' x `cons` go f' xs) . uncons4++  -- | Like 'zipWith', but works with 5 collections.+  zipWith5 :: (Sequential a, Sequential b, Sequential c, Sequential d, Sequential e)+           => (Element a -> Element b -> Element c -> Element d -> Element e -> Element col)+           -> a -> b -> c -> d -> e -> col+  zipWith5 fn a b c d e = go fn (toList a, toList b, toList c, toList d, toList e)+    where go f' = maybe mempty (\(x, xs) -> uncurry5 f' x `cons` go f' xs) . uncons5++  -- | Like 'zipWith', but works with 6 collections.+  zipWith6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e+              , Sequential f)+           => (Element a -> Element b -> Element c -> Element d -> Element e -> Element f -> Element col)+           -> a -> b -> c -> d -> e -> f -> col+  zipWith6 fn a b c d e f = go fn (toList a, toList b, toList c, toList d, toList e, toList f)+    where go f' = maybe mempty (\(x, xs) -> uncurry6 f' x `cons` go f' xs) . uncons6++  -- | Like 'zipWith', but works with 7 collections.+  zipWith7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e+              , Sequential f, Sequential g )+           => (Element a -> Element b -> Element c -> Element d -> Element e -> Element f -> Element g -> Element col)+           -> a -> b -> c -> d -> e -> f -> g -> col+  zipWith7 fn a b c d e f g = go fn (toList a, toList b, toList c, toList d, toList e, toList f, toList g)+    where go f' = maybe mempty (\(x, xs) -> uncurry7 f' x `cons` go f' xs) . uncons7++instance Zippable [c]++instance UV.PrimType ty => Zippable (UV.UArray ty) where+  zipWith f as bs = runST $+      Prelude.uncurry UVB.build $ go f (toList as) (toList bs)+    where+      go _  []       _        = (0, return ())+      go _  _        []       = (0, return ())+      go f' (a':as') (b':bs') =+          let (i, builder) = go f' as' bs'+          in (i + 1, UVB.appendTy (f' a' b') >> builder)++class Zippable col => BoxedZippable col where++  -- | 'zip' takes two collections and returns a collections of corresponding+  --   pairs. If one input collection is short, excess elements of the longer+  --   collection are discarded.+  zip :: ( Sequential a, Sequential b+         , Element col ~ (Element a, Element b) )+      => a -> b -> col+  zip = zipWith (,)++  -- | Like 'zip', but works with 3 collections.+  zip3 :: ( Sequential a, Sequential b, Sequential c+          , Element col ~ (Element a, Element b, Element c) )+       => a -> b -> c -> col+  zip3 = zipWith3 (,,)++  -- | Like 'zip', but works with 4 collections.+  zip4 :: ( Sequential a, Sequential b, Sequential c, Sequential d+          , Element col ~ (Element a, Element b, Element c, Element d) )+       => a -> b -> c -> d -> col+  zip4 = zipWith4 (,,,)++  -- | Like 'zip', but works with 5 collections.+  zip5 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e+          , Element col ~ (Element a, Element b, Element c, Element d, Element e) )+       => a -> b -> c -> d -> e -> col+  zip5 = zipWith5 (,,,,)++  -- | Like 'zip', but works with 6 collections.+  zip6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f+          , Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f) )+       => a -> b -> c -> d -> e -> f -> col+  zip6 = zipWith6 (,,,,,)++  -- | Like 'zip', but works with 7 collections.+  zip7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f, Sequential g+          , Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f, Element g) )+       => a -> b -> c -> d -> e -> f -> g -> col+  zip7 = zipWith7 (,,,,,,)++  -- | 'unzip' transforms a collection of pairs into a collection of first+  --   components and a collection of second components.+  unzip :: (Sequential a, Sequential b, Element col ~ (Element a, Element b))+        => col -> (a, b)+  unzip = go . toList+    where go []          = (mempty, mempty)+          go ((a, b):xs) =+              let (as, bs) = go xs+              in (a `cons` as, b `cons` bs)++  -- | Like 'unzip', but works on a collection of 3-element tuples.+  unzip3 :: ( Sequential a, Sequential b, Sequential c+            , Element col ~ (Element a, Element b, Element c) )+         => col -> (a, b, c)+  unzip3 = go . toList+    where go [] = (mempty, mempty, mempty)+          go ((a, b, c):xs) =+              let (as, bs, cs) = go xs+              in (a `cons` as, b `cons` bs, c `cons` cs)++  -- | Like 'unzip', but works on a collection of 4-element tuples.+  unzip4 :: ( Sequential a, Sequential b, Sequential c, Sequential d+            , Element col ~ (Element a, Element b, Element c, Element d) )+         => col -> (a, b, c, d)+  unzip4 = go . toList+    where go [] = (mempty, mempty, mempty, mempty)+          go ((a, b, c, d):xs) =+              let (as, bs, cs, ds) = go xs+              in (a `cons` as, b `cons` bs, c `cons` cs, d `cons` ds)++  -- | Like 'unzip', but works on a collection of 5-element tuples.+  unzip5 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e+            , Element col ~ (Element a, Element b, Element c, Element d, Element e) )+         => col -> (a, b, c, d, e)+  unzip5 = go . toList+    where go [] = (mempty, mempty, mempty, mempty, mempty)+          go ((a, b, c, d, e):xs) =+              let (as, bs, cs, ds, es) = go xs+              in (a `cons` as, b `cons` bs, c `cons` cs, d `cons` ds, e `cons` es)++  -- | Like 'unzip', but works on a collection of 6-element tuples.+  unzip6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f+            , Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f) )+         => col -> (a, b, c, d, e, f)+  unzip6 = go . toList+    where go [] = (mempty, mempty, mempty, mempty, mempty, mempty)+          go ((a, b, c, d, e, f):xs) =+              let (as, bs, cs, ds, es, fs) = go xs+              in (a `cons` as, b `cons` bs, c `cons` cs, d `cons` ds, e `cons` es, f `cons` fs)++  -- | Like 'unzip', but works on a collection of 7-element tuples.+  unzip7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e, Sequential f, Sequential g+            , Element col ~ (Element a, Element b, Element c, Element d, Element e, Element f, Element g) )+        => col -> (a, b, c, d, e, f, g)+  unzip7 = go . toList+    where go [] = (mempty, mempty, mempty, mempty, mempty, mempty, mempty)+          go ((a, b, c, d, e, f, g):xs) =+              let (as, bs, cs, ds, es, fs, gs) = go xs+              in (a `cons` as, b `cons` bs, c `cons` cs, d `cons` ds, e `cons` es, f `cons` fs, g `cons` gs)++instance BoxedZippable [a]++-- * Tuple helper functions++uncons2 :: (Sequential a, Sequential b) => (a, b) -> Maybe ((Element a, Element b), (a, b))+uncons2 xs = let (as, bs) = xs+             in do (a', as') <- uncons as+                   (b', bs') <- uncons bs+                   return ((a', b'), (as', bs'))++uncons3 :: (Sequential a, Sequential b, Sequential c)+        => (a, b, c)+        -> Maybe ((Element a, Element b, Element c), (a, b, c))+uncons3 xs = let (as, bs, cs) = xs+             in do (a', as') <- uncons as+                   (b', bs') <- uncons bs+                   (c', cs') <- uncons cs+                   return ((a', b', c'), (as', bs', cs'))++uncons4 :: (Sequential a, Sequential b, Sequential c, Sequential d)+        => (a, b, c, d)+        -> Maybe ( (Element a, Element b, Element c, Element d)+                 , (a, b, c, d) )+uncons4 xs = let (as, bs, cs, ds) = xs+             in do (a', as') <- uncons as+                   (b', bs') <- uncons bs+                   (c', cs') <- uncons cs+                   (d', ds') <- uncons ds+                   return ((a', b', c', d'), (as', bs', cs', ds'))++uncons5 :: (Sequential a, Sequential b, Sequential c, Sequential d, Sequential e)+        => (a, b, c, d, e)+        -> Maybe ( (Element a, Element b, Element c, Element d, Element e)+                 , (a, b, c, d, e) )+uncons5 xs = let (as, bs, cs, ds, es) = xs+             in do (a', as') <- uncons as+                   (b', bs') <- uncons bs+                   (c', cs') <- uncons cs+                   (d', ds') <- uncons ds+                   (e', es') <- uncons es+                   return ((a', b', c', d', e'), (as', bs', cs', ds', es'))++uncons6 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e+           , Sequential f )+        => (a, b, c, d, e, f)+        -> Maybe ( (Element a, Element b, Element c, Element d, Element e, Element f)+                 , (a, b, c, d, e, f) )+uncons6 xs = let (as, bs, cs, ds, es, fs) = xs+             in do (a', as') <- uncons as+                   (b', bs') <- uncons bs+                   (c', cs') <- uncons cs+                   (d', ds') <- uncons ds+                   (e', es') <- uncons es+                   (f', fs') <- uncons fs+                   return ((a', b', c', d', e', f'), (as', bs', cs', ds', es', fs'))++uncons7 :: ( Sequential a, Sequential b, Sequential c, Sequential d, Sequential e+           , Sequential f, Sequential g )+        => (a, b, c, d, e, f, g)+        -> Maybe ( (Element a, Element b, Element c, Element d, Element e, Element f+                 , Element g)+                 , (a, b, c, d, e, f, g) )+uncons7 xs = let (as, bs, cs, ds, es, fs, gs) = xs+             in do (a', as') <- uncons as+                   (b', bs') <- uncons bs+                   (c', cs') <- uncons cs+                   (d', ds') <- uncons ds+                   (e', es') <- uncons es+                   (f', fs') <- uncons fs+                   (g', gs') <- uncons gs+                   return ( (a', b', c', d', e', f', g')+                          , (as', bs', cs', ds', es', fs', gs') )++uncurry2 :: (a -> b -> c) -> (a, b) -> c+uncurry2 = Prelude.uncurry++uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uncurry3 fn (a, b, c) = fn a b c++uncurry4 :: (a -> b -> c -> d -> g) -> (a, b, c, d) -> g+uncurry4 fn (a, b, c, d) = fn a b c d++uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f+uncurry5 fn (a, b, c, d, e) = fn a b c d e++uncurry6 :: (a -> b -> c -> d -> e -> f -> g) -> (a, b, c, d, e, f) -> g+uncurry6 fn (a, b, c, d, e, f) = fn a b c d e f++uncurry7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> (a, b, c, d, e, f, g) -> h+uncurry7 fn (a, b, c, d, e, f, g) = fn a b c d e f g
+ Foundation/Convertible.hs view
@@ -0,0 +1,24 @@+-- |+-- Module      : Foundation.Convertible+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+module Foundation.Convertible+    ( Convertible(..)+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Proxy++-- | Class of things that can be converted from a to b+class Convertible a b where+    type Convert a b+    convert :: Proxy b -> a -> Convert a b++instance Convertible a a where+    type Convert a a = a+    convert _ = id
+ Foundation/Foreign.hs view
@@ -0,0 +1,16 @@+-- |+-- Module      : Foundation.Foreign+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.Foreign+    ( module Foundation.Primitive.FinalPtr+    , V.foreignMem+    , V.mutableForeignMem+    ) where++import           Foundation.Primitive.FinalPtr+import qualified Foundation.Array.Unboxed as V+import qualified Foundation.Array.Unboxed.Mutable as V
+ Foundation/Foreign/MemoryMap.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+module Foundation.Foreign.MemoryMap+    ( fileMapRead+    , FileMapping(..)+    , fileMappingToFinalPtr+    ) where++import Foundation.Foreign.MemoryMap.Types+#ifdef mingw32_HOST_OS+import Foundation.Foreign.MemoryMap.Windows+#else+import Foundation.Foreign.MemoryMap.Posix+#endif++{-+fileMap :: Fd -> Int -> IO FileMap+fileMap = undefined+-}
+ Foundation/Foreign/MemoryMap/Posix.hsc view
@@ -0,0 +1,251 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Foundation.Foreign.MemoryMap.Posix+-- Copyright   :  (c) Vincent Hanquez 2014+-- License     :  BSD-style+--+-- Maintainer  :  Vincent Hanquez+-- Stability   :  provisional+-- Portability :  non-portable (requires POSIX)+--+-- Functions defined by the POSIX standards for manipulating memory maps+--+-- When a function that calls an underlying POSIX function fails, the errno+-- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.+-- For a list of which errno codes may be generated, consult the POSIX+-- documentation for the underlying function.+--+-----------------------------------------------------------------------------++#include <sys/mman.h>+#include <unistd.h>++{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE CPP #-}+module Foundation.Foreign.MemoryMap.Posix+    ( memoryMap+    , memoryUnmap+    , memoryAdvise+    , memoryLock+    , memoryUnlock+    , memoryProtect+    , memorySync+    -- * Flags types+    , MemoryMapFlag(..)+    , MemoryProtection(..)+    , MemoryAdvice(..)+    , MemorySyncFlag(..)+    -- * system page size+    , sysconfPageSize+    -- * High level+    , fileMapRead+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Types+import System.Posix.Types+import Foreign.Ptr+import Foreign.C.Types+import Foreign.C.Error+import Data.Bits++import Foundation.Collection.Foldable+import Foundation.VFS+import qualified Prelude (fromIntegral)+import Foundation.Foreign.MemoryMap.Types+import Control.Exception++import           GHC.IO.FD+import           GHC.IO.IOMode+import qualified GHC.IO.Device as IO++foreign import ccall unsafe "mmap"+    c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)++foreign import ccall unsafe "munmap"+    c_munmap :: Ptr a -> CSize -> IO CInt++#if defined(POSIX_MADV_NORMAL)+foreign import ccall unsafe "posix_madvise"+    c_madvise :: Ptr a -> CSize -> CInt -> IO CInt+#else+foreign import ccall unsafe "madvise"+    c_madvise :: Ptr a -> CSize -> CInt -> IO CInt+#endif++foreign import ccall unsafe "msync"+    c_msync :: Ptr a -> CSize -> CInt -> IO CInt++foreign import ccall unsafe "mprotect"+    c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt++#ifndef __HAIKU__+foreign import ccall unsafe "mlock"+    c_mlock :: Ptr a -> CSize -> IO CInt+#else+c_mlock :: Ptr a -> CSize -> IO CInt+c_mlock _ _ = return (-1)+#endif++#ifndef __HAIKU__+foreign import ccall unsafe "munlock"+    c_munlock :: Ptr a -> CSize -> IO CInt+#else+c_munlock :: Ptr a -> CSize -> IO CInt+c_munlock _ _ = return (-1)+#endif++foreign import ccall unsafe "sysconf"+    c_sysconf :: CInt -> CLong++-- | Mapping flag+data MemoryMapFlag =+      MemoryMapShared  -- ^ memory changes are shared between process+    | MemoryMapPrivate -- ^ memory changes are private to process+    deriving (Show,Eq)++-- | Memory protection+data MemoryProtection =+      MemoryProtectionNone+    | MemoryProtectionRead+    | MemoryProtectionWrite+    | MemoryProtectionExecute+    deriving (Show,Eq)++-- | Advice to put on memory.+--+-- only define the posix one.+data MemoryAdvice =+      MemoryAdviceNormal     -- ^ no specific advice, the default.+    | MemoryAdviceRandom     -- ^ Expect page references in random order. No readahead should occur.+    | MemoryAdviceSequential -- ^ Expect page references in sequential order. Page should be readahead aggressively.+    | MemoryAdviceWillNeed   -- ^ Expect access in the near future. Probably a good idea to readahead early+    | MemoryAdviceDontNeed   -- ^ Do not expect access in the near future.+    deriving (Show,Eq)++-- | Memory synchronization flags+data MemorySyncFlag =+      MemorySyncAsync      -- ^ perform asynchronous write.+    | MemorySyncSync       -- ^ perform synchronous write.+    | MemorySyncInvalidate -- ^ invalidate cache data.+    deriving (Show,Eq)++cvalueOfMemoryProts :: [MemoryProtection] -> CInt+cvalueOfMemoryProts = foldl (.|.) 0 . fmap toProt+  where toProt :: MemoryProtection -> CInt+        toProt MemoryProtectionNone    = (#const PROT_NONE)+        toProt MemoryProtectionRead    = (#const PROT_READ)+        toProt MemoryProtectionWrite   = (#const PROT_WRITE)+        toProt MemoryProtectionExecute = (#const PROT_EXEC)++cvalueOfMemorySync :: [MemorySyncFlag] -> CInt+cvalueOfMemorySync = foldl (.|.) 0 . fmap toSync+  where toSync MemorySyncAsync      = (#const MS_ASYNC)+        toSync MemorySyncSync       = (#const MS_SYNC)+        toSync MemorySyncInvalidate = (#const MS_INVALIDATE)++-- | Map pages of memory.+--+-- If fd is present, this memory will represent the file associated.+-- Otherwise, the memory will be an anonymous mapping.+--+-- use 'mmap'+memoryMap :: Maybe (Ptr a)      -- ^ The address to map to if MapFixed is used.+          -> CSize              -- ^ The length of the mapping+          -> [MemoryProtection] -- ^ the memory protection associated with the mapping+          -> MemoryMapFlag      -- ^+          -> Maybe Fd+          -> COff+          -> IO (Ptr a)+memoryMap initPtr sz prots flag mfd off =+    throwErrnoIf (== m1ptr) "mmap" (c_mmap (maybe nullPtr id initPtr) sz cprot cflags fd off)+  where m1ptr  = nullPtr `plusPtr` (-1)+        fd     = maybe (-1) (\(Fd v) -> v) mfd+        cprot  = cvalueOfMemoryProts prots+        cflags = maybe cMapAnon (const 0) mfd+             .|. maybe 0 (const cMapFixed) initPtr+             .|. toMapFlag flag++#ifdef __APPLE__+        cMapAnon  = (#const MAP_ANON)+#else+        cMapAnon  = (#const MAP_ANONYMOUS)+#endif+        cMapFixed = (#const MAP_FIXED)++        toMapFlag MemoryMapShared  = (#const MAP_SHARED)+        toMapFlag MemoryMapPrivate = (#const MAP_PRIVATE)++-- | Unmap pages of memory+--+-- use 'munmap'+memoryUnmap :: Ptr a -> CSize -> IO ()+memoryUnmap ptr sz = throwErrnoIfMinus1_ "munmap" (c_munmap ptr sz)++-- | give advice to the operating system about use of memory+--+-- call 'madvise'+memoryAdvise :: Ptr a -> CSize -> MemoryAdvice -> IO ()+memoryAdvise ptr sz adv = throwErrnoIfMinus1_ "madvise" (c_madvise ptr sz cadv)+  where cadv = toAdvice adv+#if defined(POSIX_MADV_NORMAL)+        toAdvice MemoryAdviceNormal = (#const POSIX_MADV_NORMAL)+        toAdvice MemoryAdviceRandom = (#const POSIX_MADV_RANDOM)+        toAdvice MemoryAdviceSequential = (#const POSIX_MADV_SEQUENTIAL)+        toAdvice MemoryAdviceWillNeed = (#const POSIX_MADV_WILLNEED)+        toAdvice MemoryAdviceDontNeed = (#const POSIX_MADV_DONTNEED)+#else+        toAdvice MemoryAdviceNormal = (#const MADV_NORMAL)+        toAdvice MemoryAdviceRandom = (#const MADV_RANDOM)+        toAdvice MemoryAdviceSequential = (#const MADV_SEQUENTIAL)+        toAdvice MemoryAdviceWillNeed = (#const MADV_WILLNEED)+        toAdvice MemoryAdviceDontNeed = (#const MADV_DONTNEED)+#endif++-- | lock a range of process address space+--+-- call 'mlock'+memoryLock :: Ptr a -> CSize -> IO ()+memoryLock ptr sz = throwErrnoIfMinus1_ "mlock" (c_mlock ptr sz)++-- | unlock a range of process address space+--+-- call 'munlock'+memoryUnlock :: Ptr a -> CSize -> IO ()+memoryUnlock ptr sz = throwErrnoIfMinus1_ "munlock" (c_munlock ptr sz)++-- | set protection of memory mapping+--+-- call 'mprotect'+memoryProtect :: Ptr a -> CSize -> [MemoryProtection] -> IO ()+memoryProtect ptr sz prots = throwErrnoIfMinus1_ "mprotect" (c_mprotect ptr sz cprot)+  where cprot = cvalueOfMemoryProts prots++-- | memorySync synchronize memory with physical storage.+--+-- On an anonymous mapping this function does not have any effect.+-- call 'msync'+memorySync :: Ptr a -> CSize -> [MemorySyncFlag] -> IO ()+memorySync ptr sz flags = throwErrnoIfMinus1_ "msync" (c_msync ptr sz cflags)+  where cflags = cvalueOfMemorySync flags++-- | Return the operating system page size.+--+-- call 'sysconf'+sysconfPageSize :: Int+sysconfPageSize = Prelude.fromIntegral $ c_sysconf (#const _SC_PAGESIZE)++--------------------------------------------------------------------------------++fileSizeToCSize :: FileSize -> CSize+fileSizeToCSize (FileSize sz) = Prelude.fromIntegral sz++fileSizeFromInteger :: Integer -> FileSize+fileSizeFromInteger = FileSize . Prelude.fromIntegral++fileMapRead :: FileMapReadF+fileMapRead fp = bracket (openFile (filePathToLString fp) ReadMode True) (IO.close . fst) $ \(fd,_) -> do+    sz   <- fileSizeFromInteger `fmap` IO.getSize fd+    let csz = fileSizeToCSize sz+    p    <- memoryMap Nothing csz [MemoryProtectionRead] MemoryMapPrivate (Just $ Fd $ fdFD fd) 0+    return $ FileMapping p sz (memoryUnmap p csz)
+ Foundation/Foreign/MemoryMap/Types.hs view
@@ -0,0 +1,34 @@+-- |+-- Module      : Foundation.Foreign.MemoryMap.Types+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.Foreign.MemoryMap.Types+    ( FileMapping(..)+    , fileMappingToFinalPtr+    , FileMapReadF+    ) where++import GHC.Ptr+import Foundation.Primitive.FinalPtr+import Foundation.Internal.Base+import Foundation.Internal.Types+import Foundation.VFS (FilePath)++-- | Contains all the information related to a file mapping,+-- including the size and the finalizer function.+data FileMapping = FileMapping+    { fileMappingPtr   :: Ptr Word8+    , fileMappingSize  :: FileSize+    , fileMappingUnmap :: IO ()+    }++-- | From a file mapping, create a final ptr which will automatically+-- unmap memory when the pointer is garbage.+fileMappingToFinalPtr :: FileMapping -> IO (FinalPtr Word8)+fileMappingToFinalPtr (FileMapping ptr _ finalizer) =+    toFinalPtr ptr (\_ -> finalizer)++type FileMapReadF = FilePath -> IO FileMapping
+ Foundation/Foreign/MemoryMap/Windows.hs view
@@ -0,0 +1,27 @@+module Foundation.Foreign.MemoryMap.Windows+    ( fileMapRead+    ) where++import System.Win32.Mem+import System.Win32.File+import System.Win32.FileMapping+import Control.Exception hiding (handle)++import Foundation.Internal.Types+import Foundation.Internal.Base+import Foundation.Primitive.FinalPtr+import Foundation.VFS+import Foundation.Foreign.MemoryMap.Types++fileMapRead :: FileMapReadF+fileMapRead path = bracket doOpen closeHandle doMapping+  where+    doOpen           = createFile (filePathToLString path) gENERIC_READ fILE_SHARE_READ Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing+    doMapping handle = bracket (createFileMapping (Just handle) pAGE_READONLY 0 Nothing)+                               closeHandle+                               (getSizeAndMap handle)+    getSizeAndMap handle filemap = do+        fileInfo <- getFileInformationByHandle handle+        mask_ $ do+            ptr <- mapViewOfFile filemap fILE_MAP_READ 0 0+            return $ FileMapping ptr (FileSize $ bhfiSize fileInfo) (unmapViewOfFile ptr)
+ Foundation/IO.hs view
@@ -0,0 +1,25 @@+-- |+-- Module      : Foundation.IO+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- IO Routine+module Foundation.IO+    (+    -- * Terminal+      Foundation.IO.Terminal.putStrLn+    , Foundation.IO.Terminal.putStr+    -- * File+    , Foundation.IO.File.IOMode(..)+    , Foundation.IO.File.openFile+    , Foundation.IO.File.closeFile+    , Foundation.IO.File.withFile+    , Foundation.IO.File.hGet+    , Foundation.IO.File.readFile+    , Foundation.IO.File.foldTextFile+    ) where++import qualified Foundation.IO.Terminal+import qualified Foundation.IO.File
+ Foundation/IO/File.hs view
@@ -0,0 +1,147 @@+-- |+-- Module      : Foundation.IO.File+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+module Foundation.IO.File+    ( openFile+    , closeFile+    , IOMode(..)+    , withFile+    , hGet+    , hGetNonBlocking+    , hGetSome+    , readFile+    , foldTextFile+    ) where++import           System.IO (Handle, IOMode)+import           System.IO.Error+import qualified System.IO as S+import           Foundation.Collection+import           Foundation.VFS+import           Foundation.Internal.Types+import           Foundation.Internal.Base+import           Foundation.String+import           Foundation.Array+import           Foundation.Number+import qualified Foundation.Array.Unboxed.Mutable as V+import qualified Foundation.Array.Unboxed as V+import qualified Foundation.String.UTF8 as S+import           Control.Exception (bracket)+import           Foreign.Ptr (plusPtr)++-- | list the file name in the given FilePath directory+--+-- TODO: error management and not implemented yet+--getDirectory :: FilePath -> IO [FileName]+--getDirectory = undefined++-- | Open a new handle on the file+openFile :: FilePath -> IOMode -> IO Handle+openFile filepath mode = do+    S.openBinaryFile (filePathToLString filepath) mode++-- | Close a handle+closeFile :: Handle -> IO ()+closeFile = S.hClose++-- | Read binary data directly from the specified 'Handle'.+--+-- First argument is the Handle to read from, and the second is the number of bytes to read.+-- It returns the bytes read, up to the specified size, or an empty array if EOF has been reached.+--+-- 'hGet' is implemented in terms of 'hGetBuf'.+hGet :: Handle -> Int -> IO (UArray Word8)+hGet h size+    | size < 0   = invalidBufferSize "hGet" h size+    | otherwise  = V.createFromIO size $ \p -> S.hGetBuf h p size++-- | hGetNonBlocking is similar to 'hGet', except that it will never block+-- waiting for data to become available, instead it returns only whatever data+-- is available.  If there is no data available to be read, 'hGetNonBlocking'+-- returns an empty array.+--+-- Note: on Windows, this function behaves identically to 'hGet'.+hGetNonBlocking :: Handle -> Int -> IO (UArray Word8)+hGetNonBlocking h size+    | size < 0  = invalidBufferSize "hGetNonBlocking" h size+    | otherwise = V.createFromIO size $ \p -> S.hGetBufNonBlocking h p size++-- | Like 'hGet', except that a shorter array may be returned+-- if there are not enough bytes immediately available to satisfy the+-- whole request.  'hGetSome' only blocks if there is no data+-- available, and EOF has not yet been reached.+--+hGetSome :: Handle -> Int -> IO (UArray Word8)+hGetSome h size+    | size < 0  = invalidBufferSize "hGetSome" h size+    | otherwise = V.createFromIO size $ \p -> S.hGetBufSome h p size++invalidBufferSize :: [Char] -> Handle -> Int -> IO a+invalidBufferSize functionName handle size =+    ioError $ mkIOError illegalOperationErrorType+                        (functionName <> " invalid array size: " <> show size)+                        (Just handle)+                        Nothing++-- | @'withFile' filepath mode act@ opens a file using the mode@+-- and run act@. the by-product handle will be closed when act finish,+-- either normally or through an exception.+--+-- The value returned is the result of act@+withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r+withFile fp mode act = bracket (openFile fp mode) closeFile act++-- | Read a binary file and return the whole content in one contiguous buffer.+readFile :: FilePath -> IO (UArray Word8)+readFile fp = withFile fp S.ReadMode $ \h -> do+    -- TODO filesize is an integer (whyyy ?!), and transforming to Int using+    -- fromIntegral is probably the wrong thing to do here..+    sz <- S.hFileSize h+    mv <- V.newPinned (Size $ fromInteger sz)+    V.withMutablePtr mv $ loop h (fromInteger sz)+    unsafeFreeze mv+  where+    loop h left dst+        | left == 0 = return ()+        | otherwise = do+            let toRead = min blockSize left+            r <- S.hGetBuf h dst toRead+            if r > 0 && r <= toRead+                then loop h (left - r) (dst `plusPtr` r)+                else error "readFile: " -- turn into proper error++-- | Fold over chunks file calling the callback function for each chunks+-- read from the file, until the end of file.+foldTextFile :: (String -> a -> IO a) -- ^ Fold callback function+             -> a                     -- ^ initial accumulator+             -> FilePath              -- ^ File to read+             -> IO a+foldTextFile chunkf ini fp = do+    buf <- V.newPinned (Size blockSize)+    V.withMutablePtr buf $ \ptr ->+        withFile fp S.ReadMode $ doFold buf ptr+  where+    doFold mv ptr handle = loop 0 ini+      where+        loop absPos acc = do+            r <- S.hGetBuf handle ptr blockSize+            if r > 0 && r <= blockSize+                then do+                    (pos, validateRet) <- S.mutableValidate mv 0 r+                    s <- case validateRet of+                        Nothing -> S.fromBytesUnsafe `fmap` V.freezeShrink mv r+                        Just S.MissingByte -> do+                            sRet <- S.fromBytesUnsafe `fmap` V.freezeShrink mv pos+                            V.unsafeSlide mv pos r+                            return sRet+                        Just _ ->+                            error ("foldTextFile: invalid UTF8 sequence: byte position: " <> show (absPos + pos))+                    chunkf s acc >>= loop (absPos + r)+                else error ("foldTextFile: read failed") -- FIXME++blockSize :: Int+blockSize = 4096
+ Foundation/IO/FileMap.hs view
@@ -0,0 +1,59 @@+-- |+-- Module      : Foundation.IO.FileMap+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Note that the memory mapping is handled by the system, not at the haskell level.+-- The system can modify the content of the memory as any moment under your feet.+--+-- It also have the limitation of your system, no emulation or nice handling of all+-- those corners cases is attempted here.+--+-- for example mapping a large file (> 4G), on a 32 bits system is likely to just+-- fail or returns inconsistent result.+--+-- In doubt, use 'readFile' or other simple routine that brings+-- the content of the file in IO.+--+module Foundation.IO.FileMap+    ( fileMapRead+    , fileMapReadWith+    ) where++import           Control.Exception+import           Foundation.Internal.Types+import           Foundation.Internal.Base+import           Foundation.VFS (FilePath)+import           Foundation.Primitive.FinalPtr+import qualified Foundation.Array.Unboxed as V+import qualified Foundation.Foreign.MemoryMap as I+import qualified Prelude++getSize :: I.FileMapping -> Int+getSize fm+    | Prelude.fromIntegral (maxBound :: Int) < sz = error ("cannot map file in entirety as size overflow " <> show sz)+    | otherwise                                   = Prelude.fromIntegral sz+  where+    (FileSize sz) = I.fileMappingSize fm++-- | Map in memory the whole content of a file.+--+-- Once the array goes out of scope, the memory get (eventually) unmap+fileMapRead :: FilePath -> IO (V.UArray Word8)+fileMapRead fp = do+    fileMapping <- I.fileMapRead fp+    fptr <- I.fileMappingToFinalPtr fileMapping+    return $ V.foreignMem fptr (getSize fileMapping)++-- | Map in memory the whole content of a file,++-- the whole map is unmapped at the end of function after the function has been called+-- so any things that is still holding on to this memory will very likely trigger segfault+-- or other really bad behavior.+fileMapReadWith :: FilePath -> (V.UArray Word8 -> IO a) -> IO a+fileMapReadWith fp f = do+    bracket (I.fileMapRead fp) I.fileMappingUnmap $ \fm -> do+        fptr <- toFinalPtr (I.fileMappingPtr fm) (\_ -> return ())+        f (V.foreignMem fptr (getSize fm))
+ Foundation/IO/Terminal.hs view
@@ -0,0 +1,23 @@+-- |+-- Module      : Foundation.IO.Terminal+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+module Foundation.IO.Terminal+    ( putStrLn+    , putStr+    ) where++import           Foundation.Internal.Base+import           Foundation.String+import qualified Prelude++-- | Print a string to standard output+putStr :: String -> IO ()+putStr = Prelude.putStr . toList++-- | Print a string with a newline to standard output+putStrLn :: String -> IO ()+putStrLn = Prelude.putStrLn . toList
+ Foundation/Internal/Base.hs view
@@ -0,0 +1,74 @@+-- |+-- Module      : Foundation.Internal.Base+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- internal re-export of all the good base bits+module Foundation.Internal.Base+    ( (Prelude.$)+    , (Prelude.$!)+    , (Prelude.&&)+    , (Prelude.||)+    , (Control.Category..)+    , (Control.Applicative.<$>)+    , Prelude.not+    , Prelude.otherwise+    , Prelude.fst+    , Prelude.snd+    , Control.Category.id+    , Prelude.maybe+    , Prelude.either+    , Prelude.flip+    , Prelude.const+    , Prelude.error+    , Prelude.and+    , Prelude.undefined+    , Prelude.seq+    , Prelude.Show (..)+    , Prelude.Ord (..)+    , Prelude.Eq (..)+    , Prelude.Bounded (..)+    , Prelude.Enum (..)+    , Prelude.Functor (..)+    , Control.Applicative.Applicative (..)+    , Prelude.Monad (..)+    , Prelude.Maybe (..)+    , Prelude.Ordering (..)+    , Prelude.Bool (..)+    , Prelude.Int+    , Prelude.Integer+    , Prelude.Char+    , Data.Int.Int8, Data.Int.Int16, Data.Int.Int32, Data.Int.Int64+    , Data.Word.Word8, Data.Word.Word16, Data.Word.Word32, Data.Word.Word64, Data.Word.Word+    , Prelude.IO+    , Foundation.Internal.IsList.IsList (..)+    , GHC.Exts.IsString (..)+    , GHC.Generics.Generic (..)+    , Prelude.Either (..)+    , Data.Typeable.Typeable+    , Data.Monoid.Monoid (..)+    , (Data.Monoid.<>)+    , Control.Exception.Exception+    , Control.Exception.throw+    , Control.Exception.throwIO+    -- * Errors+    , internalError+    ) where++import qualified Prelude+import qualified Control.Category+import qualified Control.Applicative+import qualified Control.Exception+import qualified Data.Monoid+import qualified Data.Typeable+import qualified Data.Word+import qualified Data.Int+import qualified Foundation.Internal.IsList+import qualified GHC.Exts+import qualified GHC.Generics++-- | Only to use internally for internal error cases+internalError :: [Prelude.Char] -> a+internalError s = Prelude.error ("Internal Error: the impossible happened: " Prelude.++ s)
+ Foundation/Internal/Identity.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Foundation.Internal.Identity+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Identity re-export, with a compat wrapper for older version of base that+-- do not have Data.Functor.Identity+{-# LANGUAGE CPP #-}+module Foundation.Internal.Identity+    ( Identity(..)+    ) where++#if MIN_VERSION_base(4,8,0)++import Data.Functor.Identity++#else++import Foundation.Internal.Base++newtype Identity a = Identity { runIdentity :: a }+    deriving (Eq, Ord)++instance Functor Identity where+    fmap f (Identity a) = Identity (f a)++instance Applicative Identity where+    pure a = Identity a+    (<*>) fab fa = Identity $ runIdentity fab (runIdentity fa)++instance Monad Identity where+    return    = pure+    ma >>= mb = mb (runIdentity ma)++#endif
+ Foundation/Internal/IsList.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Foundation.Internal.IsList+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- compat friendly version of IsList+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+module Foundation.Internal.IsList+    ( IsList(..)+    ) where++#if MIN_VERSION_base(4,7,0)++import           GHC.Exts++#else++import qualified Prelude++class IsList l where+  type Item l+  fromList  :: [Item l] -> l+  toList    :: l -> [Item l]++  fromListN :: Prelude.Int -> [Item l] -> l+  fromListN _ = fromList++instance IsList [a] where+    type Item [a] = a+    fromList = Prelude.id+    toList   = Prelude.id++#endif
+ Foundation/Internal/MonadTrans.hs view
@@ -0,0 +1,49 @@+-- |+-- Module      : Foundation.Internal.MonadTrans+-- License     : BSD-style+-- Maintainer  : Psychohistorians+-- Stability   : experimental+-- Portability : portable+--+-- An internal and really simple monad transformers,+-- without any bells and whistse.+module Foundation.Internal.MonadTrans+    ( State(..)+    , Reader(..)+    ) where++import Foundation.Internal.Base++-- | Simple State monad+newtype State s m a = State { runState :: s -> m (a, s) }++instance Monad m => Functor (State s m) where+    fmap f fa = State $ \st -> runState fa st >>= \(a, s2) -> return (f a, s2)+instance Monad m => Applicative (State s m) where+    pure a = State $ \st -> return (a,st)+    fab <*> fa = State $ \s1 -> do+        (a,s2)  <- runState fa s1+        (ab,s3) <- runState fab s2+        return (ab a, s3)+instance Monad m => Monad (State r m) where+    return a = State $ \st -> return (a,st)+    ma >>= mb = State $ \s1 -> do+        (a,s2) <- runState ma s1+        runState (mb a) s2++-- | Simple Reader monad+newtype Reader r m a = Reader { runReader :: r -> m a }++instance Monad m => Functor (Reader r m) where+    fmap f fa = Reader $ \r -> runReader fa r >>= \a -> return (f a)+instance Monad m => Applicative (Reader r m) where+    pure a = Reader $ \_ -> return a+    fab <*> fa = Reader $ \r -> do+        a  <- runReader fa r+        ab <- runReader fab r+        return $ ab a+instance Monad m => Monad (Reader r m) where+    return a = Reader $ \_ -> return a+    ma >>= mb = Reader $ \r -> do+        a <- runReader ma r+        runReader (mb a) r
+ Foundation/Internal/PrimTypes.hs view
@@ -0,0 +1,28 @@+-- |+-- Module      : Foundation.Internal.PrimTypes+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+module Foundation.Internal.PrimTypes+    ( FileSize#+    , Offset#+    , Size#+    ) where++import GHC.Prim++-- | File size in bytes+type FileSize# = Word64#++-- | Offset in a bytearray, string, type alias+--+-- for code documentation purpose only, just a simple type alias on Int#+type Offset# = Int#++-- | Size in bytes type alias+--+-- for code documentation purpose only, just a simple type alias on Int#+type Size# = Int#
+ Foundation/Internal/Primitive.hs view
@@ -0,0 +1,144 @@+-- |+-- Module      : Foundation.Internal.Primitive+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE CPP #-}+module Foundation.Internal.Primitive+    ( bool#+    , PinnedStatus, pinned, unpinned, isPinned+    , compatAndI#+    , compatQuotRemInt#+    , compatCopyAddrToByteArray#+    , compatMkWeak#+    , compatGetSizeofMutableByteArray#+    , compatShrinkMutableByteArray#+    , compatResizeMutableByteArray#+    , Word(..)+    ) where++import qualified Prelude+import           GHC.Prim+import           GHC.Word+#if __GLASGOW_HASKELL__ >= 800+import           GHC.IO+#endif++--  GHC 8.0  | Base 4.9+--  GHC 7.10 | Base 4.8+--  GHC 7.8  | Base 4.7+--  GHC 7.6  | Base 4.6+--  GHC 7.4  | Base 4.5++-- | Flag record whether a specific byte array is pinned or not+data PinnedStatus = PinnedStatus Int#++isPinned :: PinnedStatus -> Prelude.Bool+isPinned (PinnedStatus 0#) = Prelude.False+isPinned _                 = Prelude.True++pinned :: PinnedStatus+pinned = PinnedStatus 1#++unpinned :: PinnedStatus+unpinned = PinnedStatus 0#++-- | turn an Int# into a Bool+--+-- Since GHC 7.8, boolean primitive don't return Bool but Int#.+#if MIN_VERSION_base(4,7,0)+bool# :: Int# -> Prelude.Bool+bool# v = tagToEnum# v+#else+bool# :: Prelude.Bool -> Prelude.Bool+bool# v = v+#endif+{-# INLINE bool# #-}++-- | A version friendly of andI#+compatAndI# :: Int# -> Int# -> Int#+#if !MIN_VERSION_base(4,7,0)+compatAndI# a b = word2Int# (and# (int2Word# a) (int2Word# b))+#else+compatAndI# = andI#+#endif+{-# INLINE compatAndI# #-}++-- | A version friendly of quotRemInt#+compatQuotRemInt# :: Int# -> Int# -> (# Int#, Int# #)+#if !MIN_VERSION_base(4,6,0)+compatQuotRemInt# a b = (# quotInt# a b, remInt# a b #)+#else+compatQuotRemInt# = quotRemInt#+#endif+{-# INLINE compatQuotRemInt# #-}++-- | A version friendly fo copyAddrToByteArray#+--+-- only available from GHC 7.8+compatCopyAddrToByteArray# :: Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s+#if MIN_VERSION_base(4,7,0)+compatCopyAddrToByteArray# = copyAddrToByteArray#+#else+compatCopyAddrToByteArray# addr ba ofs sz stini =+    loop ofs 0# stini+  where+    loop o i st+        | bool# (i ==# sz)  = st+        | Prelude.otherwise =+            case readWord8OffAddr# addr i st of+                (# st2, w #) -> loop (o +# 1#) (i +# 1#) (writeWord8Array# ba o w st2)+#endif+{-# INLINE compatCopyAddrToByteArray# #-}++-- | A mkWeak# version that keep working on 8.0+--+-- signature change in ghc-prim:+-- * 0.4: mkWeak# :: o -> b -> c                                             -> State# RealWorld -> (#State# RealWorld, Weak# b#)+-- * 0.5 :mkWeak# :: o -> b -> (State# RealWorld -> (#State# RealWorld, c#)) -> State# RealWorld -> (#State# RealWorld, Weak# b#)+--+compatMkWeak# :: o -> b -> Prelude.IO () -> State# RealWorld -> (#State# RealWorld, Weak# b #)+#if __GLASGOW_HASKELL__ >= 800+compatMkWeak# o b c s = mkWeak# o b (case c of { IO f -> f }) s+#else+compatMkWeak# o b c s = mkWeak# o b c s+#endif+{-# INLINE compatMkWeak# #-}++compatGetSizeofMutableByteArray# :: MutableByteArray# s -> State# s -> (#State# s, Int# #)+#if __GLASGOW_HASKELL__ >= 800+compatGetSizeofMutableByteArray# mba s = getSizeofMutableByteArray# mba s+#else+compatGetSizeofMutableByteArray# mba s = (# s, sizeofMutableByteArray# mba #)+#endif+{-# INLINE compatGetSizeofMutableByteArray# #-}++compatShrinkMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+#if __GLASGOW_HASKELL__ >= 800+compatShrinkMutableByteArray# mba i s =+    case shrinkMutableByteArray# mba i s of { s2 -> (# s2, mba #) }+#else+compatShrinkMutableByteArray# src i s =+    -- not check whether i is smaller than the size of the buffer+    case newAlignedPinnedByteArray# i 8# s of { (# s2, dst #) ->+    case copyMutableByteArray# dst 0# src 0# i s2 of { s3 -> (# s3, dst #) }}+#endif+{-# INLINE compatShrinkMutableByteArray# #-}++--shrinkMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> State# s+compatResizeMutableByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)+#if __GLASGOW_HASKELL__ >= 800+compatResizeMutableByteArray# mba i s = resizeMutableByteArray# mba i s+#else+compatResizeMutableByteArray# src i s =+    case newAlignedPinnedByteArray# i 8# s of { (# s2, dst #) ->+    case copyMutableByteArray# dst 0# src 0# (if isGrow then len else i) s2 of { s3 -> (# s3, dst #) }}+  where+    isGrow = bool# (i ># len)+    !len = sizeofMutableByteArray# src+#endif+{-# INLINE compatResizeMutableByteArray# #-}
+ Foundation/Internal/Proxy.hs view
@@ -0,0 +1,32 @@+-- |+-- Module      : Foundation.Internal.Proxy+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE CPP #-}+module Foundation.Internal.Proxy+    ( Proxy(..)+    , asProxyTypeOf+    ) where++#if MIN_VERSION_base(4,7,0)+import Data.Proxy+#else+import qualified Prelude++data Proxy a = Proxy++instance Prelude.Show (Proxy a) where+    showsPrec _ _ = Prelude.showString "Proxy"++-- | 'asProxyTypeOf' is a type-restricted version of 'const'.+-- It is usually used as an infix operator, and its typing forces its first+-- argument (which is usually overloaded) to have the same type as the tag+-- of the second.+asProxyTypeOf :: a -> Proxy a -> a+asProxyTypeOf = Prelude.const+{-# INLINE asProxyTypeOf #-}++#endif
+ Foundation/Internal/Types.hs view
@@ -0,0 +1,87 @@+-- |+-- Module      : Foundation.Internal.Types+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.Internal.Types+    ( FileSize(..)+    , Offset(..)+    , Offset8+    , offsetOfE+    , offsetPlusE+    , offsetMinusE+    , offsetRecast+    , (+.)+    , Size(..)+    , Size8+    , sizeOfE+    ) where++import GHC.Types+import GHC.Word+import Foundation.Internal.Base+import Foundation.Number++-- | File size in bytes+newtype FileSize = FileSize Word64+    deriving (Show,Eq,Ord)++-- | Offset in bytes used for memory addressing (e.g. in a vector, string, ..)+--+-- Int a terrible backing type which is hard to get away+-- considering that GHC/haskell are mostly using this for offset.+-- try to bring some sanity by a lightweight wrapping+--newtype Offset = Offset Int+--    deriving (Show,Eq,Ord)+type Offset8 = Offset Word8++-- | Offset in element of a certain type+newtype Offset ty = Offset Int+    deriving (Show,Eq,Ord)++instance Additive (Offset ty) where+    azero = Offset 0+    (+) (Offset a) (Offset b) = Offset (a+b)++instance Subtractive (Offset ty) where+    type Difference (Offset ty) = Size ty+    (Offset a) - (Offset b) = Size (a-b)++(+.) :: Offset ty -> Int -> Offset ty+(+.) (Offset a) b = Offset (a + b)++offsetOfE :: Size8 -> Offset ty -> Offset8+offsetOfE (Size sz) (Offset ty) = Offset (ty * sz)++offsetPlusE :: Offset ty -> Size ty -> Offset ty+offsetPlusE (Offset ofs) (Size sz) = Offset (ofs + sz)++offsetMinusE :: Offset ty -> Size ty -> Offset ty+offsetMinusE (Offset ofs) (Size sz) = Offset (ofs - sz)++offsetRecast :: Size8 -> Size8 -> Offset ty -> Offset ty2+offsetRecast szTy (Size szTy2) ofs =+    let (Offset bytes) = offsetOfE szTy ofs+     in Offset (bytes `div` szTy2)++-- | Size in bytes+--+-- Same caveat as Offset apply here+type Size8 = Size Word8++instance Additive (Size ty) where+    azero = Size 0+    (+) (Size a) (Size b) = Size (a+b)++instance Subtractive (Size ty) where+    type Difference (Size ty) = Size ty+    (Size a) - (Size b) = Size (a-b)++-- | Size in element+newtype Size ty = Size Int+    deriving (Show,Eq,Ord)++sizeOfE :: Size8 -> Size ty -> Size8+sizeOfE (Size sz) (Size ty) = Size (ty * sz)
+ Foundation/Number.hs view
@@ -0,0 +1,387 @@+-- |+-- Module      : Foundation.Number+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Compared to the Haskell hierarchy of number classes+-- this provide a more flexible approach that is closer to the+-- mathematical foundation (group, field, etc)+--+-- This try to only provide one feature per class, at the expense of+-- the number of classes.+--+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DefaultSignatures #-}+module Foundation.Number+    ( Number(..)+    , fromInteger+    , Signed(..)+    , Additive(..)+    , Multiplicative(..)+    , Subtractive(..)+    , Divisible(..)+    , Sign(..)+    ) where++import           Foundation.Internal.Base+import qualified Prelude++infixl 7  *+infixl 6  +, -+infixr 8  ^++-- | Sign of a signed number+data Sign = Negative | Zero | Positive+    deriving (Eq)++orderingToSign :: Ordering -> Sign+orderingToSign EQ = Zero+orderingToSign GT = Negative+orderingToSign LT = Positive++-- | Number literals, convertible through the generic Integer type.+--+-- all number are Enum'erable, meaning that you can move to+-- next element+class (Eq a, Ord a, Prelude.Num a, Enum a, Additive a, Subtractive a, Difference a ~ a, Multiplicative a, Divisible a) => Number a where+    {-# MINIMAL toInteger #-}+    --fromInteger  :: Integer -> a+    toInteger    :: a -> Integer++-- | convert an Integer to a type having the Number constraint+fromInteger :: Number a => Integer -> a+fromInteger = Prelude.fromInteger++-- | Number literals that can be negative+class Number a => Signed a where+    {-# MINIMAL abs, signum #-}+    abs    :: a -> a+    signum :: a -> Sign++-- | Represent class of things that can be added together,+-- contains a neutral element and is commutative.+--+-- * x + azero = x+-- * azero + x = x+-- * x + y = y + x+--+class Additive a where+    {-# MINIMAL azero, (+) #-}+    azero :: a           -- the identity element over addition+    (+)   :: a -> a -> a -- the addition++    scale :: Number n => n -> a -> a -- scale: repeated addition+    default scale :: Number n => n -> a -> a+    scale 0 _ = azero+    scale 1 a = a+    scale 2 a = a + a+    scale n a+        | n < 0     = error "cannot scale by negative number"+        | otherwise = a + scale (pred n) a -- TODO optimise. define by group of 2.++-- | Represent class of things that can be multiplied together+--+-- * x * midentity = x+-- * midentity * x = x+class Multiplicative a where+    {-# MINIMAL midentity, (*) #-}+    -- | Identity element over multiplication+    midentity :: a++    -- | Multiplication of 2 elements that result in another element+    (*) :: a -> a -> a++    -- | Raise to power, repeated multiplication+    -- e.g.+    -- > a ^ 2 = a * a+    -- > a ^ 10 = (a ^ 5) * (a ^ 5) ..+    (^) :: Number n => a -> n -> a+    (^) = power++-- | Represent class of things that can be subtracted.+--+-- Note that the result is not necessary of the same type+-- as the operand depending on the actual type.+--+-- For example:+-- e.g. (-) :: Int -> Int -> Int+--      (-) :: DateTime -> DateTime -> Seconds+--      (-) :: Ptr a -> Ptr a -> PtrDiff+class Subtractive a where+    type Difference a+    (-) :: a -> a -> Difference a++-- | Represent class of things that can be divided+--+-- (x ‘div‘  y) * y + (x ‘mod‘ y) == x+class Multiplicative a => Divisible a where+    {-# MINIMAL (div, mod) | divMod #-}+    div :: a -> a -> a+    div a b = fst $ divMod a b+    mod :: a -> a -> a+    mod a b = snd $ divMod a b+    divMod :: a -> a -> (a, a)+    divMod a b = (div a b, mod a b)++instance Number Integer where+    toInteger i = i+instance Number Int where+    toInteger i = Prelude.fromIntegral i+instance Number Int8 where+    toInteger i = Prelude.fromIntegral i+instance Number Int16 where+    toInteger i = Prelude.fromIntegral i+instance Number Int32 where+    toInteger i = Prelude.fromIntegral i+instance Number Int64 where+    toInteger i = Prelude.fromIntegral i++instance Signed Integer where+    abs = Prelude.abs+    signum = orderingToSign . compare 0+instance Signed Int where+    abs = Prelude.abs+    signum = orderingToSign . compare 0+instance Signed Int8 where+    abs = Prelude.abs+    signum = orderingToSign . compare 0+instance Signed Int16 where+    abs = Prelude.abs+    signum = orderingToSign . compare 0+instance Signed Int32 where+    abs = Prelude.abs+    signum = orderingToSign . compare 0+instance Signed Int64 where+    abs = Prelude.abs+    signum = orderingToSign . compare 0++instance Number Word where+    toInteger i = Prelude.fromIntegral i+instance Number Word8 where+    toInteger i = Prelude.fromIntegral i+instance Number Word16 where+    toInteger i = Prelude.fromIntegral i+instance Number Word32 where+    toInteger i = Prelude.fromIntegral i+instance Number Word64 where+    toInteger i = Prelude.fromIntegral i++instance Additive Integer where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Int where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Int8 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Int16 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Int32 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Int64 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Word where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Word8 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Word16 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Word32 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum+instance Additive Word64 where+    azero = 0+    (+) = (Prelude.+)+    scale = scaleNum++scaleNum :: (Prelude.Num a, Number n) => n -> a -> a+scaleNum n a = (Prelude.fromIntegral $ toInteger n) Prelude.* a++instance Subtractive Integer where+    type Difference Integer = Integer+    (-) = (Prelude.-)+instance Subtractive Int where+    type Difference Int = Int+    (-) = (Prelude.-)+instance Subtractive Int8 where+    type Difference Int8 = Int8+    (-) = (Prelude.-)+instance Subtractive Int16 where+    type Difference Int16 = Int16+    (-) = (Prelude.-)+instance Subtractive Int32 where+    type Difference Int32 = Int32+    (-) = (Prelude.-)+instance Subtractive Int64 where+    type Difference Int64 = Int64+    (-) = (Prelude.-)+instance Subtractive Word where+    type Difference Word = Word+    (-) = (Prelude.-)+instance Subtractive Word8 where+    type Difference Word8 = Word8+    (-) = (Prelude.-)+instance Subtractive Word16 where+    type Difference Word16 = Word16+    (-) = (Prelude.-)+instance Subtractive Word32 where+    type Difference Word32 = Word32+    (-) = (Prelude.-)+instance Subtractive Word64 where+    type Difference Word64 = Word64+    (-) = (Prelude.-)++instance Multiplicative Integer where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Int where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Int8 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Int16 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Int32 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Int64 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Word where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Word8 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Word16 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Word32 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power+instance Multiplicative Word64 where+    midentity = 1+    (*) = (Prelude.*)+    (^) = power++power :: (Number n, Multiplicative a) => a -> n -> a+power a n+    | n < 0     = error "(^): cannot use negative exponent"+    | n == 0    = midentity+    | otherwise = squaring midentity a n+  where+    squaring y x i+        | i == 0    = y+        | i == 1    = x * y+        | even i    = squaring y (x*x) (i`div`2)+        | otherwise = squaring (x*y) (x*x) (pred i`div` 2)++--odd n = (n `mod` 2) /= 0+even :: Number n => n -> Bool+even n = (n `mod` 2) == 0++instance Divisible Integer where+    div = Prelude.div+    mod = Prelude.mod+instance Divisible Int where+    div = Prelude.div+    mod = Prelude.mod+instance Divisible Int8 where+    div = Prelude.div+    mod = Prelude.mod+instance Divisible Int16 where+    div = Prelude.div+    mod = Prelude.mod+instance Divisible Int32 where+    div = Prelude.div+    mod = Prelude.mod+instance Divisible Int64 where+    div = Prelude.div+    mod = Prelude.mod+instance Divisible Word where+    div = Prelude.quot+    mod = Prelude.rem+instance Divisible Word8 where+    div = Prelude.quot+    mod = Prelude.rem+instance Divisible Word16 where+    div = Prelude.quot+    mod = Prelude.rem+instance Divisible Word32 where+    div = Prelude.quot+    mod = Prelude.rem+instance Divisible Word64 where+    div = Prelude.quot+    mod = Prelude.rem++-- {-# RULES scaleNum = * #-}++--numUpSize :: a -> b+--numUpSize+-----------------------------------+{- haskell numerical classes:+ -+Prelude> :i Fractional+class Num a => Fractional a where+  (/) :: a -> a -> a+  recip :: a -> a+  fromRational :: Rational -> a+  	-- Defined in ‘GHC.Real’+instance Fractional Float -- Defined in ‘GHC.Float’+instance Fractional Double -- Defined in ‘GHC.Float’++Prelude> :i Integral+class (Real a, Enum a) => Integral a where+  quot :: a -> a -> a+  rem :: a -> a -> a+  div :: a -> a -> a+  mod :: a -> a -> a+  quotRem :: a -> a -> (a, a)+  divMod :: a -> a -> (a, a)+  toInteger :: a -> Integer+  	-- Defined in ‘GHC.Real’+instance Integral Word -- Defined in ‘GHC.Real’+instance Integral Integer -- Defined in ‘GHC.Real’+instance Integral Int -- Defined in ‘GHC.Real’++Prelude> :i Real+class (Num a, Ord a) => Real a where+  toRational :: a -> Rational+  	-- Defined in ‘GHC.Real’+instance Real Word -- Defined in ‘GHC.Real’+instance Real Integer -- Defined in ‘GHC.Real’+instance Real Int -- Defined in ‘GHC.Real’+instance Real Float -- Defined in ‘GHC.Float’+instance Real Double -- Defined in ‘GHC.Float’+-}
+ Foundation/Partial.hs view
@@ -0,0 +1,80 @@+-- |+-- Module      : Foundation.Partial+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Partial give a way to annotate your partial function with+-- a simple wrapper, which can only evaluated using 'fromPartial'+--+-- > fromPartial ( head [] )+--+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Foundation.Partial+    ( Partial+    , PartialError+    , partialError+    , partial+    , fromPartial+    , head+    , fromJust+    , fromLeft+    , fromRight+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Identity++-- | Partialiality wrapper.+newtype Partial a = Partial (Identity a)+    deriving (Functor, Applicative, Monad)++-- | An error related to the evaluation of a Partial value that failed.+--+-- it contains the name of the function and the reason for failure+data PartialError = PartialError [Char] [Char]+    deriving (Show,Eq,Typeable)++instance Exception PartialError++-- | Throw an asynchronous PartialError+partialError :: [Char] -> [Char] -> a+partialError lbl exp = throw (PartialError lbl exp)++-- | Create a value that is partial. this can only be+-- unwrap using the 'fromPartial' function+partial :: a -> Partial a+partial = pure++-- | Dewrap a possible partial value+fromPartial :: Partial a -> a+fromPartial (Partial ida) = runIdentity ida++-- | Partial function to get the head of a list+head :: [a] -> Partial a+head l = partial $+    case l of+        []  -> partialError "head" "empty list"+        x:_ -> x++-- | Partial function to grab the value inside a Maybe+fromJust :: Maybe a -> Partial a+fromJust x = partial $+    case x of+        Nothing -> partialError "fromJust" "Nothing"+        Just y  -> y++-- Grab the Right value of an Either+fromRight :: Either a b -> Partial b+fromRight x = partial $+    case x of+        Left _ -> partialError "fromRight" "Left"+        Right a -> a++-- Grab the Left value of an Either+fromLeft :: Either a b -> Partial a+fromLeft x = partial $+    case x of+        Right _ -> partialError "fromLeft" "Right"+        Left a -> a
+ Foundation/Primitive.hs view
@@ -0,0 +1,19 @@+-- |+-- Module      : Foundation.Primitive+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Different collections (list, vector, string, ..) unified under 1 API.+-- an API to rules them all, and in the darkness bind them.+--+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+module Foundation.Primitive+    ( PrimType(..)+    , PrimMonad(..)+    ) where++import Foundation.Primitive.Types+import Foundation.Primitive.Monad
+ Foundation/Primitive/FinalPtr.hs view
@@ -0,0 +1,85 @@+-- |+-- Module      : Foundation.Primitive.FinalPtr+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A smaller ForeignPtr reimplementation that work in any prim monad.+--+-- Here be dragon.+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE CPP #-}+module Foundation.Primitive.FinalPtr+    ( FinalPtr(..)+    , finalPtrSameMemory+    , castFinalPtr+    , toFinalPtr+    , toFinalPtrForeign+    , withFinalPtr+    , withUnsafeFinalPtr+    , withFinalPtrNoTouch+    ) where++import GHC.Ptr+import GHC.ForeignPtr+import GHC.IO+import Foundation.Primitive.Monad+import Foundation.Internal.Primitive+import Foundation.Internal.Base (return, Bool(..), (==))++-- | Create a pointer with an associated finalizer+data FinalPtr a = FinalPtr (Ptr a)+                | FinalForeign (ForeignPtr a)++-- | Check if 2 final ptr points on the same memory bits+--+-- it stand to reason that provided a final ptr that is still being referenced+-- and thus have the memory still valid, if 2 final ptrs have the+-- same address, they should be the same final ptr+finalPtrSameMemory :: FinalPtr a -> FinalPtr b -> Bool+finalPtrSameMemory (FinalPtr p1)     (FinalPtr p2)     = p1 == castPtr p2+finalPtrSameMemory (FinalForeign p1) (FinalForeign p2) = p1 == castForeignPtr p2+finalPtrSameMemory (FinalForeign _)  (FinalPtr _)      = False+finalPtrSameMemory (FinalPtr _)      (FinalForeign _)  = False++-- | create a new FinalPtr from a Pointer+toFinalPtr :: PrimMonad prim => Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)+toFinalPtr ptr finalizer = unsafePrimFromIO (primitive makeWithFinalizer)+  where+    makeWithFinalizer s =+        case compatMkWeak# ptr () (finalizer ptr) s of { (# s2, _ #) -> (# s2, FinalPtr ptr #) }++-- | Create a new FinalPtr from a ForeignPtr+toFinalPtrForeign :: ForeignPtr a -> FinalPtr a+toFinalPtrForeign fptr = FinalForeign fptr++-- | Cast a finalized pointer from type a to type b+castFinalPtr :: FinalPtr a -> FinalPtr b+castFinalPtr (FinalPtr a)     = FinalPtr (castPtr a)+castFinalPtr (FinalForeign a) = FinalForeign (castForeignPtr a)++withFinalPtrNoTouch :: FinalPtr p -> (Ptr p -> a) -> a+withFinalPtrNoTouch (FinalPtr ptr) f = f ptr+withFinalPtrNoTouch (FinalForeign fptr) f = f (unsafeForeignPtrToPtr fptr)+{-# INLINE withFinalPtrNoTouch #-}++-- | Looks at the raw pointer inside a FinalPtr, making sure the+-- data pointed by the pointer is not finalized during the call to 'f'+withFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> prim a+withFinalPtr (FinalPtr ptr) f = do+    r <- f ptr+    primTouch ptr+    return r+withFinalPtr (FinalForeign fptr) f = do+    r <- f (unsafeForeignPtrToPtr fptr)+    unsafePrimFromIO (touchForeignPtr fptr)+    return r+{-# INLINE withFinalPtr #-}++-- | Unsafe version of 'withFinalPtr'+withUnsafeFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> a+withUnsafeFinalPtr fptr f = unsafePerformIO (unsafePrimToIO (withFinalPtr fptr f))+{-# NOINLINE withUnsafeFinalPtr #-}
+ Foundation/Primitive/Monad.hs view
@@ -0,0 +1,117 @@+-- |+-- Module      : Foundation.Primitive.Monad+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Allow to run operation in ST and IO, without having to+-- distinguinsh between the two. Most operations exposes+-- the bare nuts and bolts of how IO and ST actually+-- works, and relatively easy to shoot yourself in the foot+--+-- this is highly similar to the Control.Monad.Primitive+-- in the primitive package+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE ExistentialQuantification #-}+module Foundation.Primitive.Monad+    ( PrimMonad(..)+    , unPrimMonad_+    , unsafePrimCast+    , unsafePrimToST+    , unsafePrimToIO+    , unsafePrimFromIO+    , primTouch+    ) where++import qualified Prelude+import           GHC.ST+import           GHC.STRef+import           GHC.IORef+import           GHC.IO+import           GHC.Prim+import           Foundation.Internal.Base (Exception, (.), ($))++-- | Primitive monad that can handle mutation.+--+-- For example: IO and ST.+class (Prelude.Functor m, Prelude.Monad m) => PrimMonad m where+    -- | type of state token associated with the PrimMonad m+    type PrimState m+    -- | type of variable associated with the PrimMonad m+    type PrimVar m :: * -> *+    -- | Unwrap the State# token to pass to a function a primitive function that returns an unboxed state and a value.+    primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a+    -- | Throw Exception in the primitive monad+    primThrow :: Exception e => e -> m a+    -- | Run a Prim monad from a dedicated state#+    unPrimMonad  :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #)++    -- | Build a new variable in the Prim Monad+    primVarNew :: a -> m (PrimVar m a)+    -- | Read the variable in the Prim Monad+    primVarRead :: PrimVar m a -> m a+    -- | Write the variable in the Prim Monad+    primVarWrite :: PrimVar m a -> a -> m ()++-- | just like `unwrapPrimMonad` but throw away the result and return just the new State#+unPrimMonad_ :: PrimMonad m => m () -> State# (PrimState m) -> State# (PrimState m)+unPrimMonad_ p st =+    case unPrimMonad p st of+        (# st', () #) -> st'+{-# INLINE unPrimMonad_ #-}++instance PrimMonad IO where+    type PrimState IO = RealWorld+    type PrimVar IO = IORef+    primitive = IO+    {-# INLINE primitive #-}+    primThrow = throwIO+    unPrimMonad (IO p) = p+    {-# INLINE unPrimMonad #-}+    primVarNew = newIORef+    primVarRead = readIORef+    primVarWrite = writeIORef++instance PrimMonad (ST s) where+    type PrimState (ST s) = s+    type PrimVar (ST s) = STRef s+    primitive = ST+    {-# INLINE primitive #-}+    primThrow = unsafeIOToST . throwIO+    unPrimMonad (ST p) = p+    {-# INLINE unPrimMonad #-}+    primVarNew = newSTRef+    primVarRead = readSTRef+    primVarWrite = writeSTRef++-- | Convert a prim monad to another prim monad.+--+-- The net effect is that it coerce the state repr to another,+-- so the runtime representation should be the same, otherwise+-- hilary ensues.+unsafePrimCast :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a+unsafePrimCast m = primitive (unsafeCoerce# (unPrimMonad m))+{-# INLINE unsafePrimCast #-}++-- | Convert any prim monad to an ST monad+unsafePrimToST :: PrimMonad prim => prim a -> ST s a+unsafePrimToST = unsafePrimCast+{-# INLINE unsafePrimToST #-}++-- | Convert any prim monad to an IO monad+unsafePrimToIO :: PrimMonad prim => prim a -> IO a+unsafePrimToIO = unsafePrimCast+{-# INLINE unsafePrimToIO #-}++-- | Convert any IO monad to a prim monad+unsafePrimFromIO :: PrimMonad prim => IO a -> prim a+unsafePrimFromIO = unsafePrimCast+{-# INLINE unsafePrimFromIO #-}++-- | Touch primitive lifted to any prim monad+primTouch :: PrimMonad m => a -> m ()+primTouch x = unsafePrimFromIO $ primitive $ \s -> case touch# x s of { s2 -> (# s2, () #) }+{-# INLINE primTouch #-}
+ Foundation/Primitive/Types.hs view
@@ -0,0 +1,281 @@+-- |+-- Module      : Foundation.Primitive.Types+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+module Foundation.Primitive.Types+    ( PrimType(..)+    , primOffsetOfE+    , primOffsetRecast+    , sizeRecast+    , offsetAsSize+    , sizeAsOffset+    ) where++import           GHC.Prim+import           GHC.Int+import           GHC.Types+import           GHC.Word+import           Foundation.Internal.Proxy+import           Foundation.Internal.Base+import           Foundation.Internal.Types+import           Foundation.Primitive.Monad+import qualified Prelude (quot)++-- | Represent the accessor for types that can be stored in the UArray and MUArray.+--+-- Types need to be a instance of storable and have fixed sized.+class Eq ty => PrimType ty where+    -- | get the size in bytes of a ty element+    primSizeInBytes :: Proxy ty -> Size8++    -----+    -- ByteArray section+    -----++    -- | return the element stored at a specific index+    primBaIndex :: ByteArray# -> Offset ty -> ty++    -----+    -- MutableByteArray section+    -----++    -- | Read an element at an index in a mutable array+    primMbaRead :: PrimMonad prim+                => MutableByteArray# (PrimState prim) -- ^ mutable array to read from+                -> Offset ty                         -- ^ index of the element to retrieve+                -> prim ty                           -- ^ the element returned++    -- | Write an element to a specific cell in a mutable array.+    primMbaWrite :: PrimMonad prim+                 => MutableByteArray# (PrimState prim) -- ^ mutable array to modify+                 -> Offset ty                         -- ^ index of the element to modify+                 -> ty                                 -- ^ the new value to store+                 -> prim ()++    -----+    -- Addr# section+    -----++    -- | Read from Address, without a state. the value read should be considered a constant for all+    -- pratical purpose, otherwise bad thing will happens.+    primAddrIndex :: Addr# -> Offset ty -> ty++    -- | Read a value from Addr in a specific primitive monad+    primAddrRead :: PrimMonad prim+                 => Addr#+                 -> Offset ty+                 -> prim ty+    -- | Write a value to Addr in a specific primitive monad+    primAddrWrite :: PrimMonad prim+                  => Addr#+                  -> Offset ty+                  -> ty+                  -> prim ()++{-# SPECIALIZE [3] primBaIndex :: ByteArray# -> Offset Word8 -> Word8 #-}++instance PrimType Word8 where+    primSizeInBytes _ = Size 1+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = W8# (indexWord8Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord8Array# mba n s1 in (# s2, W8# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (W8# w) = primitive $ \s1 -> (# writeWord8Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = W8# (indexWord8OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord8OffAddr# addr n s1 in (# s2, W8# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W8# w) = primitive $ \s1 -> (# writeWord8OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Word16 where+    primSizeInBytes _ = Size 2+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = W16# (indexWord16Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord16Array# mba n s1 in (# s2, W16# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (W16# w) = primitive $ \s1 -> (# writeWord16Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = W16# (indexWord16OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord16OffAddr# addr n s1 in (# s2, W16# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W16# w) = primitive $ \s1 -> (# writeWord16OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Word32 where+    primSizeInBytes _ = Size 4+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = W32# (indexWord32Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord32Array# mba n s1 in (# s2, W32# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (W32# w) = primitive $ \s1 -> (# writeWord32Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = W32# (indexWord32OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord32OffAddr# addr n s1 in (# s2, W32# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W32# w) = primitive $ \s1 -> (# writeWord32OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Word64 where+    primSizeInBytes _ = Size 8+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = W64# (indexWord64Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord64Array# mba n s1 in (# s2, W64# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (W64# w) = primitive $ \s1 -> (# writeWord64Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = W64# (indexWord64OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWord64OffAddr# addr n s1 in (# s2, W64# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (W64# w) = primitive $ \s1 -> (# writeWord64OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int8 where+    primSizeInBytes _ = Size 1+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = I8# (indexInt8Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt8Array# mba n s1 in (# s2, I8# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (I8# w) = primitive $ \s1 -> (# writeInt8Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = I8# (indexInt8OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt8OffAddr# addr n s1 in (# s2, I8# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I8# w) = primitive $ \s1 -> (# writeInt8OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int16 where+    primSizeInBytes _ = Size 2+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = I16# (indexInt16Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt16Array# mba n s1 in (# s2, I16# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (I16# w) = primitive $ \s1 -> (# writeInt16Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = I16# (indexInt16OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt16OffAddr# addr n s1 in (# s2, I16# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I16# w) = primitive $ \s1 -> (# writeInt16OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int32 where+    primSizeInBytes _ = Size 4+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = I32# (indexInt32Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt32Array# mba n s1 in (# s2, I32# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (I32# w) = primitive $ \s1 -> (# writeInt32Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = I32# (indexInt32OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt32OffAddr# addr n s1 in (# s2, I32# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I32# w) = primitive $ \s1 -> (# writeInt32OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Int64 where+    primSizeInBytes _ = Size 8+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = I64# (indexInt64Array# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt64Array# mba n s1 in (# s2, I64# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (I64# w) = primitive $ \s1 -> (# writeInt64Array# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = I64# (indexInt64OffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readInt64OffAddr# addr n s1 in (# s2, I64# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (I64# w) = primitive $ \s1 -> (# writeInt64OffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Float where+    primSizeInBytes _ = Size 4+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = F# (indexFloatArray# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readFloatArray# mba n s1 in (# s2, F# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (F# w) = primitive $ \s1 -> (# writeFloatArray# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = F# (indexFloatOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readFloatOffAddr# addr n s1 in (# s2, F# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (F# w) = primitive $ \s1 -> (# writeFloatOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}+instance PrimType Double where+    primSizeInBytes _ = Size 8+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = D# (indexDoubleArray# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readDoubleArray# mba n s1 in (# s2, D# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (D# w) = primitive $ \s1 -> (# writeDoubleArray# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = D# (indexDoubleOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readDoubleOffAddr# addr n s1 in (# s2, D# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (D# w) = primitive $ \s1 -> (# writeDoubleOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++instance PrimType Char where+    primSizeInBytes _ = Size 4+    {-# INLINE primSizeInBytes #-}+    primBaIndex ba (Offset (I# n)) = C# (indexWideCharArray# ba n)+    {-# INLINE primBaIndex #-}+    primMbaRead mba (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWideCharArray# mba n s1 in (# s2, C# r #)+    {-# INLINE primMbaRead #-}+    primMbaWrite mba (Offset (I# n)) (C# w) = primitive $ \s1 -> (# writeWideCharArray# mba n w s1, () #)+    {-# INLINE primMbaWrite #-}+    primAddrIndex addr (Offset (I# n)) = C# (indexWideCharOffAddr# addr n)+    {-# INLINE primAddrIndex #-}+    primAddrRead addr (Offset (I# n)) = primitive $ \s1 -> let (# s2, r #) = readWideCharOffAddr# addr n s1 in (# s2, C# r #)+    {-# INLINE primAddrRead #-}+    primAddrWrite addr (Offset (I# n)) (C# w) = primitive $ \s1 -> (# writeWideCharOffAddr# addr n w s1, () #)+    {-# INLINE primAddrWrite #-}++-- | Cast a Size linked to type A (Size A) to a Size linked to type B (Size B)+sizeRecast :: (PrimType a, PrimType b) => Size a -> Size b+sizeRecast = doRecast Proxy Proxy+  where doRecast :: (PrimType a, PrimType b) => Proxy a -> Proxy b -> Size a -> Size b+        doRecast pa pb sz =+            let szA          = primSizeInBytes pa+                (Size szB)   = primSizeInBytes pb+                (Size bytes) = sizeOfE szA sz+             in Size (bytes `Prelude.quot` szB)++primOffsetRecast :: (PrimType a, PrimType b) => Offset a -> Offset b+primOffsetRecast = doRecast Proxy Proxy+  where doRecast :: (PrimType a, PrimType b) => Proxy a -> Proxy b -> Offset a -> Offset b+        doRecast pa pb ofs =+            let szA            = primSizeInBytes pa+                (Size szB)     = primSizeInBytes pb+                (Offset bytes) = offsetOfE szA ofs+             in Offset (bytes `Prelude.quot` szB)++primOffsetOfE :: PrimType a => Offset a -> Offset8+primOffsetOfE = getOffset Proxy+  where getOffset :: PrimType a => Proxy a -> Offset a -> Offset8+        getOffset proxy = offsetOfE (primSizeInBytes proxy)++sizeAsOffset :: Size a -> Offset a+sizeAsOffset (Size a) = Offset a+{-# INLINE sizeAsOffset #-}++offsetAsSize :: Offset a -> Size a+offsetAsSize (Offset a) = Size a+{-# INLINE offsetAsSize #-}
+ Foundation/Primitive/Utils.hs view
@@ -0,0 +1,72 @@+-- |+-- Module      : Foundation.Primitive.Utils+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+module Foundation.Primitive.Utils+    ( primCopyFreezedBytes+    , primCopyFreezedBytesOffset+    , primCopyFreezedW32+    , primCopyFreezedW64+    , primMutableAddrSlideToStart+    , primMutableByteArraySlideToStart+    ) where++import           Foundation.Internal.Base+import           Foundation.Internal.Types+import           Foundation.Internal.Primitive+import           Foundation.Primitive.Monad+import           GHC.Prim+import           GHC.Types++-- | Copy all bytes from a byteArray# to a mutableByteArray#+primCopyFreezedBytes :: PrimMonad m => MutableByteArray# (PrimState m) -> ByteArray# -> m ()+primCopyFreezedBytes mba ba = primitive $ \st ->+    (# copyByteArray# ba 0# mba 0# (sizeofByteArray# ba) st , () #)+{-# INLINE primCopyFreezedBytes #-}++-- | Copy @nbBytes bytes from a byteArray# to a mutableByteArray# starting at an offset+primCopyFreezedBytesOffset :: PrimMonad m => MutableByteArray# (PrimState m) -> Int# -> ByteArray# -> Int# -> m ()+primCopyFreezedBytesOffset mba ofs ba nbBytes = primitive $ \st ->+    (# copyByteArray# ba 0# mba ofs nbBytes st , () #)+{-# INLINE primCopyFreezedBytesOffset #-}++-- | same as 'primCopyFreezedBytes' except copy using 32 bits word+primCopyFreezedW32 :: PrimMonad m => MutableByteArray# (PrimState m) -> ByteArray# -> m ()+primCopyFreezedW32 mba ba = primitive $ \st -> (# loop st 0#, () #)+  where+    !len = quotInt# (sizeofByteArray# ba) 8#+    loop !st !n+        | bool# (n ==# len) = st+        | otherwise         = loop (writeWord32Array# mba n (indexWord32Array# ba n) st) (n +# 1#)+    {-# INLINE loop #-}+{-# INLINE primCopyFreezedW32 #-}++-- | same as 'primCopyFreezedBytes' except copy using 64 bits word+primCopyFreezedW64 :: PrimMonad m => MutableByteArray# (PrimState m) -> ByteArray# -> m ()+primCopyFreezedW64 mba ba = primitive $ \st -> (# loop st 0#, () #)+  where+    !len = quotInt# (sizeofByteArray# ba) 8#+    loop !st !n+        | bool# (n ==# len) = st+        | otherwise         = loop (writeWord64Array# mba n (indexWord64Array# ba n) st) (n +# 1#)+    {-# INLINE loop #-}+{-# INLINE primCopyFreezedW64 #-}++primMutableByteArraySlideToStart :: PrimMonad m => MutableByteArray# (PrimState m) -> Offset8 -> Offset8 -> m ()+primMutableByteArraySlideToStart mba (Offset (I# ofs)) (Offset (I# end)) = primitive $ \st ->+    (# copyMutableByteArray# mba 0# mba ofs (end -# ofs) st, () #)++primMutableAddrSlideToStart :: PrimMonad m => Addr# -> Offset8 -> Offset8 -> m ()+primMutableAddrSlideToStart addr (Offset (I# ofsIni)) (Offset (I# end)) = primitive $ \st -> (# loop st 0# ofsIni, () #)+  where+    loop !st !dst !ofs+        | bool# (ofs ==# end) = st+        | otherwise           =+            case readWord8OffAddr# addr ofs st of { (# st', v #) ->+            case writeWord8OffAddr# addr dst v st' of { st'' ->+                loop st'' (dst +# 1#) (ofs +# 1#) }}
+ Foundation/Strict.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Foundation.Strict+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : stable+-- Portability : portable+--+-- Enforce strictness when executing lambda+--++module Foundation.Strict+    ( strict1+    , strict2+    , strict3+    , strict4+    , strict5+    , strict6+    ) where++strict1 :: (a -> b) -> a -> b+strict1 f !a = f a++strict2 :: (a -> b -> c) -> a -> b -> c+strict2 f !a !b = f a b++strict3 :: (a -> b -> c -> d) -> a -> b -> c -> d+strict3 f !a !b !c = f a b c++strict4 :: (a -> b -> c -> d -> e) -> a -> b -> c -> d -> e+strict4 f !a !b !c !d = f a b c d++strict5 :: (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> e -> f+strict5 f !a !b !c !d !e = f a b c d e++strict6 :: (a -> b -> c -> d -> e -> f -> g) -> a -> b -> c -> d -> e -> f -> g+strict6 f !a !b !c !d !e !g = f a b c d e g+
+ Foundation/String.hs view
@@ -0,0 +1,35 @@+-- |+-- Module      : Foundation.String+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- Opaque packed String encoded in UTF8.+--+-- The type is an instance of IsString and IsList, which allow OverloadedStrings+-- for string literal, and 'fromList' to convert a [Char] (Prelude String) to a packed+-- representation+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > s = "Hello World :: String+--+-- > s = fromList ("Hello World" :: Prelude.String) :: String+--+-- Each unicode code point is represented by a variable encoding of 1 to 4 bytes,+--+-- For more information about UTF8: <https://en.wikipedia.org/wiki/UTF-8>+--+module Foundation.String+    ( String+    , Encoding(..)+    , fromBytes+    , fromBytesLenient+    , fromBytesUnsafe+    , toBytes+    , ValidationFailure(..)+    , lines+    , words+    ) where++import Foundation.String.UTF8
+ Foundation/String/Encoding/ASCII7.hs view
@@ -0,0 +1,86 @@+-- |+-- Module      : Foundation.String.Encoding.ASCII7+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE MagicHash #-}++module Foundation.String.Encoding.ASCII7+    ( ASCII7(..)+    , ASCII7_Invalid(..)+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Types+import Foundation.Number+import Foundation.Primitive.Monad++import GHC.Prim+import GHC.Word+import GHC.Types+import Foundation.Array.Unboxed.Builder++import Foundation.String.Encoding.Encoding++-- | validate a given byte is within ASCII characters encoring size+--+-- This function check the 8th bit is set to 0+--+isAscii :: Word8 -> Bool+isAscii (W8# w) = W8# (and# w 0x80## ) == 0+{-# INLINE isAscii #-}++-- offset of size one+aone :: Offset Word8+aone = Offset 1++data ASCII7_Invalid+    = ByteOutOfBound Word8+    | CharNotAscii   Char+  deriving (Typeable, Show, Eq)+instance Exception ASCII7_Invalid++data ASCII7 = ASCII7++instance Encoding ASCII7 where+    type Unit ASCII7 = Word8+    type Error ASCII7 = ASCII7_Invalid+    encodingNext  _ = next+    encodingWrite _ = write++-- | consume an Ascii7 char and return the Unicode point and the position+-- of the next possible Ascii7 char+--+next :: (Offset Word8 -> Word8)+          -- ^ method to access a given byte+     -> Offset Word8+          -- ^ index of the byte+     -> Either ASCII7_Invalid (Char, Offset Word8)+          -- ^ either successfully validated the ASCII char and returned the+          -- next index or fail with an error+next getter off+    | isAscii w8 = Right (toChar w, off + aone)+    | otherwise  = Left $ ByteOutOfBound w8+  where+    !w8@(W8# w) = getter off+    toChar :: Word# -> Char+    toChar a = C# (chr# (word2Int# a))++-- Write ascii char+--+-- > build 64 $ sequence_ write "this is a simple list of char..."+--+write :: (PrimMonad st, Monad st)+      => Char+           -- ^ expecting it to be a valid Ascii character.+           -- otherwise this function will throw an exception+      -> ArrayBuilder Word8 st ()+write c+    | c < toEnum 0x80 = appendTy $ w8 c+    | otherwise       = throw $ CharNotAscii c+  where+    w8 :: Char -> Word8+    w8 (C# ch) = W8# (int2Word# (ord# ch))
+ Foundation/String/Encoding/Encoding.hs view
@@ -0,0 +1,102 @@+-- |+-- Module      : Foundation.String.Encoding.Encoding+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE FlexibleContexts #-}++module Foundation.String.Encoding.Encoding+    ( Encoding(..)+    , convertFromTo+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Types+import Foundation.Primitive.Monad+import Foundation.Primitive.Types+import Foundation.Array.Unboxed.Builder+import Foundation.Number+import qualified Foundation.Collection as C+import           Foundation.Array.Unboxed (UArray)+import qualified Foundation.Array.Unboxed as Vec++class Encoding encoding where+    -- | the unit element use for the encoding.+    -- i.e. Word8 for ASCII7 or UTF8, Word16 for UTF16...+    --+    type Unit encoding++    -- | define the type of error handling you want to use for the+    -- next function.+    --+    -- > type Error UTF8 = Either UTF8_Invalid+    --+    type Error encoding++    -- | consume an `Unit encoding` and return the Unicode point and the position+    -- of the next possible `Unit encoding`+    --+    encodingNext :: encoding+                      -- ^ only used for type deduction+                -> (Offset (Unit encoding) -> Unit encoding)+                      -- ^ method to access a given `Unit encoding`+                      -- (see `unsafeIndexer`)+                -> Offset (Unit encoding)+                      -- ^ offset of the `Unit encoding` where starts the+                      -- encoding of a given unicode+                -> Either (Error encoding) (Char, Offset (Unit encoding))+                      -- ^ either successfully validated the `Unit encoding`+                      -- and returned the next offset or fail with an+                      -- `Error encoding`++    -- Write a unicode point encoded into one or multiple `Unit encoding`+    --+    -- > build 64 $ sequence_ (write UTF8) "this is a simple list of char..."+    --+    encodingWrite :: (PrimMonad st, Monad st)+                  => encoding+                      -- ^ only used for type deduction+                  -> Char+                      -- ^ the unicode character to encode+                  -> ArrayBuilder (Unit encoding) st ()++-- | helper to convert a given Array in a given encoding into an array+-- with another encoding.+--+-- This is a helper to convert from one String encoding to another.+-- This function is (quite) slow and needs some work.+--+-- ```+-- let s16 = ... -- string in UTF16+-- -- create s8, a UTF8 String+-- let s8  = runST $ convertWith UTF16 UTF8 (toBytes s16)+--+-- print s8+-- ```+--+convertFromTo :: ( PrimMonad st, Monad st+                 , Encoding input, PrimType (Unit input)+                 , Exception (Error input)+                 , Encoding output, PrimType (Unit output)+                 )+              => input+                -- ^ Input's encoding type+              -> output+                -- ^ Output's encoding type+              -> UArray (Unit input)+                -- ^ the input raw array+              -> st (UArray (Unit output))+convertFromTo inputEncodingTy outputEncodingTy bytes+    | C.null bytes = return mempty+    | otherwise    = Vec.unsafeIndexer bytes $ \t -> build 64 (loop azero t)+  where+    lastUnit = Offset $ C.length bytes++    loop off getter+      | off >= lastUnit = return ()+      | otherwise = case encodingNext inputEncodingTy getter off of+          Left err -> throw err+          Right (c, noff) -> encodingWrite outputEncodingTy c >> loop noff getter
+ Foundation/String/Encoding/ISO_8859_1.hs view
@@ -0,0 +1,62 @@+-- |+-- Module      : Foundation.String.Encoding.ISO_8859_1+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE MagicHash #-}++module Foundation.String.Encoding.ISO_8859_1+    ( ISO_8859_1(..)+    , ISO_8859_1_Invalid(..)+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Types+import Foundation.Number+import Foundation.Primitive.Monad++import GHC.Prim+import GHC.Word+import GHC.Types+import Foundation.Array.Unboxed.Builder++import Foundation.String.Encoding.Encoding++-- offset of size one+aone :: Offset Word8+aone = Offset 1++data ISO_8859_1_Invalid+    = NotISO_8859_1 Char+  deriving (Typeable, Show, Eq)+instance Exception ISO_8859_1_Invalid++data ISO_8859_1 = ISO_8859_1++instance Encoding ISO_8859_1 where+    type Unit ISO_8859_1 = Word8+    type Error ISO_8859_1 = ISO_8859_1_Invalid+    encodingNext  _ = next+    encodingWrite _ = write++next :: (Offset Word8 -> Word8)+     -> Offset Word8+     -> Either ISO_8859_1_Invalid (Char, Offset Word8)+next getter off = Right (toChar w, off + aone)+  where+    !(W8# w) = getter off+    toChar :: Word# -> Char+    toChar a = C# (chr# (word2Int# a))++write :: (PrimMonad st, Monad st)+      => Char+      -> ArrayBuilder Word8 st ()+write c@(C# ch)+    | c <= toEnum 0xFF = appendTy (W8# x)+    | otherwise       = throw $ NotISO_8859_1 c+  where+    x :: Word#+    !x = int2Word# (ord# ch)
+ Foundation/String/Encoding/UTF16.hs view
@@ -0,0 +1,95 @@+-- |+-- Module      : Foundation.String.Encoding.UTF16+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+module Foundation.String.Encoding.UTF16+    ( UTF16(..)+    , UTF16_Invalid(..)+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Types+import Foundation.Primitive.Monad+import GHC.Prim+import GHC.Word+import GHC.Types+import Foundation.Number+import Data.Bits+import qualified Prelude+import Foundation.Array.Unboxed.Builder++import Foundation.String.Encoding.Encoding++data UTF16_Invalid+    = InvalidContinuation+    | InvalidUnicode Char+  deriving (Show, Eq, Typeable)+instance Exception UTF16_Invalid++data UTF16 = UTF16++instance Encoding UTF16 where+    type Unit UTF16 = Word16+    type Error UTF16 = UTF16_Invalid+    encodingNext  _ = next+    encodingWrite _ = write+++--+-- U+0000 to U+D7FF and U+E000 to U+FFFF : 1 bytes+-- U+10000 to U+10FFFF :+--    * 0x010000 is subtracted from the code point, leaving a 20-bit number in the range 0..0x0FFFFF.+--    * The top ten bits (a number in the range 0..0x03FF) are added to 0xD800 to give the first 16-bit code unit+--      or high surrogate, which will be in the range 0xD800..0xDBFF.+--    * The low ten bits (also in the range 0..0x03FF) are added to 0xDC00 to give the second 16-bit code unit+--      or low surrogate, which will be in the range 0xDC00..0xDFFF.++next :: (Offset Word16 -> Word16)+     -> Offset Word16+     -> Either UTF16_Invalid (Char, Offset Word16)+next getter off+    | h <  0xd800 = Right (toChar hh, off + Offset 1)+    | h >= 0xe000 = Right (toChar hh, off + Offset 1)+    | otherwise   = nextContinuation+  where+    h :: Word16+    !h@(W16# hh) = getter off+    toChar :: Word# -> Char+    toChar w = C# (chr# (word2Int# w))+    to32 :: Word16 -> Word32+    to32 (W16# w) = W32# w++    nextContinuation+        | cont >= 0xdc00 && cont < 0xe00 =+            let !(W32# w) = ((to32 h .&. 0x3ff) `shiftL` 10)+                         .|. (to32 cont .&. 0x3ff)+             in Right (toChar w, off + Offset 2)+        | otherwise = Left InvalidContinuation+      where+        cont :: Word16+        !cont = getter $ off + Offset 1++write :: (PrimMonad st, Monad st)+      => Char+      -> ArrayBuilder Word16 st ()+write c+    | c < toEnum 0xd800   = appendTy $ w16 c+    | c > toEnum 0x10000  = let (w1, w2) = wHigh c in appendTy w1 >> appendTy w2+    | c > toEnum 0x10ffff = throw $ InvalidUnicode c+    | c >= toEnum 0xe000  = appendTy $ w16 c+    | otherwise = throw $ InvalidUnicode c+  where+    w16 :: Char -> Word16+    w16 (C# ch) = W16# (int2Word# (ord# ch))++    to16 :: Word32 -> Word16+    to16 = Prelude.fromIntegral++    wHigh :: Char -> (Word16, Word16)+    wHigh (C# ch) =+        let v = W32# (minusWord# (int2Word# (ord# ch)) 0x10000##)+         in (0xdc00 .|. to16 (v `shiftR` 10), 0xd800 .|. to16 (v .&. 0x3ff))
+ Foundation/String/Encoding/UTF32.hs view
@@ -0,0 +1,53 @@+-- |+-- Module      : Foundation.String.Encoding.UTF32+-- License     : BSD-style+-- Maintainer  : Foundation+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE MagicHash #-}+module Foundation.String.Encoding.UTF32+    ( UTF32(..)+    , UTF32_Invalid+    ) where++import Foundation.Internal.Base+import Foundation.Internal.Types+import Foundation.Primitive.Monad+import GHC.Prim+import GHC.Word+import GHC.Types+import Foundation.Number+import Foundation.Array.Unboxed.Builder++import Foundation.String.Encoding.Encoding++data UTF32 = UTF32++data UTF32_Invalid = UTF32_Invalid+  deriving (Typeable, Show, Eq, Ord, Enum, Bounded)+instance Exception UTF32_Invalid++instance Encoding UTF32 where+    type Unit UTF32 = Word32+    type Error UTF32 = UTF32_Invalid+    encodingNext  _ = next+    encodingWrite _ = write++next :: (Offset Word32 -> Word32)+     -> Offset Word32+     -> Either UTF32_Invalid (Char, Offset Word32)+next getter off = Right (char, off + Offset 1)+  where+    !(W32# hh) = getter off+    char :: Char+    char = C# (chr# (word2Int# hh))++write :: (PrimMonad st, Monad st)+      => Char+      -> ArrayBuilder Word32 st ()+write c = appendTy w32+  where+    !(C# ch) = c+    w32 :: Word32+    w32 = W32# (int2Word# (ord# ch))
+ Foundation/String/Internal.hs view
@@ -0,0 +1,10 @@+-- |+-- Module      : Foundation.String.Internal+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+module Foundation.String.Internal+    (+    ) where
+ Foundation/String/ModifiedUTF8.hs view
@@ -0,0 +1,81 @@+-- |+-- Module      : Foundation.String.ModifiedUTF8+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--+-- A String type backed by a Modified UTF8 encoded byte array and all the+-- necessary functions to manipulate the string.+--+-- You can think of String as a specialization of a byte array that+-- have element of type Char.+--+-- The String data must contain UTF8 valid data.+--++{-# LANGUAGE MagicHash #-}+module Foundation.String.ModifiedUTF8+    ( fromModified+    ) where++import           GHC.ST (runST, ST)+import           GHC.Prim (Addr#)+import           GHC.Ptr (Ptr(..))+import qualified Control.Monad (mapM)++import           Foundation.Internal.Base+import           Foundation.Internal.Types+import qualified Foundation.Array.Unboxed as Vec+import           Foundation.Array.Unboxed (UArray)+import           Foundation.Number+import           Foundation.Array.Unboxed.Builder+import           Foundation.Primitive.FinalPtr+import           Foundation.String.UTF8Table++-- offset of size one+aone :: Offset Word8+aone = Offset 1++-- helper function to read some bytes from the given byte reader+accessBytes :: Offset Word8 -> (Offset Word8 -> Word8) -> ([Word8], Offset Word8)+accessBytes offset getAtIdx = (loop offset, pastEnd)+  where+    nbytes :: Size Word8+    nbytes = Size $ getNbBytes $ getAtIdx offset+    pastEnd :: Offset Word8+    pastEnd = aone + (offset `offsetPlusE` nbytes)+    loop :: Offset Word8 -> [Word8]+    loop off+        | off == pastEnd = []+        | otherwise      = getAtIdx off : loop (off + aone)++buildByteArray :: Addr# -> ST st (UArray Word8)+buildByteArray addr = Vec.UVecAddr (Offset 0) (Size 100000) `fmap`+    toFinalPtr (Ptr addr) (\_ -> return ())++-- | assuming the given ByteArray is a valid modified UTF-8 sequence of bytes+--+-- We only modify the given Unicode Null-character (0xC080) into a null bytes+--+-- FIXME: need to evaluate the kind of modified UTF8 GHC is actually expecting+-- it is plausible they only handle the Null Bytes, which this function actually+-- does.+fromModified :: Addr# -> UArray Word8+fromModified addr = runST $ do+    ba <- buildByteArray addr+    Vec.unsafeIndexer ba buildWithBytes+  where+    buildWithBytes getAt = build 64 $ loopBuilder getAt (Offset 0)+    loopBuilder getAt offset =+        let (bs, noffset) = accessBytes offset getAt+         in case bs of+              [] -> internalError "ModifiedUTF8.fromModified"+              [0x00] -> return ()+              [b1,b2] | b1 == 0xC0 && b2 == 0x80 -> appendTy 0x00 >> loopBuilder getAt noffset+              _ -> Control.Monad.mapM appendTy bs >> loopBuilder getAt noffset++{-+toModified :: ByteArray -> ByteArray+toModified = undefined+-}
+ Foundation/String/UTF8.hs view
@@ -0,0 +1,962 @@+-- |+-- Module      : Foundation.String.UTF8+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- A String type backed by a UTF8 encoded byte array and all the necessary+-- functions to manipulate the string.+--+-- You can think of String as a specialization of a byte array that+-- have element of type Char.+--+-- The String data must contain UTF8 valid data.+--+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UnboxedTuples              #-}+{-# LANGUAGE FlexibleContexts           #-}+module Foundation.String.UTF8+    ( String(..)+    --, Buffer+    , create+    , replicate+    -- * Binary conversion+    , Encoding(..)+    , fromBytes+    , fromChunkBytes+    , fromBytesUnsafe+    , fromBytesLenient+    , toBytes+    , mutableValidate+    , ValidationFailure(..)+    -- * Legacy utility+    , lines+    , words+    ) where++import           Foundation.Array.Unboxed           (UArray)+import qualified Foundation.Array.Unboxed           as Vec+import           Foundation.Array.Unboxed.ByteArray (MutableByteArray)+import qualified Foundation.Array.Unboxed.Mutable   as MVec+import qualified Foundation.Collection              as C+import           Foundation.Internal.Base+import           Foundation.Internal.Primitive+import           Foundation.Internal.Types+import           Foundation.Number+import           Foundation.Primitive.Monad+import           Foundation.Primitive.Types+import           Foundation.String.UTF8Table+import           GHC.Prim+import           GHC.ST+import           GHC.Types+import           GHC.Word+import           Foundation.Array.Unboxed.Builder (ArrayBuilder, appendTy)++ -- temporary+import qualified Data.List+import           Data.Data+import qualified Prelude++import           Foundation.String.ModifiedUTF8     (fromModified)+import           GHC.CString                  (unpackCString#,+                                               unpackCStringUtf8#)++import qualified Foundation.String.Encoding.Encoding   as Encoder+import qualified Foundation.String.Encoding.ASCII7     as Encoder+import qualified Foundation.String.Encoding.UTF16      as Encoder+import qualified Foundation.String.Encoding.UTF32      as Encoder+import qualified Foundation.String.Encoding.ISO_8859_1 as Encoder++-- | Opaque packed array of characters in the UTF8 encoding+newtype String = String (UArray Word8)+    deriving (Typeable, Monoid, Eq, Ord)++newtype MutableString st = MutableString (MutableByteArray st)+    deriving (Typeable)++instance Show String where+    show = show . sToList+instance IsString String where+    fromString = sFromList+instance IsList String where+    type Item String = Char+    fromList = sFromList+    toList = sToList++type instance C.Element String = Char++instance C.InnerFunctor String where+    imap = charMap+instance C.Sequential String where+    null = null+    take = take+    drop = drop+    splitAt = splitAt+    revTake = revTake+    revDrop = revDrop+    revSplitAt = revSplitAt+    splitOn = splitOn+    break = break+    breakElem = breakElem+    intersperse = intersperse+    span = span+    filter = filter+    reverse = reverse+    unsnoc = unsnoc+    uncons = uncons+    snoc = snoc+    cons = cons+    find = find+    sortBy = sortBy+    length = length+    singleton = fromList . (:[])++instance C.Zippable String where+  -- TODO Use a string builder once available+  zipWith f a b = sFromList (C.zipWith f a b)++data ValidationFailure = InvalidHeader+                       | InvalidContinuation+                       | MissingByte+                       deriving (Show,Eq,Typeable)++instance Exception ValidationFailure++data EncoderUTF8 = EncoderUTF8++instance Encoder.Encoding EncoderUTF8 where+    type Unit EncoderUTF8 = Word8+    type Error EncoderUTF8 = ValidationFailure+    encodingNext  _ = \ofs -> Right . nextWithIndexer ofs+    encodingWrite _ = writeWithBuilder++-- | Validate a bytearray for UTF8'ness+--+-- On success Nothing is returned+-- On Failure the position along with the failure reason+validate :: UArray Word8+         -> Offset8+         -> Size Word8+         -> (Offset8, Maybe ValidationFailure)+validate ba ofsStart sz = runST (Vec.unsafeIndexer ba go)+  where+    end = ofsStart `offsetPlusE` sz++    go :: (Offset Word8 -> Word8) -> ST s (Offset Word8, Maybe ValidationFailure)+    go getIdx = return $ loop ofsStart+      where+        loop ofs+            | ofs > end  = error "validate: internal error: went pass offset"+            | ofs == end = (end, Nothing)+            | otherwise  =+                case {-# SCC "validate.one" #-} one ofs of+                    (nextOfs, Nothing)  -> loop nextOfs+                    (pos, Just failure) -> (pos, Just failure)++        one pos =+            case nbConts of+                0    -> (pos + o1, Nothing)+                0xff -> (pos, Just InvalidHeader)+                _ | (pos + o1) `offsetPlusE` nbContsE > end -> (pos, Just MissingByte)+                1    ->+                    let c1 = getIdx (pos + o1)+                     in if isContinuation c1+                            then (pos + Offset 2, Nothing)+                            else (pos, Just InvalidContinuation)+                2 ->+                    let c1 = getIdx (pos + o1)+                        c2 = getIdx (pos + Offset 2)+                     in if isContinuation c1 && isContinuation c2+                            then (pos + Offset 3, Nothing)+                            else (pos, Just InvalidContinuation)+                3 ->+                    let c1 = getIdx (pos + Offset 1)+                        c2 = getIdx (pos + Offset 2)+                        c3 = getIdx (pos + Offset 3)+                     in if isContinuation c1 && isContinuation c2 && isContinuation c3+                            then (pos + Offset 4, Nothing)+                            else (pos, Just InvalidContinuation)+                _ -> error "internal error"+          where+            !h = getIdx pos+            !nbContsE@(Size nbConts) = Size $ getNbBytes h+    {-# INLINE go #-}++    o1 = Offset 1++mutableValidate :: PrimMonad prim+                => MutableByteArray (PrimState prim)+                -> Int+                -> Int+                -> prim (Int, Maybe ValidationFailure)+mutableValidate mba ofsStart sz = do+    loop ofsStart+  where+    end = ofsStart + sz++    loop ofs+        | ofs > end  = error "mutableValidate: internal error: went pass offset"+        | ofs == end = return (end, Nothing)+        | otherwise  = do+            r <- one ofs+            case r of+                (nextOfs, Nothing)  -> loop nextOfs+                (pos, Just failure) -> return (pos, Just failure)++    one pos = do+        h <- C.mutUnsafeRead mba pos+        let nbConts = getNbBytes h+        if nbConts == 0xff+            then return (pos, Just InvalidHeader)+            else if pos + 1 + nbConts > end+                then return (pos, Just MissingByte)+                else do+                    case nbConts of+                        0 -> return (pos + 1, Nothing)+                        1 -> do+                            c1 <- C.mutUnsafeRead mba (pos + 1)+                            if isContinuation c1+                                then return (pos + 2, Nothing)+                                else return (pos, Just InvalidContinuation)+                        2 -> do+                            c1 <- C.mutUnsafeRead mba (pos + 1)+                            c2 <- C.mutUnsafeRead mba (pos + 2)+                            if isContinuation c1 && isContinuation c2+                                then return (pos + 3, Nothing)+                                else return (pos, Just InvalidContinuation)+                        3 -> do+                            c1 <- C.mutUnsafeRead mba (pos + 1)+                            c2 <- C.mutUnsafeRead mba (pos + 2)+                            c3 <- C.mutUnsafeRead mba (pos + 3)+                            if isContinuation c1 && isContinuation c2 && isContinuation c3+                                then return (pos + 4, Nothing)+                                else return (pos, Just InvalidContinuation)+                        _ -> error "internal error"++skipNext :: String -> Int -> Int+skipNext (String ba) n = n + 1 + getNbBytes h+  where+    !h = Vec.unsafeIndex ba n++nextWithIndexer :: (Offset Word8 -> Word8)+                -> Offset Word8+                -> (Char, Offset Word8)+nextWithIndexer getter off =+    case getNbBytes# h of+        0# -> (toChar h, off + aone)+        1# -> (toChar (decode2 (getter $ off + aone)), off + atwo)+        2# -> (toChar (decode3 (getter $ off + aone) (getter $ off + atwo)), off + athree)+        3# -> (toChar (decode4 (getter $ off + aone) (getter $ off + atwo) (getter $ off + athree))+              , off + afour)+        r -> error ("next: internal error: invalid input: " <> show (I# r) <> " " <> show (W# h))+  where+    aone = Offset 1+    atwo = Offset 2+    athree = Offset 3+    afour = Offset 4+    !(W8# h) = getter off++    toChar :: Word# -> Char+    toChar w = C# (chr# (word2Int# w))++    decode2 :: Word8 -> Word#+    decode2 (W8# c1) =+        or# (uncheckedShiftL# (and# h 0x1f##) 6#)+            (and# c1 0x3f##)++    decode3 :: Word8 -> Word8 -> Word#+    decode3 (W8# c1) (W8# c2) =+        or# (uncheckedShiftL# (and# h 0xf##) 12#)+            (or# (uncheckedShiftL# (and# c1 0x3f##) 6#)+                 (and# c2 0x3f##))++    decode4 :: Word8 -> Word8 -> Word8 -> Word#+    decode4 (W8# c1) (W8# c2) (W8# c3) =+        or# (uncheckedShiftL# (and# h 0x7##) 18#)+            (or# (uncheckedShiftL# (and# c1 0x3f##) 12#)+                (or# (uncheckedShiftL# (and# c2 0x3f##) 6#)+                    (and# c3 0x3f##))+            )++writeWithBuilder :: (PrimMonad st, Monad st)+                 => Char+                 ->  ArrayBuilder Word8 st ()+writeWithBuilder c =+    if      bool# (ltWord# x 0x80##   ) then encode1+    else if bool# (ltWord# x 0x800##  ) then encode2+    else if bool# (ltWord# x 0x10000##) then encode3+    else                                     encode4+  where+    !(I# xi) = fromEnum c+    !x       = int2Word# xi++    encode1 = appendTy (W8# x)++    encode2 = do+        let x1  = or# (uncheckedShiftRL# x 6#) 0xc0##+            x2  = toContinuation x+        appendTy (W8# x1) >> appendTy (W8# x2)++    encode3 = do+        let x1  = or# (uncheckedShiftRL# x 12#) 0xe0##+            x2  = toContinuation (uncheckedShiftRL# x 6#)+            x3  = toContinuation x+        appendTy (W8# x1) >> appendTy (W8# x2) >> appendTy (W8# x3)++    encode4 = do+        let x1  = or# (uncheckedShiftRL# x 18#) 0xf0##+            x2  = toContinuation (uncheckedShiftRL# x 12#)+            x3  = toContinuation (uncheckedShiftRL# x 6#)+            x4  = toContinuation x+        appendTy (W8# x1) >> appendTy (W8# x2) >> appendTy (W8# x3) >> appendTy (W8# x4)++    toContinuation :: Word# -> Word#+    toContinuation w = or# (and# w 0x3f##) 0x80##+++next :: String -> Offset8 -> (# Char, Offset8 #)+next (String ba) (Offset n) =+    case getNbBytes# h of+        0# -> (# toChar h, Offset $ n + 1 #)+        1# -> (# toChar (decode2 (Vec.unsafeIndex ba (n + 1))) , Offset $ n + 2 #)+        2# -> (# toChar (decode3 (Vec.unsafeIndex ba (n + 1))+                                 (Vec.unsafeIndex ba (n + 2))) , Offset $ n + 3 #)+        3# -> (# toChar (decode4 (Vec.unsafeIndex ba (n + 1))+                                 (Vec.unsafeIndex ba (n + 2))+                                 (Vec.unsafeIndex ba (n + 3))) , Offset $ n + 4 #)+        r -> error ("next: internal error: invalid input: " <> show (I# r) <> " " <> show (W# h))+  where+    !(W8# h) = Vec.unsafeIndex ba n++    toChar :: Word# -> Char+    toChar w = C# (chr# (word2Int# w))++    decode2 :: Word8 -> Word#+    decode2 (W8# c1) =+        or# (uncheckedShiftL# (and# h 0x1f##) 6#)+            (and# c1 0x3f##)++    decode3 :: Word8 -> Word8 -> Word#+    decode3 (W8# c1) (W8# c2) =+        or# (uncheckedShiftL# (and# h 0xf##) 12#)+            (or# (uncheckedShiftL# (and# c1 0x3f##) 6#)+                 (and# c2 0x3f##))++    decode4 :: Word8 -> Word8 -> Word8 -> Word#+    decode4 (W8# c1) (W8# c2) (W8# c3) =+        or# (uncheckedShiftL# (and# h 0x7##) 18#)+            (or# (uncheckedShiftL# (and# c1 0x3f##) 12#)+                (or# (uncheckedShiftL# (and# c2 0x3f##) 6#)+                    (and# c3 0x3f##))+            )++-- | Different way to encode a Character in UTF8 represented as an ADT+data UTF8Char =+      UTF8_1 {-# UNPACK #-} !Word8+    | UTF8_2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+    | UTF8_3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+    | UTF8_4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8++writeBytes :: Char -> UTF8Char+writeBytes c =+    if      bool# (ltWord# x 0x80##   ) then encode1+    else if bool# (ltWord# x 0x800##  ) then encode2+    else if bool# (ltWord# x 0x10000##) then encode3+    else                                     encode4+  where+    !(I# xi) = fromEnum c+    !x       = int2Word# xi+    encode1 = UTF8_1 (W8# x)+    encode2 =+        let !x1  = W8# (or# (uncheckedShiftRL# x 6#) 0xc0##)+            !x2  = toContinuation x+         in UTF8_2 x1 x2+    encode3 =+        let !x1  = W8# (or# (uncheckedShiftRL# x 12#) 0xe0##)+            !x2  = toContinuation (uncheckedShiftRL# x 6#)+            !x3  = toContinuation x+         in UTF8_3 x1 x2 x3+    encode4 =+        let !x1  = W8# (or# (uncheckedShiftRL# x 18#) 0xf0##)+            !x2  = toContinuation (uncheckedShiftRL# x 12#)+            !x3  = toContinuation (uncheckedShiftRL# x 6#)+            !x4  = toContinuation x+         in UTF8_4 x1 x2 x3 x4+    toContinuation :: Word# -> Word8+    toContinuation w = W8# (or# (and# w 0x3f##) 0x80##)+    {-# INLINE toContinuation #-}++write :: PrimMonad prim => MutableString (PrimState prim) -> Offset8 -> Char -> prim Offset8+write (MutableString mba) (Offset i) c =+    if      bool# (ltWord# x 0x80##   ) then encode1+    else if bool# (ltWord# x 0x800##  ) then encode2+    else if bool# (ltWord# x 0x10000##) then encode3+    else                                     encode4+  where+    !(I# xi) = fromEnum c+    !x       = int2Word# xi++    encode1 = C.mutUnsafeWrite mba i (W8# x) >> return (Offset $ i + 1)++    encode2 = do+        let x1  = or# (uncheckedShiftRL# x 6#) 0xc0##+            x2  = toContinuation x+        C.mutUnsafeWrite mba i     (W8# x1)+        C.mutUnsafeWrite mba (i+1) (W8# x2)+        return $ Offset (i + 2)++    encode3 = do+        let x1  = or# (uncheckedShiftRL# x 12#) 0xe0##+            x2  = toContinuation (uncheckedShiftRL# x 6#)+            x3  = toContinuation x+        C.mutUnsafeWrite mba i     (W8# x1)+        C.mutUnsafeWrite mba (i+1) (W8# x2)+        C.mutUnsafeWrite mba (i+2) (W8# x3)+        return $ Offset (i + 3)++    encode4 = do+        let x1  = or# (uncheckedShiftRL# x 18#) 0xf0##+            x2  = toContinuation (uncheckedShiftRL# x 12#)+            x3  = toContinuation (uncheckedShiftRL# x 6#)+            x4  = toContinuation x+        C.mutUnsafeWrite mba i     (W8# x1)+        C.mutUnsafeWrite mba (i+1) (W8# x2)+        C.mutUnsafeWrite mba (i+2) (W8# x3)+        C.mutUnsafeWrite mba (i+3) (W8# x4)+        return $ Offset (i + 4)++    toContinuation :: Word# -> Word#+    toContinuation w = or# (and# w 0x3f##) 0x80##++freeze :: PrimMonad prim => MutableString (PrimState prim) -> prim String+freeze (MutableString mba) = String `fmap` C.unsafeFreeze mba+{-# INLINE freeze #-}++------------------------------------------------------------------------+-- real functions++sToList :: String -> [Char]+sToList s = loop azero+  where+    !nbBytes = size s+    end = azero `offsetPlusE` nbBytes+    loop idx+        | idx == end = []+        | otherwise  =+            let (# c , idx' #) = next s idx in c : loop idx'+++{-# RULES+"String sFromList" forall s .+  sFromList (unpackCString# s) = String $ fromModified s+  #-}+{-# RULES+"String sFromList" forall s .+  sFromList (unpackCStringUtf8# s) = String $ fromModified s+  #-}++sFromList :: [Char] -> String+sFromList l = runST (new bytes >>= copy)+  where+    -- count how many bytes+    !bytes = C.foldl' (+) (Size 0) $ fmap (charToBytes . fromEnum) l++    copy :: MutableString (PrimState (ST st)) -> ST st String+    copy ms = loop azero l+      where+        loop _   []     = freeze ms+        loop idx (c:xs) = write ms idx c >>= \idx' -> loop idx' xs+    -- write those bytes+    --loop :: MutableByteArray# st -> Int# -> State# st -> [Char] -> (# State# st, String #)+{-# INLINE [0] sFromList #-}++null :: String -> Bool+null (String ba) = C.length ba == 0++-- | Create a string composed of a number @n of Chars (Unicode code points).+--+-- if the input @s contains less characters than required, then+take :: Int -> String -> String+take n s = fst $ splitAt n s -- TODO specialize++-- | Create a string with the remaining Chars after dropping @n Chars from the beginning+drop :: Int -> String -> String+drop n s@(String ba)+    | n <= 0    = s+    | otherwise = loop 0 0+  where+    !sz = C.length ba+    loop idx i+        | idx >= sz = mempty+        | i == n    = String $ C.drop idx ba+        | otherwise = loop (skipNext s idx) (i + 1)++splitAt :: Int -> String -> (String, String)+splitAt n s@(String ba)+    | n <= 0    = (mempty, s)+    | otherwise = loop 0 0+  where+    !sz = C.length ba+    loop idx i+        | idx >= sz = (s, mempty)+        | i == n    = let (v1,v2) = C.splitAt idx ba in (String v1, String v2)+        | otherwise = loop (skipNext s idx) (i + 1)++-- rev{Take,Drop,SplitAt} TODO optimise:+-- we can process the string from the end using a skipPrev instead of getting the length++revTake :: Int -> String -> String+revTake nbElems v = drop (length v - nbElems) v++revDrop :: Int -> String -> String+revDrop nbElems v = take (length v - nbElems) v++revSplitAt :: Int -> String -> (String, String)+revSplitAt n v = (drop idx v, take idx v)+  where idx = length v - n++-- | Split on the input string using the predicate as separator+--+-- e.g.+--+-- > splitOn (== ',') ","          == ["",""]+-- > splitOn (== ',') ",abc,"      == ["","abc",""]+-- > splitOn (== ':') "abc"        == ["abc"]+-- > splitOn (== ':') "abc::def"   == ["abc","","def"]+-- > splitOn (== ':') "::abc::def" == ["","","abc","","def"]+--+splitOn :: (Char -> Bool) -> String -> [String]+splitOn predicate s+    | sz == Size 0 = []+    | otherwise    = loop azero azero+  where+    !sz = size s+    end = azero `offsetPlusE` sz+    loop prevIdx idx+        | idx == end = [sub s prevIdx idx]+        | otherwise =+            let (# c, idx' #) = next s idx+             in if predicate c+                    then sub s prevIdx idx : loop idx' idx'+                    else loop prevIdx idx'++sub :: String -> Offset8 -> Offset8 -> String+sub (String ba) (Offset start) (Offset end) = String $ Vec.sub ba start end++-- | Split at a given index.+splitIndex :: Offset8 -> String -> (String, String)+splitIndex (Offset idx) (String ba) = (String v1, String v2)+  where (v1,v2) = C.splitAt idx ba++break :: (Char -> Bool) -> String -> (String, String)+break predicate s@(String ba) = runST $ Vec.unsafeIndexer ba go+  where+    !sz = size s+    end = azero `offsetPlusE` sz++    go :: (Offset Word8 -> Word8) -> ST st (String, String)+    go getIdx = loop (Offset 0)+      where+        !nextI = nextWithIndexer getIdx+        loop idx+            | idx == end = return (s, mempty)+            | otherwise  = do+                let (c, idx') = nextI idx+                case predicate c of+                    True  -> return $ splitIndex idx s+                    False -> loop idx'+        {-# INLINE loop #-}+{-# INLINE [2] break #-}++{-# RULES "break (== 'c')" [3] forall c . break (== c) = breakElem c #-}++breakElem :: Char -> String -> (String, String)+breakElem !el s@(String ba) =+    case writeBytes el of+        UTF8_1 w -> let (# v1,v2 #) = Vec.splitElem w ba in (String v1, String v2)+        _        -> runST $ Vec.unsafeIndexer ba go+  where+    sz = size s+    end = azero `offsetPlusE` sz++    go :: (Offset Word8 -> Word8) -> ST st (String, String)+    go getIdx = loop (Offset 0)+      where+        !nextI = nextWithIndexer getIdx+        loop idx+            | idx == end = return (s, mempty)+            | otherwise  = do+                let (c, idx') = nextI idx+                case el == c of+                    True  -> return $ splitIndex idx s+                    False -> loop idx'++intersperse :: Char -> String -> String+intersperse sep src+    | srcLen <= 1 = src+    | otherwise   = runST $ unsafeCopyFrom src dstBytes (go sep)+  where+    !srcBytes = size src+    !srcLen   = length src+    dstBytes = srcBytes + ((srcLen - 1) `scale` charToBytes (fromEnum sep))++    lastSrc :: Offset Char+    lastSrc = Offset 0 `offsetPlusE` Size srcLen++    go :: Char -> String -> Offset Char -> Offset8 -> MutableString s -> Offset8 -> ST s (Offset8, Offset8)+    go sep' src' srcI srcIdx dst dstIdx+        | srcI == lastSrc = do+            nextDstIdx <- write dst dstIdx c+            return (nextSrcIdx, nextDstIdx)+        | otherwise          = do+            nextDstIdx  <- write dst dstIdx c+            nextDstIdx' <- write dst nextDstIdx sep'+            return (nextSrcIdx, nextDstIdx')+      where+        (# c, nextSrcIdx #) = next src' srcIdx++-- | Allocate a new @String@ with a fill function that has access to the characters of+--   the source @String@.+unsafeCopyFrom :: String -- ^ Source string+               -> Size8  -- ^ Length of the destination string in bytes+               -> (String -> Offset Char -> Offset8 -> MutableString s -> Offset8 -> ST s (Offset8, Offset8))+               -- ^ Function called for each character in the source String+               -> ST s String -- ^ Returns the filled new string+unsafeCopyFrom src dstBytes f = new dstBytes >>= fill (Offset 0) (Offset 0) (Offset 0) f >>= freeze+  where+    srcLen = length src+    end = Offset 0 `offsetPlusE` Size srcLen+    fill srcI srcIdx dstIdx f' dst'+        | srcI == end = return dst'+        | otherwise = do (nextSrcIdx, nextDstIdx) <- f' src srcI srcIdx dst' dstIdx+                         fill (srcI + Offset 1) nextSrcIdx nextDstIdx f' dst'++span :: (Char -> Bool) -> String -> (String, String)+span predicate s = break (not . predicate) s++-- | size in bytes+size :: String -> Size8+size (String ba) = Size $ C.length ba++length :: String -> Int+length s@(String ba) = loop 0 0+  where+    !sz     = C.length ba+    loop idx !i+        | idx == sz = i+        | otherwise =+            let idx' = skipNext s idx+             in loop idx' (i + 1)++replicate :: Int -> Char -> String+replicate n c = runST (new nbBytes >>= fill)+  where+    end       = azero `offsetPlusE` nbBytes+    nbBytes   = Size $ sz * n+    (Size sz) = charToBytes (fromEnum c)+    fill :: PrimMonad prim => MutableString (PrimState prim) -> prim String+    fill ms = loop (Offset 0)+      where+        loop idx+            | idx == end = freeze ms+            | otherwise  = write ms idx c >>= loop++{-+sizeBytes :: String -> Int+sizeBytes (String ba) = I# (sizeofByteArray# ba)+-}++-- | Allocate a MutableString of a specific size in bytes.+new :: PrimMonad prim+    => Size8 -- ^ in number of bytes, not of elements.+    -> prim (MutableString (PrimState prim))+new n = MutableString `fmap` MVec.new n++create :: PrimMonad prim => Int -> (MutableString (PrimState prim) -> prim Int) -> prim String+create sz f = do+    ms     <- new (Size sz)+    filled <- f ms+    if filled == sz+        then freeze ms+        else C.take filled `fmap` freeze ms++charToBytes :: Int -> Size8+charToBytes c+    | c < 0x80     = Size 1+    | c < 0x800    = Size 2+    | c < 0x10000  = Size 3+    | c < 0x110000 = Size 4+    | otherwise    = error ("invalid code point: " `mappend` show c)++charMap :: (Char -> Char) -> String -> String+charMap f src =+    let !(elems, nbBytes) = allocateAndFill [] (Offset 0) (Size 0)+     in runST $ do+            dest <- new nbBytes+            copyLoop dest elems (Offset 0 `offsetPlusE` nbBytes)+            freeze dest+  where+    !srcSz = size src+    srcEnd = azero `offsetPlusE` srcSz++    allocateAndFill :: [(String, Size8)]+                    -> Offset8+                    -> Size8+                    -> ([(String,Size8)], Size8)+    allocateAndFill acc idx bytesWritten+        | idx == srcEnd = (acc, bytesWritten)+        | otherwise     =+            let (el@(_,addBytes), idx') = runST $ do+                    -- make sure we allocate at least 4 bytes for the destination for the last few bytes+                    -- otherwise allocating less would bring the danger of spinning endlessly+                    -- and never succeeding.+                    let !diffBytes = srcEnd - idx+                        !allocatedBytes = if diffBytes <= Size 4 then Size 4 else diffBytes+                    ms <- new allocatedBytes+                    (dstIdx, srcIdx) <- fill ms allocatedBytes idx+                    s <- freeze ms+                    return ((s, dstIdx), srcIdx)+             in allocateAndFill (el : acc) idx' (bytesWritten + addBytes)++    fill :: PrimMonad prim+         => MutableString (PrimState prim)+         -> Size8+         -> Offset8+         -> prim (Size8, Offset8)+    fill mba dsz srcIdxOrig =+        loop (Offset 0) srcIdxOrig+      where+        endDst = (Offset 0) `offsetPlusE` dsz+        loop dstIdx srcIdx+            | srcIdx == srcEnd = return (offsetAsSize dstIdx, srcIdx)+            | dstIdx == endDst = return (offsetAsSize dstIdx, srcIdx)+            | otherwise        =+                let (# c, srcIdx' #) = next src srcIdx+                    c' = f c -- the mapped char+                    !nbBytes = charToBytes (fromEnum c')+                 in -- check if we have room in the destination buffer+                    if dstIdx `offsetPlusE` nbBytes <= sizeAsOffset dsz+                        then do dstIdx' <- write mba dstIdx c'+                                loop dstIdx' srcIdx'+                        else return (offsetAsSize dstIdx, srcIdx)++    copyLoop _   []     (Offset 0) = return ()+    copyLoop _   []     n          = error ("charMap invalid: " <> show n)+    copyLoop ms@(MutableString mba) ((String ba, sz):xs) end = do+        let start = end `offsetMinusE` sz+        Vec.unsafeCopyAtRO mba start ba (Offset 0) sz+        copyLoop ms xs start++snoc :: String -> Char -> String+snoc s@(String ba) c+    | len == Size 0 = C.singleton c+    | otherwise     = runST $ do+        ms@(MutableString mba) <- new (len + nbBytes)+        Vec.unsafeCopyAtRO mba (Offset 0) ba (Offset 0) len+        _ <- write ms (azero `offsetPlusE` len) c+        freeze ms+  where+    !len     = size s+    !nbBytes = charToBytes (fromEnum c)++cons :: Char -> String -> String+cons c s@(String ba)+  | len == Size 0 = C.singleton c+  | otherwise     = runST $ do+      ms@(MutableString mba) <- new (len + nbBytes)+      idx <- write ms (Offset 0) c+      Vec.unsafeCopyAtRO mba idx ba (Offset 0) len+      freeze ms+  where+    !len     = size s+    !nbBytes = charToBytes (fromEnum c)++unsnoc :: String -> Maybe (String, Char)+unsnoc s+    | null s    = Nothing+    | otherwise =+        let (s1,s2) = revSplitAt 1 s+         in case toList s1 of -- TODO use index instead of toList+                [c] -> Just (s2, c)+                _   -> internalError "unsnoc"++uncons :: String -> Maybe (Char, String)+uncons s+    | null s    = Nothing+    | otherwise =+        let (s1,s2) = splitAt 1 s+         in case toList s1 of -- TODO use index instead of ToList+                [c] -> Just (c, s2)+                _   -> internalError "uncons"++find :: (Char -> Bool) -> String -> Maybe Char+find predicate s = loop (Offset 0)+  where+    !sz = size s+    end = Offset 0 `offsetPlusE` sz+    loop idx+        | idx == end = Nothing+        | otherwise =+            let (# c, idx' #) = next s idx+             in case predicate c of+                    True  -> Just c+                    False -> loop idx'++sortBy :: (Char -> Char -> Ordering) -> String -> String+sortBy sortF s = fromList $ Data.List.sortBy sortF $ toList s -- FIXME for tests++filter :: (Char -> Bool) -> String -> String+filter p s = fromList $ Data.List.filter p $ toList s++reverse :: String -> String+reverse s@(String ba) = runST $ do+    ms <- new len+    loop ms (Offset 0) (Offset 0 `offsetPlusE` len)+  where+    !len = size s+    -- write those bytes+    loop :: PrimMonad prim => MutableString (PrimState prim) -> Offset8 -> Offset8 -> prim String+    loop ms@(MutableString mba) sidx@(Offset si) didx+        | didx == Offset 0 = freeze ms+        | otherwise = do+            let !h = Vec.unsafeIndex ba si+                !nb = Size (getNbBytes h + 1)+                didx'@(Offset d) = didx `offsetMinusE` nb+            case nb of+                Size 1 -> C.mutUnsafeWrite mba d      h+                Size 2 -> do+                    C.mutUnsafeWrite mba d       h+                    C.mutUnsafeWrite mba (d + 1) (Vec.unsafeIndex ba (si + 1))+                Size 3 -> do+                    C.mutUnsafeWrite mba d       h+                    C.mutUnsafeWrite mba (d + 1) (Vec.unsafeIndex ba (si + 1))+                    C.mutUnsafeWrite mba (d + 2) (Vec.unsafeIndex ba (si + 2))+                Size 4 -> do+                    C.mutUnsafeWrite mba d       h+                    C.mutUnsafeWrite mba (d + 1) (Vec.unsafeIndex  ba (si + 1))+                    C.mutUnsafeWrite mba (d + 2) (Vec.unsafeIndex ba (si + 2))+                    C.mutUnsafeWrite mba (d + 3) (Vec.unsafeIndex ba (si + 3))+                _  -> return () -- impossible+            loop ms (sidx `offsetPlusE` nb) didx'++{-+-- | Convert a Byte Array to a string and check UTF8 validity+fromBytes :: Encoding -> UArray Word8 -> Maybe String+fromBytes UTF8 bytes =+    case validate bytes 0 (C.length bytes) of+        (_, Nothing) -> Just $ fromBytesUnsafe bytes+        (_, Just _)  -> Nothing+        -}++data Encoding+    = ASCII7+    | UTF8+    | UTF16+    | UTF32+    | ISO_8859_1+  deriving (Typeable, Data, Eq, Ord, Show, Enum, Bounded)++fromEncoderBytes :: ( Encoder.Encoding encoding+                    , Exception (Encoder.Error encoding)+                    , PrimType (Encoder.Unit encoding)+                    )+                 => encoding+                 -> UArray Word8+                 -> (String, Maybe ValidationFailure, UArray Word8)+fromEncoderBytes enc bytes =+    ( String $ runST $ Encoder.convertFromTo enc EncoderUTF8 (Vec.recast bytes)+    , Nothing+    , mempty+    )+++fromBytes :: Encoding -> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)+fromBytes ASCII7     bytes = fromEncoderBytes Encoder.ASCII7     bytes+fromBytes ISO_8859_1 bytes = fromEncoderBytes Encoder.ISO_8859_1 bytes+fromBytes UTF16      bytes = fromEncoderBytes Encoder.UTF16      bytes+fromBytes UTF32      bytes = fromEncoderBytes Encoder.UTF32      bytes+fromBytes UTF8       bytes+    | C.null bytes = (mempty, Nothing, mempty)+    | otherwise    =+        case validate bytes (Offset 0) (Size $ C.length bytes) of+            (_, Nothing)  -> (fromBytesUnsafe bytes, Nothing, mempty)+            (Offset pos, Just vf) ->+                let (b1, b2) = C.splitAt pos bytes+                 in (fromBytesUnsafe b1, toErr vf, b2)+  where+    toErr MissingByte         = Nothing+    toErr InvalidHeader       = Just InvalidHeader+    toErr InvalidContinuation = Just InvalidContinuation++fromBytesLenient :: UArray Word8 -> (String, UArray Word8)+fromBytesLenient bytes+    | C.null bytes = (mempty, mempty)+    | otherwise    =+        case validate bytes (Offset 0) (Size $ C.length bytes) of+            (_, Nothing)                   -> (fromBytesUnsafe bytes, mempty)+            (Offset pos, Just MissingByte) ->+                let (b1,b2) = C.splitAt pos bytes+                 in (fromBytesUnsafe b1, b2)+            (Offset pos, Just InvalidHeader) ->+                let (b1,b2) = C.splitAt pos bytes+                    (_,b3)  = C.splitAt 1 b2+                    (s3, r) = fromBytesLenient b3+                 in (mconcat [fromBytesUnsafe b1,replacement, s3], r)+            (Offset pos, Just InvalidContinuation) ->+                let (b1,b2) = C.splitAt pos bytes+                    (_,b3)  = C.splitAt 1 b2+                    (s3, r) = fromBytesLenient b3+                 in (mconcat [fromBytesUnsafe b1,replacement, s3], r)+  where+    -- This is the replacement character U+FFFD used for any invalid header or continuation+    replacement :: String+    !replacement = fromBytesUnsafe $ fromList [0xef,0xbf,0xbd]++fromChunkBytes :: [UArray Word8] -> [String]+fromChunkBytes l = loop l+  where+    loop []         = []+    loop (bytes:[]) =+        case validate bytes (Offset 0) (Size $ C.length bytes) of+            (_, Nothing)  -> [fromBytesUnsafe bytes]+            (_, Just err) -> doErr err+    loop (bytes:cs@(c1:c2)) =+        case validate bytes (Offset 0) (Size $ C.length bytes) of+            (_, Nothing) -> fromBytesUnsafe bytes : loop cs+            (Offset pos, Just MissingByte) ->+                let (b1,b2) = C.splitAt pos bytes+                 in fromBytesUnsafe b1 : loop ((b2 `mappend` c1) : c2)+            (_, Just err) -> doErr err+    doErr err = error ("fromChunkBytes: " <> show err)++-- | Convert a Byte Array directly to a string without checking for UTF8 validity+fromBytesUnsafe :: UArray Word8 -> String+fromBytesUnsafe = String++toEncoderBytes :: ( Encoder.Encoding encoding+                  , PrimType (Encoder.Unit encoding)+                  , Exception (Encoder.Error encoding)+                  )+               => encoding+               -> UArray Word8+               -> UArray Word8+toEncoderBytes enc bytes = Vec.recast (runST $ Encoder.convertFromTo EncoderUTF8 enc bytes)++-- | Convert a String to a bytearray+toBytes :: Encoding -> String -> UArray Word8+toBytes UTF8       (String bytes) = bytes+toBytes ASCII7     (String bytes) = toEncoderBytes Encoder.ASCII7     bytes+toBytes ISO_8859_1 (String bytes) = toEncoderBytes Encoder.ISO_8859_1 bytes+toBytes UTF16      (String bytes) = toEncoderBytes Encoder.UTF16      bytes+toBytes UTF32      (String bytes) = toEncoderBytes Encoder.UTF32      bytes++lines :: String -> [String]+lines = fmap fromList . Prelude.lines . toList++words :: String -> [String]+words = fmap fromList . Prelude.words . toList
+ Foundation/String/UTF8Table.hs view
@@ -0,0 +1,83 @@+-- |+-- Module      : Foundation.String.UTF8Table+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+-- UTF8 lookup tables for fast continuation & nb bytes per header queries+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+module Foundation.String.UTF8Table+    ( isContinuation+    , getNbBytes+    , isContinuation#+    , getNbBytes#+    ) where++import           GHC.Prim+import           GHC.Types+import           GHC.Word+import           Foundation.Internal.Base++-- | Check if the byte is a continuation byte+isContinuation :: Word8 -> Bool+isContinuation (W8# w) = isContinuation# w+{-# INLINE isContinuation #-}++-- | Get the number of following bytes given the first byte of a UTF8 sequence.+getNbBytes :: Word8 -> Int+getNbBytes (W8# w) = I# (getNbBytes# w)+{-# INLINE getNbBytes #-}++-- | Check if the byte is a continuation byte+isContinuation# :: Word# -> Bool+isContinuation# w = W# (indexWord8OffAddr# (unTable contTable) (word2Int# w)) /= W# 0##+{-# INLINE isContinuation# #-}++-- | Get the number of following bytes given the first byte of a UTF8 sequence.+getNbBytes# :: Word# -> Int#+getNbBytes# w = word2Int# (indexWord8OffAddr# (unTable headTable) (word2Int# w))+{-# INLINE getNbBytes# #-}++data Table = Table { unTable :: !Addr# }++contTable :: Table+contTable = Table+        "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#+{-# NOINLINE contTable #-}++headTable :: Table+headTable = Table+        "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\x01\+        \\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\+        \\x03\x03\x03\x03\x03\x03\x03\x03\xff\xff\xff\xff\xff\xff\xff\xff"#+{-# NOINLINE headTable #-}
+ Foundation/System/Info.hs view
@@ -0,0 +1,138 @@+-- |+-- Module      : Foundation.System.Info+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE CPP #-}++module Foundation.System.Info+    (+      -- * Operation System info+      OS(..)+    , os+      -- * CPU info+    , arch+    , cpus+    , Endianness(..)+    , endianness+      -- * Compiler info+    , compilerName+    , System.Info.compilerVersion+    , Data.Version.Version(..)+    ) where++import qualified System.Info+import qualified Data.Version+import           Data.Data+import qualified GHC.Conc+import Foundation.String+import Foundation.Internal.Base++#ifdef ARCH_IS_UNKNOWN_ENDIAN+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (castPtr)+import Foreign.Storable (poke, peek)+import Data.Word (Word8, Word32)+import System.IO.Unsafe (unsafePerformIO)+#endif++data OS+    = Windows+    | OSX+    | Linux+    | Android+    | BSD+  deriving (Show, Eq, Ord, Enum, Bounded, Data, Typeable)++-- | get the operating system on which the program is running.+--+-- Either return the known `OS` or a strict `String` of the OS name.+--+-- This function uses the `base`'s `System.Info.os` function.+--+os :: Either String OS+os = case System.Info.os of+    "darwin"  -> Right OSX+    "mingw32" -> Right Windows+    "linux"   -> Right Linux+    "linux-android" -> Right Android+    "openbsd" -> Right BSD+    "netbsd"  -> Right BSD+    "freebsd" -> Right BSD+    str       -> Left $ fromList str++-- | Enumeration of the known GHC supported architecture.+--+data Arch+    = I386+    | X86_64+    | PowerPC+    | PowerPC64+    | Sparc+    | Sparc64+    | ARM+    | ARM64+  deriving (Show, Eq, Ord, Enum, Bounded, Data, Typeable)++-- | get the machine architecture on which the program is running+--+-- Either return the known architecture or a Strict `String` of the+-- architecture name.+--+-- This function uses the `base`'s `System.Info.arch` function.+--+arch :: Either String Arch+arch = case System.Info.arch of+    "i386"          -> Right I386+    "x86_64"        -> Right X86_64+    "powerpc"       -> Right PowerPC+    "powerpc64"     -> Right PowerPC64+    "powerpc64le"   -> Right PowerPC64+    "sparc"         -> Right Sparc+    "sparc64"       -> Right Sparc64+    "arm"           -> Right ARM+    "aarch64"       -> Right ARM64+    str             -> Left $ fromList str++-- | get the compiler name+--+-- get the compilerName from base package but convert+-- it into a strict String+compilerName :: String+compilerName = fromList System.Info.compilerName++-- | returns the number of CPUs the machine has+cpus :: IO Int+cpus = GHC.Conc.getNumProcessors++data Endianness+    = LittleEndian+    | BigEndian+  deriving (Eq, Show)++-- | endianness of the current architecture+endianness :: Endianness+#ifdef ARCH_IS_LITTLE_ENDIAN+endianness = LittleEndian+#elif ARCH_IS_BIG_ENDIAN+endianness = BigEndian+#else+-- ! ARCH_IS_UNKNOWN_ENDIAN+endianness = unsafePerformIO $ bytesToEndianness <$> word32ToByte input+  where+    input :: Word32+    input = 0x01020304+{-# NOINLINE endianness #-}++word32ToByte :: Word32 -> IO Word8+word32ToByte word = alloca $ \wordPtr -> do+         poke wordPtr word+         peek (castPtr wordPtr)++bytesToEndianness :: Word8 -> Endianness+bytesToEndianness 1 = BigEndian+bytesToEndianness _ = LittleEndian+#endif
+ Foundation/Tuple.hs view
@@ -0,0 +1,98 @@+-- |+-- Module      : Foundation.Tuple+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : portable+--+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+module Foundation.Tuple+    ( Tuple2(..)+    , Tuple3(..)+    , Tuple4(..)+    , Fstable(..)+    , Sndable(..)+    , Thdable(..)+    ) where++import Foundation.Internal.Base+import Data.Data++-- | Strict tuple (a,b)+data Tuple2 a b = Tuple2 !a !b+    deriving (Show,Eq,Ord,Typeable,Data,Generic)++-- | Strict tuple (a,b,c)+data Tuple3 a b c = Tuple3 !a !b !c+    deriving (Show,Eq,Ord,Typeable,Data,Generic)++-- | Strict tuple (a,b,c,d)+data Tuple4 a b c d = Tuple4 !a !b !c !d+    deriving (Show,Eq,Ord,Typeable,Data,Generic)++-- | Class of product types that have a first element+class Fstable a where+    type FstTy a+    fst :: a -> FstTy a++-- | Class of product types that have a second element+class Sndable a where+    type SndTy a+    snd :: a -> SndTy a++-- | Class of product types that have a third element+class Thdable a where+    type ThdTy a+    thd :: a -> ThdTy a++instance Fstable (a,b) where+    type FstTy (a,b) = a+    fst (a,_) = a+instance Fstable (a,b,c) where+    type FstTy (a,b,c) = a+    fst (a,_,_) = a+instance Fstable (a,b,c,d) where+    type FstTy (a,b,c,d) = a+    fst (a,_,_,_) = a+instance Fstable (Tuple2 a b) where+    type FstTy (Tuple2 a b) = a+    fst (Tuple2 a _) = a+instance Fstable (Tuple3 a b c) where+    type FstTy (Tuple3 a b c) = a+    fst (Tuple3 a _ _) = a+instance Fstable (Tuple4 a b c d) where+    type FstTy (Tuple4 a b c d) = a+    fst (Tuple4 a _ _ _) = a++instance Sndable (a,b) where+    type SndTy (a,b) = b+    snd (_,b) = b+instance Sndable (a,b,c) where+    type SndTy (a,b,c) = b+    snd (_,b,_) = b+instance Sndable (a,b,c,d) where+    type SndTy (a,b,c,d) = b+    snd (_,b,_,_) = b+instance Sndable (Tuple2 a b) where+    type SndTy (Tuple2 a b) = b+    snd (Tuple2 _ b) = b+instance Sndable (Tuple3 a b c) where+    type SndTy (Tuple3 a b c) = b+    snd (Tuple3 _ b _) = b+instance Sndable (Tuple4 a b c d) where+    type SndTy (Tuple4 a b c d) = b+    snd (Tuple4 _ b _ _) = b++instance Thdable (a,b,c) where+    type ThdTy (a,b,c) = c+    thd (_,_,c) = c+instance Thdable (a,b,c,d) where+    type ThdTy (a,b,c,d) = c+    thd (_,_,c,_) = c+instance Thdable (Tuple3 a b c) where+    type ThdTy (Tuple3 a b c) = c+    thd (Tuple3 _ _ c) = c+instance Thdable (Tuple4 a b c d) where+    type ThdTy (Tuple4 a b c d) = c+    thd (Tuple4 _ _ c _) = c
+ Foundation/VFS.hs view
@@ -0,0 +1,32 @@+-- |+-- Module      : Foundation.VFS+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--+module Foundation.VFS+    ( Path(..)+    , filename+    , parent+    , prefix+    , suffix++      -- * FilePath+    , FilePath+    , FileName+      -- ** conversion+    , filePathToString+    , filePathToLString+    ) where+++import Foundation.VFS.Path+          ( Path(..)+          , filename, parent, suffix, prefix+          )+import Foundation.VFS.FilePath+          ( FilePath, FileName+          , filePathToString+          , filePathToLString+          )
+ Foundation/VFS/FilePath.hs view
@@ -0,0 +1,256 @@+-- |+-- Module      : Foundation.VFS.FilePath+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--+-- # Opaque implementation for FilePath+--+-- The underlying type of a FilePath is a `Foundation.ByteArray`. It is indeed like+-- this because for some systems (Unix systems) a `FilePath` is a null+-- terminated array of bytes.+--+-- # FilePath and FileName for type checking validation+--+-- In order to add some constraint at compile time, it is not possible to+-- append (`</>`) a `FilePath` to another `FilePath`.+-- You can only append (`</>`) a `FileName` to a given `FilePath`.+--++{-# LANGUAGE CPP #-}++module Foundation.VFS.FilePath+    ( FilePath+    , Relativity(..)+    , FileName+      -- * conversion+    , filePathToString+    , filePathToLString++      -- ** unsafe+    , unsafeFilePath+    , unsafeFileName+    , extension+    ) where++import Foundation.Internal.Base+import Foundation.Collection+import Foundation.Array+import Foundation.String (Encoding(..), ValidationFailure, toBytes, fromBytes, String)+import Foundation.VFS.Path(Path(..))++import qualified Data.List+import Foundation.Partial+-- ------------------------------------------------------------------------- --+--                           System related helpers                          --+-- ------------------------------------------------------------------------- --++#ifdef mingw32_HOST_OS+pathSeparatorWINC :: Char+pathSeparatorWINC = '\\'++-- | define the Path separator for Windows systems : '\\'+pathSeparatorWIN :: String+pathSeparatorWIN = fromString [pathSeparatorWINC]+#else+pathSeparatorPOSIXC :: Char+pathSeparatorPOSIXC = '/'++-- | define the Path separator for POSIX systems : '/'+pathSeparatorPOSIX :: String+pathSeparatorPOSIX = fromString [pathSeparatorPOSIXC]+#endif++pathSeparatorC :: Char+pathSeparator :: String+#ifdef mingw32_HOST_OS+pathSeparatorC = pathSeparatorWINC+pathSeparator = pathSeparatorWIN+#else+pathSeparatorC = pathSeparatorPOSIXC+pathSeparator = pathSeparatorPOSIX+#endif++-- ------------------------------------------------------------------------- --+--                              FilePath                                     --+-- ------------------------------------------------------------------------- --++-- | information about type of FilePath+--+-- A file path being only `Relative` or `Absolute`.+data Relativity = Absolute | Relative+  deriving (Eq, Show)++-- | FilePath is a collection of FileName+--+-- TODO: Eq and Ord are implemented using Show+--       This is not very efficient and would need to be improved+--       Also, it is possible the ordering is not necessary what we want+--       in this case.+--+-- A FilePath is one of the following:+--+-- * An Absolute:+--   * starts with one of the follwing "/"+-- * A relative:+--   * don't start with a "/"+--+-- * authorised:+--   * "/"+--   * "/file/path"+--   * "."+--   * ".."+--   * "work/haskell/hs-foundation"+--+-- * unauthorised+--   * "path//"+data FilePath = FilePath Relativity [FileName]++instance Show FilePath where+    show = filePathToLString+instance Eq FilePath where+  (==) a b = (==) (show a) (show b)+instance Ord FilePath where+  compare a b = compare (show a) (show b)++-- | error associated to filepath manipulation+data FilePath_Invalid+      = ContiguousPathSeparator+          -- ^ this mean there were 2 contiguous path separators.+          --+          -- This is not valid in Foundation's FilePath specifications+    deriving (Typeable, Show)+instance Exception FilePath_Invalid++instance IsString FilePath where+    fromString [] = FilePath Absolute mempty+    fromString s@(x:xs)+        | hasContigueSeparators s = throw ContiguousPathSeparator+        | otherwise = FilePath relativity $ case relativity of+            Absolute -> fromString <$> splitOn isSeparator xs+            Relative -> fromString <$> splitOn isSeparator s+      where+        relativity :: Relativity+        relativity = if isSeparator x then Absolute else Relative++-- | A filename (or path entity) in the FilePath+--+-- * Authorised+--   * ""+--   * "."+--   * ".."+--   * "foundation"+-- * Unauthorised+--   * "/"+--   * "file/"+--   * "/file"+--   * "file/path"+--+data FileName = FileName (UArray Word8)+  deriving (Eq)+-- | errors related to FileName manipulation+data FileName_Invalid+    = ContainsNullByte+        -- ^ this means a null byte was found in the FileName+    | ContainsSeparator+        -- ^ this means a path separator was found in the FileName+    | EncodingError ValidationFailure+        -- ^ encoding error+    | UnknownTrailingBytes (UArray Word8)+        -- ^ some unknown trainling bytes found+  deriving (Typeable, Show)+instance Exception FileName_Invalid++instance Show FileName where+    show = fileNameToLString+instance IsString FileName where+  fromString [] = FileName mempty+  fromString xs | hasNullByte  xs = throw ContainsNullByte+                | hasSeparator xs = throw ContainsSeparator+                | otherwise       = FileName $ toBytes UTF8 $ fromString xs++hasNullByte :: [Char] -> Bool+hasNullByte = Data.List.elem '\0'++hasSeparator :: [Char] -> Bool+hasSeparator = Data.List.elem pathSeparatorC++isSeparator :: Char -> Bool+isSeparator = (==) pathSeparatorC++hasContigueSeparators :: [Char] -> Bool+hasContigueSeparators [] = False+hasContigueSeparators [_] = False+hasContigueSeparators (x1:x2:xs) =+    (isSeparator x1 && x1 == x2) || hasContigueSeparators xs++instance Monoid FileName where+      mempty = FileName mempty+      mappend (FileName a) (FileName b) = FileName $ a `mappend` b++instance Path FilePath where+    type PathEnt FilePath = FileName+    type PathPrefix FilePath = Relativity+    type PathSuffix FilePath = ()+    (</>) = join+    splitPath (FilePath r xs) = (r, xs, ())+    buildPath (r, xs , _) = FilePath r xs++-- compare to the original </>, this type disallow to be able to append an absolute filepath to a filepath+join :: FilePath -> FileName -> FilePath+join p              (FileName x) | null x = p+join (FilePath r xs) x          = FilePath r $ snoc xs x++filePathToString :: FilePath -> String+filePathToString (FilePath Absolute []) = fromString [pathSeparatorC]+filePathToString (FilePath Relative []) = fromString "."+filePathToString (FilePath Absolute fns) = cons pathSeparatorC $ filenameIntercalate fns+filePathToString (FilePath Relative fns) = filenameIntercalate fns++filenameIntercalate :: [FileName] -> String+filenameIntercalate = mconcat . Data.List.intersperse pathSeparator . fmap fileNameToString++-- | convert a FileName into a String+--+-- This function may throw an exception associated to the encoding+fileNameToString :: FileName -> String+fileNameToString (FileName fp) =+    -- FIXME probably incorrect considering windows.+    -- this is just to get going to be able to be able to reuse System.IO functions which+    -- works on [Char]+    case fromBytes UTF8 fp of+        (s, Nothing, bs)+            | null bs -> s+            | otherwise -> throw $ UnknownTrailingBytes bs+        (_, Just err, _) -> throw $ EncodingError err++-- | conversion of FileName into a list of Char+--+-- this function may throw exceptions+fileNameToLString :: FileName -> [Char]+fileNameToLString = toList . fileNameToString++-- | conversion of a FilePath into a list of Char+--+-- this function may throw exceptions+filePathToLString :: FilePath -> [Char]+filePathToLString = toList . filePathToString++-- | build a file path from a given list of filename+--+-- this is unsafe and is mainly needed for testing purpose+unsafeFilePath :: Relativity -> [FileName] -> FilePath+unsafeFilePath = FilePath++-- | build a file name from a given ByteArray+--+-- this is unsafe and is mainly needed for testing purpose+unsafeFileName :: UArray Word8 -> FileName+unsafeFileName = FileName++extension :: FileName -> Maybe FileName+extension (FileName fn) = case splitOn (\c -> c == 0x2E) fn of+                            [] -> Nothing+                            [_] -> Nothing+                            xs -> Just $ FileName $ fromPartial $ head $ reverse xs
+ Foundation/VFS/Path.hs view
@@ -0,0 +1,141 @@+-- |+-- Module      : Foundation.VFS.Path+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--++{-# LANGUAGE FlexibleContexts #-}++module Foundation.VFS.Path+    (+      -- * Path class+      Path(..)++    , parent+    , filename+    , prefix+    , suffix+    ) where++import Foundation.Internal.Base++-- | Path type class+--+-- defines the Path associated types and basic functions to implement related+-- to the path manipulation+--+-- # TODO, add missing enhancement:+--+-- ```+--    splitExtension :: PathEnt path -> (PathEnt path, PathEnt path)+--    addExtension  :: PathEnt path -> PathEnt path -> PathEnt path+--    (<.>) :: path -> PathEnt path -> path+--    (-<.>) :: path -> PathEnt path -> path+-- ```+--+class Path path where+    -- | the associated PathEntity of the given `path`+    -- this type is the minimal element contained in the Path+    -- a Path is not a collection but it is possible to see this+    -- associated type equivalent to the `Foundation.Collection.Element` type family+    type PathEnt path++    -- | the associated prefix of the given `path`+    --+    -- in the case of a `FilePath`, it is a void (i.e. `()`)+    -- in the case of an `URI`, it is the schema, host, port...+    type PathPrefix path++    -- | the associated suffix of the given path+    --+    -- in the case of the `FilePath`, it is a void (i.e. `()`)+    -- in the case of the `URI`, it is a the query, the fragment+    type PathSuffix path++    -- | join a path entity to a given path+    (</>) :: path -> PathEnt path -> path++    -- | split the path into the associated elements+    splitPath :: path -> ( PathPrefix path+                         , [PathEnt path]+                         , PathSuffix path+                         )+    -- | build the path from the associated elements+    buildPath :: ( PathPrefix path+                 , [PathEnt path]+                 , PathSuffix path+                 )+              -> path+++-- | parent is only going to drop the filename.+--+-- if you actually want to reference to the parent directory, simply uses:+--+-- ```+-- parent "." /= "." </> ".."+-- ```+parent :: Path path => path -> path+parent path = buildPath (p, init ps, s)+  where+    (p, ps , s) = splitPath path+++-- | get the filename of the given path+--+-- If there is no filename, you will receive the mempty of the PathEnt+filename :: (Path path, Monoid (PathEnt path)) => path -> PathEnt path+filename path = case ps of+    [] -> mempty+    _  -> last ps+  where+    (_, ps , _) = splitPath path++-- TODO: this might be better in Sequential ?+init :: [a] -> [a]+init [] = []+init [_] = []+init (x:xs) = x : init xs++-- TODO: this might be better in Sequential ?+last :: [a] -> a+last [] = undefined+last [x] = x+last (_:xs) = last xs+++-- | get the path prefix information+--+-- ```+-- prefix "/home/tab" == ()+-- ```+--+-- or for URI (TODO, not yet accurate)+--+-- ```+-- prefix "http://github.com/vincenthz/hs-foundation?w=1"+--    == URISchema http Nothing Nothing "github.com" Nothing+-- ```+prefix :: Path path => path -> PathPrefix path+prefix p = pre+  where+    (pre, _, _) = splitPath p++-- | get the path suffix information+--+-- ```+-- suffix "/home/tab" == ()+-- ```+--+-- or for URI (TODO, not yet accurate)+--+-- ```+-- suffix "http://github.com/vincenthz/hs-foundation?w=1"+--    == URISuffix (["w", "1"], Nothing)+-- ```+suffix :: Path path => path -> PathSuffix path+suffix p = suf+  where+    (_, _, suf) = splitPath p
+ Foundation/VFS/URI.hs view
@@ -0,0 +1,38 @@+-- |+-- Module      : Foundation.VFS.URI+-- License     : BSD-style+-- Maintainer  : foundation+-- Stability   : experimental+-- Portability : portable+--++module Foundation.VFS.URI+    ( URI(..)+    , URISchema(..)+    , URIAuthority(..)+    , URIQuery(..)+    , URIFragment(..)+    , URIPath(..)+    ) where++import Foundation.Internal.Base+import Foundation.VFS.Path(Path(..))++-- ------------------------------------------------------------------------- --+--                                URI                                        --+-- ------------------------------------------------------------------------- --++-- | TODO this is not implemented yet+data URI = URI+data URISchema = URISchema+data URIAuthority = URIAuthority+data URIQuery = URIQuery+data URIFragment = URIFragment+data URIPath = URIPath+instance Path URI where+    type PathEnt URI = URIPath+    type PathPrefix URI = (URISchema, URIAuthority)+    type PathSuffix URI = (URIQuery, URIFragment)+    (</>) = undefined+    splitPath = undefined+    buildPath = undefined
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2015-2016 Vincent Hanquez <vincent@snarc.org>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,65 @@+Foundation+==========++[![Build Status](https://travis-ci.org/haskell-foundation/foundation.png?branch=master)](https://travis-ci.org/haskell-foundation/foundation)+[![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses)+[![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org)++Documentation: [foundation on hackage](http://hackage.haskell.org/package/foundation)++Goals+=====++* provide a base like set of modules that provide a consistent set of features and bugfixes across multiple versions of GHC (unlike base).+* provide a better and more efficient prelude than base's prelude.+* be self-sufficient: no external dependencies apart from base (or ghc packages).+* provide better data-types: packed unicode string by default, arrays.+* Better numerical classes that better represent mathematical things (No more all-in-one Num).++How to use+==========++Disable the built-in prelude at the top of your file:++```haskell+{-# LANGUAGE NoImplicitPrelude #-}+```++Or directly in your project cabal file:++```haskell+Default-Extensions: NoImplicitPrelude+```++Then in your modules:++```haskell+import Foundation+```++How to contribute+=================++Any contributions is welcome, but a short list includes:++* Improve the code base+* Report an issue+* Fix an issue+* Improve the documentation+* Make tutorial on how to use foundation+* Make your project use foundation instead of base, report the missing coverage (IO, types, etc.), or what functionality is missing to make a succesful transition+++Design+======++Foundation started on the simple idea of trying to put everything I need in one+simple and consistent package. The amazing haskell ecosystem is extremely+fragmented and maintained by different people with different goals, free time,+and style. The overall scare of not trying to change anything relatively+central (base, bytestring, text, vector ..) for a promise of stability has pushed+many people to work on their own thing, leading to unnecessary work duplication+and further fragmentation.+++Foundation uses and abuses type families.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchs/Array.hs view
@@ -0,0 +1,16 @@+module Main where++import Foundation+import Foundation.Collection+import Criterion.Main++main = defaultMain+    [ bgroup "Uarray"+        [ bench "fromList [Word8]" $ whnf (fromList :: [Word8] -> UArray Word8) [1..255]+        , bench "fromList [Word16]" $ whnf (fromList :: [Word16] -> UArray Word16) [1..1024]+        , bench "break" $ whnf (break (== 255)) input+        ]+    ]+  where+    input :: UArray Word8+    input = fromList ([1..255] <> [1..255])
+ benchs/ProfBreak.hs view
@@ -0,0 +1,9 @@+module Main where++import Foundation+import Foundation.Collection++main = do+    let v = fromList [1..255] :: UArray Word8+    let (v1,v2) = break ((==) 128) v+    putStrLn $ (fromList $ show v1) <> (fromList $ show v2)
+ foundation.cabal view
@@ -0,0 +1,156 @@+Name:                foundation+Version:             0.0.1+Synopsis:            Alternative prelude with batteries and no dependencies+Description:+    A custom prelude with no dependencies apart from base.+    .+    This package has the following goals:+    .+    * provide a base like sets of modules that provide a consistent set of features and bugfixes across multiple versions of GHC (unlike base).+    .+    * provide a better and more efficient prelude than base's prelude.+    .+    * be self-sufficient: no external dependencies apart from base.+    .+    * provide better data-types: packed unicode string by default, arrays.+    .+    * Better numerical classes that better represent mathematical thing (No more all-in-one Num).+    .+    * Better I/O system with less Lazy IO+    .+    * Usual partial functions distinguished through type system+License:             BSD3+License-file:        LICENSE+Copyright:           Vincent Hanquez <vincent@snarc.org>+Author:              Vincent Hanquez <vincent@snarc.org>+Maintainer:          vincent@snarc.org+Category:            foundation+Stability:           experimental+Build-Type:          Simple+Homepage:            https://github.com/haskell-foundation/foundation+Bug-Reports:         https://github.com/haskell-foundation/foundation/issues+Cabal-Version:       >=1.10+tested-with:         GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+extra-source-files:  README.md++source-repository head+  type: git+  location: https://github.com/haskell-foundation/foundation++Library+  Exposed-modules:   Foundation+                     Foundation.Number+                     Foundation.Array+                     Foundation.Array.Internal+                     Foundation.Convertible+                     Foundation.String+                     Foundation.IO+                     Foundation.IO.FileMap+                     Foundation.VFS+                     Foundation.VFS.Path+                     Foundation.VFS.FilePath+                     Foundation.VFS.URI+                     Foundation.Foreign+                     Foundation.Collection+                     Foundation.Primitive+                     Foundation.System.Info+                     Foundation.Strict+  Other-modules:     Foundation.String.Internal+                     Foundation.String.UTF8+                     Foundation.String.Encoding.Encoding+                     Foundation.String.Encoding.UTF16+                     Foundation.String.Encoding.UTF32+                     Foundation.String.Encoding.ASCII7+                     Foundation.String.Encoding.ISO_8859_1+                     Foundation.String.UTF8Table+                     Foundation.String.ModifiedUTF8+                     Foundation.Tuple+                     Foundation.Collection.List+                     Foundation.Collection.Element+                     Foundation.Collection.InnerFunctor+                     Foundation.Collection.Sequential+                     Foundation.Collection.Keyed+                     Foundation.Collection.Indexed+                     Foundation.Collection.Foldable+                     Foundation.Collection.Mutable+                     Foundation.Collection.Zippable+                     Foundation.Internal.Base+                     Foundation.Internal.Primitive+                     Foundation.Internal.IsList+                     Foundation.Internal.Identity+                     Foundation.Internal.Proxy+                     Foundation.Internal.Types+                     Foundation.Internal.PrimTypes+                     Foundation.Internal.MonadTrans+                     Foundation.IO.File+                     Foundation.IO.Terminal+                     Foundation.Primitive.Types+                     Foundation.Primitive.Monad+                     Foundation.Primitive.Utils+                     Foundation.Primitive.FinalPtr+                     Foundation.Array.Common+                     Foundation.Array.Unboxed+                     Foundation.Array.Unboxed.Builder+                     Foundation.Array.Unboxed.Mutable+                     Foundation.Array.Unboxed.ByteArray+                     Foundation.Array.Boxed+                     Foundation.Array.Bitmap+                     Foundation.Foreign.MemoryMap+                     Foundation.Foreign.MemoryMap.Types+                     Foundation.Partial+  if os(windows)+    Other-modules:   Foundation.Foreign.MemoryMap.Windows+  else+    Other-modules:   Foundation.Foreign.MemoryMap.Posix+  Default-Extensions: NoImplicitPrelude+                      TypeFamilies+                      BangPatterns+                      DeriveDataTypeable+  Build-depends:     base >= 4 && < 5+                   , ghc-prim+  -- FIXME add suport for armel mipsel+  --  CPP-options: -DARCH_IS_LITTLE_ENDIAN+  -- FIXME add support for powerpc powerpc64 armeb mipseb+  --  CPP-options: -DARCH_IS_BIG_ENDIAN+  if (arch(i386) || arch(x86_64))+    CPP-options: -DARCH_IS_LITTLE_ENDIAN+  else+    CPP-options: -DARCH_IS_UNKNOWN_ENDIAN+  if os(windows)+    Build-depends:    Win32+  ghc-options:       -Wall -fwarn-tabs+  default-language:  Haskell2010++Test-Suite test-foundation+  type:              exitcode-stdio-1.0+  hs-source-dirs:    tests+  Main-is:           Tests.hs+  Other-modules:     ForeignUtils+                     Encoding+  Build-Depends:     base >= 3 && < 5+                   , mtl+                   , QuickCheck+                   , tasty+                   , tasty-quickcheck+                   , tasty-hunit+                   , foundation+  ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures+  default-language:  Haskell2010++Benchmark bench-array+  Main-Is:           Array.hs+  hs-source-dirs:    benchs+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  Default-Extensions: NoImplicitPrelude+                      BangPatterns+  Build-depends:     base >= 4, criterion, foundation++Benchmark bench-profile-break+  Main-Is:           ProfBreak.hs+  hs-source-dirs:    benchs+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  Default-Extensions: NoImplicitPrelude+                      BangPatterns+  Build-depends:     foundation
+ tests/Encoding.hs view
@@ -0,0 +1,956 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Encoding+  ( EncodedString(..)+  , sample0+  , sample1+  , sample2++  , testEncodings+  ) where++import Foundation+import Foundation.String (Encoding(..), fromBytes, toBytes)+import Foundation.Array.Internal (recast)++import Test.Tasty+import Test.Tasty.HUnit++data EncodedString = EncodedString Encoding (UArray Word8)++testEncodings :: ([EncodedString], String) -> [TestTree]+testEncodings ([]  , _       ) = []+testEncodings (x:xs, expected) = testEncoding x expected <> testEncodings (xs, expected)++testEncoding :: EncodedString -> String -> [TestTree]+testEncoding (EncodedString encoding ba) expected =+    [ testCase (show encoding <> " -> UTF8") $ testFromBytes+    , testCase ("UTF8 -> " <> show encoding) $ testToBytes+    ]+  where+    testFromBytes :: Assertion+    testFromBytes = case fromBytes encoding ba of+      (str, _, _) -> assertEqual "testFromBytes: " expected str+    testToBytes :: Assertion+    testToBytes =+      let bytes = toBytes encoding expected+       in assertEqual "testToBytes: " ba bytes++-- -------------------------- Sample 0 ------------------------------------- --++sample0 :: ([EncodedString], String)+sample0 = ( [sample0_ASCII7, sample0_UTF8, sample0_UTF16, sample0_ISO_8859_1]+          , sample0_String+          )++sample0_String :: String+sample0_String =+    "Called forth to stand trial on Trantor for allegations of treason (for\n\+    \foreshadowing the decline of the Galactic Empire), Seldon explains that his\n\+    \science of psychohistory foresees many alternatives, all of which result in the\n\+    \Galactic Empire eventually falling. If humanity follows its current path, the\n\+    \Empire will fall and 30,000 years of turmoil will overcome humanity before a\n\+    \second Empire arises. However, an alternative path allows for the intervening\n\+    \years to be only one thousand, if Seldon is allowed to collect the most\n\+    \intelligent minds and create a compendium of all human knowledge, entitled\n\+    \Encyclopedia Galactica. The board is still wary but allows Seldon to assemble\n\+    \whomever he needs, provided he and the \"Encyclopedists\" be exiled to a remote\n\+    \planet, Terminus. Seldon agrees to set up his own collection of Encyclopedists,\n\+    \and also secretly implements a contingency plan-a second Foundation-at the\n\+    \\"opposite end\" of the galaxy.\n"++sample0_ASCII7 :: EncodedString+sample0_ASCII7 = EncodedString ASCII7 $ fromList+  [ 0x43, 0x61, 0x6c, 0x6c, 0x65, 0x64, 0x20, 0x66, 0x6f, 0x72, 0x74, 0x68, 0x20, 0x74, 0x6f, 0x20+  , 0x73, 0x74, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x72, 0x69, 0x61, 0x6c, 0x20, 0x6f, 0x6e, 0x20, 0x54+  , 0x72, 0x61, 0x6e, 0x74, 0x6f, 0x72, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x61, 0x6c, 0x6c, 0x65, 0x67+  , 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x72, 0x65, 0x61, 0x73, 0x6f+  , 0x6e, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x0a, 0x66, 0x6f, 0x72, 0x65, 0x73, 0x68, 0x61, 0x64, 0x6f+  , 0x77, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x68, 0x65, 0x20, 0x64, 0x65, 0x63, 0x6c, 0x69, 0x6e, 0x65+  , 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x47, 0x61, 0x6c, 0x61, 0x63, 0x74, 0x69, 0x63+  , 0x20, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x29, 0x2c, 0x20, 0x53, 0x65, 0x6c, 0x64, 0x6f, 0x6e+  , 0x20, 0x65, 0x78, 0x70, 0x6c, 0x61, 0x69, 0x6e, 0x73, 0x20, 0x74, 0x68, 0x61, 0x74, 0x20, 0x68+  , 0x69, 0x73, 0x0a, 0x73, 0x63, 0x69, 0x65, 0x6e, 0x63, 0x65, 0x20, 0x6f, 0x66, 0x20, 0x70, 0x73+  , 0x79, 0x63, 0x68, 0x6f, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x20, 0x66, 0x6f, 0x72, 0x65+  , 0x73, 0x65, 0x65, 0x73, 0x20, 0x6d, 0x61, 0x6e, 0x79, 0x20, 0x61, 0x6c, 0x74, 0x65, 0x72, 0x6e+  , 0x61, 0x74, 0x69, 0x76, 0x65, 0x73, 0x2c, 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x6f, 0x66, 0x20, 0x77+  , 0x68, 0x69, 0x63, 0x68, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x74+  , 0x68, 0x65, 0x0a, 0x47, 0x61, 0x6c, 0x61, 0x63, 0x74, 0x69, 0x63, 0x20, 0x45, 0x6d, 0x70, 0x69+  , 0x72, 0x65, 0x20, 0x65, 0x76, 0x65, 0x6e, 0x74, 0x75, 0x61, 0x6c, 0x6c, 0x79, 0x20, 0x66, 0x61+  , 0x6c, 0x6c, 0x69, 0x6e, 0x67, 0x2e, 0x20, 0x49, 0x66, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x6e, 0x69+  , 0x74, 0x79, 0x20, 0x66, 0x6f, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x69, 0x74, 0x73, 0x20, 0x63+  , 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x70, 0x61, 0x74, 0x68, 0x2c, 0x20, 0x74, 0x68, 0x65+  , 0x0a, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x20, 0x77, 0x69, 0x6c, 0x6c, 0x20, 0x66, 0x61, 0x6c+  , 0x6c, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x33, 0x30, 0x2c, 0x30, 0x30, 0x30, 0x20, 0x79, 0x65, 0x61+  , 0x72, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x75, 0x72, 0x6d, 0x6f, 0x69, 0x6c, 0x20, 0x77, 0x69+  , 0x6c, 0x6c, 0x20, 0x6f, 0x76, 0x65, 0x72, 0x63, 0x6f, 0x6d, 0x65, 0x20, 0x68, 0x75, 0x6d, 0x61+  , 0x6e, 0x69, 0x74, 0x79, 0x20, 0x62, 0x65, 0x66, 0x6f, 0x72, 0x65, 0x20, 0x61, 0x0a, 0x73, 0x65+  , 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x20, 0x61, 0x72, 0x69, 0x73+  , 0x65, 0x73, 0x2e, 0x20, 0x48, 0x6f, 0x77, 0x65, 0x76, 0x65, 0x72, 0x2c, 0x20, 0x61, 0x6e, 0x20+  , 0x61, 0x6c, 0x74, 0x65, 0x72, 0x6e, 0x61, 0x74, 0x69, 0x76, 0x65, 0x20, 0x70, 0x61, 0x74, 0x68+  , 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x74, 0x68, 0x65, 0x20+  , 0x69, 0x6e, 0x74, 0x65, 0x72, 0x76, 0x65, 0x6e, 0x69, 0x6e, 0x67, 0x0a, 0x79, 0x65, 0x61, 0x72+  , 0x73, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x65, 0x20, 0x6f, 0x6e, 0x6c, 0x79, 0x20, 0x6f, 0x6e, 0x65+  , 0x20, 0x74, 0x68, 0x6f, 0x75, 0x73, 0x61, 0x6e, 0x64, 0x2c, 0x20, 0x69, 0x66, 0x20, 0x53, 0x65+  , 0x6c, 0x64, 0x6f, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x65, 0x64, 0x20+  , 0x74, 0x6f, 0x20, 0x63, 0x6f, 0x6c, 0x6c, 0x65, 0x63, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6d+  , 0x6f, 0x73, 0x74, 0x0a, 0x69, 0x6e, 0x74, 0x65, 0x6c, 0x6c, 0x69, 0x67, 0x65, 0x6e, 0x74, 0x20+  , 0x6d, 0x69, 0x6e, 0x64, 0x73, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x72, 0x65, 0x61, 0x74, 0x65+  , 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x65, 0x6e, 0x64, 0x69, 0x75, 0x6d, 0x20, 0x6f, 0x66+  , 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x6e, 0x20, 0x6b, 0x6e, 0x6f, 0x77, 0x6c+  , 0x65, 0x64, 0x67, 0x65, 0x2c, 0x20, 0x65, 0x6e, 0x74, 0x69, 0x74, 0x6c, 0x65, 0x64, 0x0a, 0x45+  , 0x6e, 0x63, 0x79, 0x63, 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69, 0x61, 0x20, 0x47, 0x61, 0x6c, 0x61+  , 0x63, 0x74, 0x69, 0x63, 0x61, 0x2e, 0x20, 0x54, 0x68, 0x65, 0x20, 0x62, 0x6f, 0x61, 0x72, 0x64+  , 0x20, 0x69, 0x73, 0x20, 0x73, 0x74, 0x69, 0x6c, 0x6c, 0x20, 0x77, 0x61, 0x72, 0x79, 0x20, 0x62+  , 0x75, 0x74, 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x53, 0x65, 0x6c, 0x64, 0x6f, 0x6e+  , 0x20, 0x74, 0x6f, 0x20, 0x61, 0x73, 0x73, 0x65, 0x6d, 0x62, 0x6c, 0x65, 0x0a, 0x77, 0x68, 0x6f+  , 0x6d, 0x65, 0x76, 0x65, 0x72, 0x20, 0x68, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x73, 0x2c, 0x20+  , 0x70, 0x72, 0x6f, 0x76, 0x69, 0x64, 0x65, 0x64, 0x20, 0x68, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20+  , 0x74, 0x68, 0x65, 0x20, 0x22, 0x45, 0x6e, 0x63, 0x79, 0x63, 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69+  , 0x73, 0x74, 0x73, 0x22, 0x20, 0x62, 0x65, 0x20, 0x65, 0x78, 0x69, 0x6c, 0x65, 0x64, 0x20, 0x74+  , 0x6f, 0x20, 0x61, 0x20, 0x72, 0x65, 0x6d, 0x6f, 0x74, 0x65, 0x0a, 0x70, 0x6c, 0x61, 0x6e, 0x65+  , 0x74, 0x2c, 0x20, 0x54, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x75, 0x73, 0x2e, 0x20, 0x53, 0x65, 0x6c+  , 0x64, 0x6f, 0x6e, 0x20, 0x61, 0x67, 0x72, 0x65, 0x65, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x73, 0x65+  , 0x74, 0x20, 0x75, 0x70, 0x20, 0x68, 0x69, 0x73, 0x20, 0x6f, 0x77, 0x6e, 0x20, 0x63, 0x6f, 0x6c+  , 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6f, 0x66, 0x20, 0x45, 0x6e, 0x63, 0x79, 0x63+  , 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69, 0x73, 0x74, 0x73, 0x2c, 0x0a, 0x61, 0x6e, 0x64, 0x20, 0x61+  , 0x6c, 0x73, 0x6f, 0x20, 0x73, 0x65, 0x63, 0x72, 0x65, 0x74, 0x6c, 0x79, 0x20, 0x69, 0x6d, 0x70+  , 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x69, 0x6e+  , 0x67, 0x65, 0x6e, 0x63, 0x79, 0x20, 0x70, 0x6c, 0x61, 0x6e, 0x2d, 0x61, 0x20, 0x73, 0x65, 0x63+  , 0x6f, 0x6e, 0x64, 0x20, 0x46, 0x6f, 0x75, 0x6e, 0x64, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x2d, 0x61+  , 0x74, 0x20, 0x74, 0x68, 0x65, 0x0a, 0x22, 0x6f, 0x70, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x65, 0x20+  , 0x65, 0x6e, 0x64, 0x22, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x67, 0x61, 0x6c, 0x61+  , 0x78, 0x79, 0x2e, 0x0a+  ]+++sample0_UTF8 :: EncodedString+sample0_UTF8 = EncodedString UTF8 $ fromList+  [ 0x43, 0x61, 0x6c, 0x6c, 0x65, 0x64, 0x20, 0x66, 0x6f, 0x72, 0x74, 0x68, 0x20, 0x74, 0x6f, 0x20+  , 0x73, 0x74, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x72, 0x69, 0x61, 0x6c, 0x20, 0x6f, 0x6e, 0x20, 0x54+  , 0x72, 0x61, 0x6e, 0x74, 0x6f, 0x72, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x61, 0x6c, 0x6c, 0x65, 0x67+  , 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x72, 0x65, 0x61, 0x73, 0x6f+  , 0x6e, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x0a, 0x66, 0x6f, 0x72, 0x65, 0x73, 0x68, 0x61, 0x64, 0x6f+  , 0x77, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x68, 0x65, 0x20, 0x64, 0x65, 0x63, 0x6c, 0x69, 0x6e, 0x65+  , 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x47, 0x61, 0x6c, 0x61, 0x63, 0x74, 0x69, 0x63+  , 0x20, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x29, 0x2c, 0x20, 0x53, 0x65, 0x6c, 0x64, 0x6f, 0x6e+  , 0x20, 0x65, 0x78, 0x70, 0x6c, 0x61, 0x69, 0x6e, 0x73, 0x20, 0x74, 0x68, 0x61, 0x74, 0x20, 0x68+  , 0x69, 0x73, 0x0a, 0x73, 0x63, 0x69, 0x65, 0x6e, 0x63, 0x65, 0x20, 0x6f, 0x66, 0x20, 0x70, 0x73+  , 0x79, 0x63, 0x68, 0x6f, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x20, 0x66, 0x6f, 0x72, 0x65+  , 0x73, 0x65, 0x65, 0x73, 0x20, 0x6d, 0x61, 0x6e, 0x79, 0x20, 0x61, 0x6c, 0x74, 0x65, 0x72, 0x6e+  , 0x61, 0x74, 0x69, 0x76, 0x65, 0x73, 0x2c, 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x6f, 0x66, 0x20, 0x77+  , 0x68, 0x69, 0x63, 0x68, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x74+  , 0x68, 0x65, 0x0a, 0x47, 0x61, 0x6c, 0x61, 0x63, 0x74, 0x69, 0x63, 0x20, 0x45, 0x6d, 0x70, 0x69+  , 0x72, 0x65, 0x20, 0x65, 0x76, 0x65, 0x6e, 0x74, 0x75, 0x61, 0x6c, 0x6c, 0x79, 0x20, 0x66, 0x61+  , 0x6c, 0x6c, 0x69, 0x6e, 0x67, 0x2e, 0x20, 0x49, 0x66, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x6e, 0x69+  , 0x74, 0x79, 0x20, 0x66, 0x6f, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x69, 0x74, 0x73, 0x20, 0x63+  , 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x70, 0x61, 0x74, 0x68, 0x2c, 0x20, 0x74, 0x68, 0x65+  , 0x0a, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x20, 0x77, 0x69, 0x6c, 0x6c, 0x20, 0x66, 0x61, 0x6c+  , 0x6c, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x33, 0x30, 0x2c, 0x30, 0x30, 0x30, 0x20, 0x79, 0x65, 0x61+  , 0x72, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x75, 0x72, 0x6d, 0x6f, 0x69, 0x6c, 0x20, 0x77, 0x69+  , 0x6c, 0x6c, 0x20, 0x6f, 0x76, 0x65, 0x72, 0x63, 0x6f, 0x6d, 0x65, 0x20, 0x68, 0x75, 0x6d, 0x61+  , 0x6e, 0x69, 0x74, 0x79, 0x20, 0x62, 0x65, 0x66, 0x6f, 0x72, 0x65, 0x20, 0x61, 0x0a, 0x73, 0x65+  , 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x20, 0x61, 0x72, 0x69, 0x73+  , 0x65, 0x73, 0x2e, 0x20, 0x48, 0x6f, 0x77, 0x65, 0x76, 0x65, 0x72, 0x2c, 0x20, 0x61, 0x6e, 0x20+  , 0x61, 0x6c, 0x74, 0x65, 0x72, 0x6e, 0x61, 0x74, 0x69, 0x76, 0x65, 0x20, 0x70, 0x61, 0x74, 0x68+  , 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x74, 0x68, 0x65, 0x20+  , 0x69, 0x6e, 0x74, 0x65, 0x72, 0x76, 0x65, 0x6e, 0x69, 0x6e, 0x67, 0x0a, 0x79, 0x65, 0x61, 0x72+  , 0x73, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x65, 0x20, 0x6f, 0x6e, 0x6c, 0x79, 0x20, 0x6f, 0x6e, 0x65+  , 0x20, 0x74, 0x68, 0x6f, 0x75, 0x73, 0x61, 0x6e, 0x64, 0x2c, 0x20, 0x69, 0x66, 0x20, 0x53, 0x65+  , 0x6c, 0x64, 0x6f, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x65, 0x64, 0x20+  , 0x74, 0x6f, 0x20, 0x63, 0x6f, 0x6c, 0x6c, 0x65, 0x63, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6d+  , 0x6f, 0x73, 0x74, 0x0a, 0x69, 0x6e, 0x74, 0x65, 0x6c, 0x6c, 0x69, 0x67, 0x65, 0x6e, 0x74, 0x20+  , 0x6d, 0x69, 0x6e, 0x64, 0x73, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x72, 0x65, 0x61, 0x74, 0x65+  , 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x65, 0x6e, 0x64, 0x69, 0x75, 0x6d, 0x20, 0x6f, 0x66+  , 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x6e, 0x20, 0x6b, 0x6e, 0x6f, 0x77, 0x6c+  , 0x65, 0x64, 0x67, 0x65, 0x2c, 0x20, 0x65, 0x6e, 0x74, 0x69, 0x74, 0x6c, 0x65, 0x64, 0x0a, 0x45+  , 0x6e, 0x63, 0x79, 0x63, 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69, 0x61, 0x20, 0x47, 0x61, 0x6c, 0x61+  , 0x63, 0x74, 0x69, 0x63, 0x61, 0x2e, 0x20, 0x54, 0x68, 0x65, 0x20, 0x62, 0x6f, 0x61, 0x72, 0x64+  , 0x20, 0x69, 0x73, 0x20, 0x73, 0x74, 0x69, 0x6c, 0x6c, 0x20, 0x77, 0x61, 0x72, 0x79, 0x20, 0x62+  , 0x75, 0x74, 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x53, 0x65, 0x6c, 0x64, 0x6f, 0x6e+  , 0x20, 0x74, 0x6f, 0x20, 0x61, 0x73, 0x73, 0x65, 0x6d, 0x62, 0x6c, 0x65, 0x0a, 0x77, 0x68, 0x6f+  , 0x6d, 0x65, 0x76, 0x65, 0x72, 0x20, 0x68, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x73, 0x2c, 0x20+  , 0x70, 0x72, 0x6f, 0x76, 0x69, 0x64, 0x65, 0x64, 0x20, 0x68, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20+  , 0x74, 0x68, 0x65, 0x20, 0x22, 0x45, 0x6e, 0x63, 0x79, 0x63, 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69+  , 0x73, 0x74, 0x73, 0x22, 0x20, 0x62, 0x65, 0x20, 0x65, 0x78, 0x69, 0x6c, 0x65, 0x64, 0x20, 0x74+  , 0x6f, 0x20, 0x61, 0x20, 0x72, 0x65, 0x6d, 0x6f, 0x74, 0x65, 0x0a, 0x70, 0x6c, 0x61, 0x6e, 0x65+  , 0x74, 0x2c, 0x20, 0x54, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x75, 0x73, 0x2e, 0x20, 0x53, 0x65, 0x6c+  , 0x64, 0x6f, 0x6e, 0x20, 0x61, 0x67, 0x72, 0x65, 0x65, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x73, 0x65+  , 0x74, 0x20, 0x75, 0x70, 0x20, 0x68, 0x69, 0x73, 0x20, 0x6f, 0x77, 0x6e, 0x20, 0x63, 0x6f, 0x6c+  , 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6f, 0x66, 0x20, 0x45, 0x6e, 0x63, 0x79, 0x63+  , 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69, 0x73, 0x74, 0x73, 0x2c, 0x0a, 0x61, 0x6e, 0x64, 0x20, 0x61+  , 0x6c, 0x73, 0x6f, 0x20, 0x73, 0x65, 0x63, 0x72, 0x65, 0x74, 0x6c, 0x79, 0x20, 0x69, 0x6d, 0x70+  , 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x69, 0x6e+  , 0x67, 0x65, 0x6e, 0x63, 0x79, 0x20, 0x70, 0x6c, 0x61, 0x6e, 0x2d, 0x61, 0x20, 0x73, 0x65, 0x63+  , 0x6f, 0x6e, 0x64, 0x20, 0x46, 0x6f, 0x75, 0x6e, 0x64, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x2d, 0x61+  , 0x74, 0x20, 0x74, 0x68, 0x65, 0x0a, 0x22, 0x6f, 0x70, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x65, 0x20+  , 0x65, 0x6e, 0x64, 0x22, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x67, 0x61, 0x6c, 0x61+  , 0x78, 0x79, 0x2e, 0x0a+  ]++sample0_UTF16 :: EncodedString+sample0_UTF16 = EncodedString UTF16 $ recast array+  where+    array :: UArray Word16+    array = fromList+      [ 0x0043, 0x0061, 0x006c, 0x006c, 0x0065, 0x0064, 0x0020, 0x0066+      , 0x006f, 0x0072, 0x0074, 0x0068, 0x0020, 0x0074, 0x006f, 0x0020+      , 0x0073, 0x0074, 0x0061, 0x006e, 0x0064, 0x0020, 0x0074, 0x0072+      , 0x0069, 0x0061, 0x006c, 0x0020, 0x006f, 0x006e, 0x0020, 0x0054+      , 0x0072, 0x0061, 0x006e, 0x0074, 0x006f, 0x0072, 0x0020, 0x0066+      , 0x006f, 0x0072, 0x0020, 0x0061, 0x006c, 0x006c, 0x0065, 0x0067+      , 0x0061, 0x0074, 0x0069, 0x006f, 0x006e, 0x0073, 0x0020, 0x006f+      , 0x0066, 0x0020, 0x0074, 0x0072, 0x0065, 0x0061, 0x0073, 0x006f+      , 0x006e, 0x0020, 0x0028, 0x0066, 0x006f, 0x0072, 0x000a, 0x0066+      , 0x006f, 0x0072, 0x0065, 0x0073, 0x0068, 0x0061, 0x0064, 0x006f+      , 0x0077, 0x0069, 0x006e, 0x0067, 0x0020, 0x0074, 0x0068, 0x0065+      , 0x0020, 0x0064, 0x0065, 0x0063, 0x006c, 0x0069, 0x006e, 0x0065+      , 0x0020, 0x006f, 0x0066, 0x0020, 0x0074, 0x0068, 0x0065, 0x0020+      , 0x0047, 0x0061, 0x006c, 0x0061, 0x0063, 0x0074, 0x0069, 0x0063+      , 0x0020, 0x0045, 0x006d, 0x0070, 0x0069, 0x0072, 0x0065, 0x0029+      , 0x002c, 0x0020, 0x0053, 0x0065, 0x006c, 0x0064, 0x006f, 0x006e+      , 0x0020, 0x0065, 0x0078, 0x0070, 0x006c, 0x0061, 0x0069, 0x006e+      , 0x0073, 0x0020, 0x0074, 0x0068, 0x0061, 0x0074, 0x0020, 0x0068+      , 0x0069, 0x0073, 0x000a, 0x0073, 0x0063, 0x0069, 0x0065, 0x006e+      , 0x0063, 0x0065, 0x0020, 0x006f, 0x0066, 0x0020, 0x0070, 0x0073+      , 0x0079, 0x0063, 0x0068, 0x006f, 0x0068, 0x0069, 0x0073, 0x0074+      , 0x006f, 0x0072, 0x0079, 0x0020, 0x0066, 0x006f, 0x0072, 0x0065+      , 0x0073, 0x0065, 0x0065, 0x0073, 0x0020, 0x006d, 0x0061, 0x006e+      , 0x0079, 0x0020, 0x0061, 0x006c, 0x0074, 0x0065, 0x0072, 0x006e+      , 0x0061, 0x0074, 0x0069, 0x0076, 0x0065, 0x0073, 0x002c, 0x0020+      , 0x0061, 0x006c, 0x006c, 0x0020, 0x006f, 0x0066, 0x0020, 0x0077+      , 0x0068, 0x0069, 0x0063, 0x0068, 0x0020, 0x0072, 0x0065, 0x0073+      , 0x0075, 0x006c, 0x0074, 0x0020, 0x0069, 0x006e, 0x0020, 0x0074+      , 0x0068, 0x0065, 0x000a, 0x0047, 0x0061, 0x006c, 0x0061, 0x0063+      , 0x0074, 0x0069, 0x0063, 0x0020, 0x0045, 0x006d, 0x0070, 0x0069+      , 0x0072, 0x0065, 0x0020, 0x0065, 0x0076, 0x0065, 0x006e, 0x0074+      , 0x0075, 0x0061, 0x006c, 0x006c, 0x0079, 0x0020, 0x0066, 0x0061+      , 0x006c, 0x006c, 0x0069, 0x006e, 0x0067, 0x002e, 0x0020, 0x0049+      , 0x0066, 0x0020, 0x0068, 0x0075, 0x006d, 0x0061, 0x006e, 0x0069+      , 0x0074, 0x0079, 0x0020, 0x0066, 0x006f, 0x006c, 0x006c, 0x006f+      , 0x0077, 0x0073, 0x0020, 0x0069, 0x0074, 0x0073, 0x0020, 0x0063+      , 0x0075, 0x0072, 0x0072, 0x0065, 0x006e, 0x0074, 0x0020, 0x0070+      , 0x0061, 0x0074, 0x0068, 0x002c, 0x0020, 0x0074, 0x0068, 0x0065+      , 0x000a, 0x0045, 0x006d, 0x0070, 0x0069, 0x0072, 0x0065, 0x0020+      , 0x0077, 0x0069, 0x006c, 0x006c, 0x0020, 0x0066, 0x0061, 0x006c+      , 0x006c, 0x0020, 0x0061, 0x006e, 0x0064, 0x0020, 0x0033, 0x0030+      , 0x002c, 0x0030, 0x0030, 0x0030, 0x0020, 0x0079, 0x0065, 0x0061+      , 0x0072, 0x0073, 0x0020, 0x006f, 0x0066, 0x0020, 0x0074, 0x0075+      , 0x0072, 0x006d, 0x006f, 0x0069, 0x006c, 0x0020, 0x0077, 0x0069+      , 0x006c, 0x006c, 0x0020, 0x006f, 0x0076, 0x0065, 0x0072, 0x0063+      , 0x006f, 0x006d, 0x0065, 0x0020, 0x0068, 0x0075, 0x006d, 0x0061+      , 0x006e, 0x0069, 0x0074, 0x0079, 0x0020, 0x0062, 0x0065, 0x0066+      , 0x006f, 0x0072, 0x0065, 0x0020, 0x0061, 0x000a, 0x0073, 0x0065+      , 0x0063, 0x006f, 0x006e, 0x0064, 0x0020, 0x0045, 0x006d, 0x0070+      , 0x0069, 0x0072, 0x0065, 0x0020, 0x0061, 0x0072, 0x0069, 0x0073+      , 0x0065, 0x0073, 0x002e, 0x0020, 0x0048, 0x006f, 0x0077, 0x0065+      , 0x0076, 0x0065, 0x0072, 0x002c, 0x0020, 0x0061, 0x006e, 0x0020+      , 0x0061, 0x006c, 0x0074, 0x0065, 0x0072, 0x006e, 0x0061, 0x0074+      , 0x0069, 0x0076, 0x0065, 0x0020, 0x0070, 0x0061, 0x0074, 0x0068+      , 0x0020, 0x0061, 0x006c, 0x006c, 0x006f, 0x0077, 0x0073, 0x0020+      , 0x0066, 0x006f, 0x0072, 0x0020, 0x0074, 0x0068, 0x0065, 0x0020+      , 0x0069, 0x006e, 0x0074, 0x0065, 0x0072, 0x0076, 0x0065, 0x006e+      , 0x0069, 0x006e, 0x0067, 0x000a, 0x0079, 0x0065, 0x0061, 0x0072+      , 0x0073, 0x0020, 0x0074, 0x006f, 0x0020, 0x0062, 0x0065, 0x0020+      , 0x006f, 0x006e, 0x006c, 0x0079, 0x0020, 0x006f, 0x006e, 0x0065+      , 0x0020, 0x0074, 0x0068, 0x006f, 0x0075, 0x0073, 0x0061, 0x006e+      , 0x0064, 0x002c, 0x0020, 0x0069, 0x0066, 0x0020, 0x0053, 0x0065+      , 0x006c, 0x0064, 0x006f, 0x006e, 0x0020, 0x0069, 0x0073, 0x0020+      , 0x0061, 0x006c, 0x006c, 0x006f, 0x0077, 0x0065, 0x0064, 0x0020+      , 0x0074, 0x006f, 0x0020, 0x0063, 0x006f, 0x006c, 0x006c, 0x0065+      , 0x0063, 0x0074, 0x0020, 0x0074, 0x0068, 0x0065, 0x0020, 0x006d+      , 0x006f, 0x0073, 0x0074, 0x000a, 0x0069, 0x006e, 0x0074, 0x0065+      , 0x006c, 0x006c, 0x0069, 0x0067, 0x0065, 0x006e, 0x0074, 0x0020+      , 0x006d, 0x0069, 0x006e, 0x0064, 0x0073, 0x0020, 0x0061, 0x006e+      , 0x0064, 0x0020, 0x0063, 0x0072, 0x0065, 0x0061, 0x0074, 0x0065+      , 0x0020, 0x0061, 0x0020, 0x0063, 0x006f, 0x006d, 0x0070, 0x0065+      , 0x006e, 0x0064, 0x0069, 0x0075, 0x006d, 0x0020, 0x006f, 0x0066+      , 0x0020, 0x0061, 0x006c, 0x006c, 0x0020, 0x0068, 0x0075, 0x006d+      , 0x0061, 0x006e, 0x0020, 0x006b, 0x006e, 0x006f, 0x0077, 0x006c+      , 0x0065, 0x0064, 0x0067, 0x0065, 0x002c, 0x0020, 0x0065, 0x006e+      , 0x0074, 0x0069, 0x0074, 0x006c, 0x0065, 0x0064, 0x000a, 0x0045+      , 0x006e, 0x0063, 0x0079, 0x0063, 0x006c, 0x006f, 0x0070, 0x0065+      , 0x0064, 0x0069, 0x0061, 0x0020, 0x0047, 0x0061, 0x006c, 0x0061+      , 0x0063, 0x0074, 0x0069, 0x0063, 0x0061, 0x002e, 0x0020, 0x0054+      , 0x0068, 0x0065, 0x0020, 0x0062, 0x006f, 0x0061, 0x0072, 0x0064+      , 0x0020, 0x0069, 0x0073, 0x0020, 0x0073, 0x0074, 0x0069, 0x006c+      , 0x006c, 0x0020, 0x0077, 0x0061, 0x0072, 0x0079, 0x0020, 0x0062+      , 0x0075, 0x0074, 0x0020, 0x0061, 0x006c, 0x006c, 0x006f, 0x0077+      , 0x0073, 0x0020, 0x0053, 0x0065, 0x006c, 0x0064, 0x006f, 0x006e+      , 0x0020, 0x0074, 0x006f, 0x0020, 0x0061, 0x0073, 0x0073, 0x0065+      , 0x006d, 0x0062, 0x006c, 0x0065, 0x000a, 0x0077, 0x0068, 0x006f+      , 0x006d, 0x0065, 0x0076, 0x0065, 0x0072, 0x0020, 0x0068, 0x0065+      , 0x0020, 0x006e, 0x0065, 0x0065, 0x0064, 0x0073, 0x002c, 0x0020+      , 0x0070, 0x0072, 0x006f, 0x0076, 0x0069, 0x0064, 0x0065, 0x0064+      , 0x0020, 0x0068, 0x0065, 0x0020, 0x0061, 0x006e, 0x0064, 0x0020+      , 0x0074, 0x0068, 0x0065, 0x0020, 0x0022, 0x0045, 0x006e, 0x0063+      , 0x0079, 0x0063, 0x006c, 0x006f, 0x0070, 0x0065, 0x0064, 0x0069+      , 0x0073, 0x0074, 0x0073, 0x0022, 0x0020, 0x0062, 0x0065, 0x0020+      , 0x0065, 0x0078, 0x0069, 0x006c, 0x0065, 0x0064, 0x0020, 0x0074+      , 0x006f, 0x0020, 0x0061, 0x0020, 0x0072, 0x0065, 0x006d, 0x006f+      , 0x0074, 0x0065, 0x000a, 0x0070, 0x006c, 0x0061, 0x006e, 0x0065+      , 0x0074, 0x002c, 0x0020, 0x0054, 0x0065, 0x0072, 0x006d, 0x0069+      , 0x006e, 0x0075, 0x0073, 0x002e, 0x0020, 0x0053, 0x0065, 0x006c+      , 0x0064, 0x006f, 0x006e, 0x0020, 0x0061, 0x0067, 0x0072, 0x0065+      , 0x0065, 0x0073, 0x0020, 0x0074, 0x006f, 0x0020, 0x0073, 0x0065+      , 0x0074, 0x0020, 0x0075, 0x0070, 0x0020, 0x0068, 0x0069, 0x0073+      , 0x0020, 0x006f, 0x0077, 0x006e, 0x0020, 0x0063, 0x006f, 0x006c+      , 0x006c, 0x0065, 0x0063, 0x0074, 0x0069, 0x006f, 0x006e, 0x0020+      , 0x006f, 0x0066, 0x0020, 0x0045, 0x006e, 0x0063, 0x0079, 0x0063+      , 0x006c, 0x006f, 0x0070, 0x0065, 0x0064, 0x0069, 0x0073, 0x0074+      , 0x0073, 0x002c, 0x000a, 0x0061, 0x006e, 0x0064, 0x0020, 0x0061+      , 0x006c, 0x0073, 0x006f, 0x0020, 0x0073, 0x0065, 0x0063, 0x0072+      , 0x0065, 0x0074, 0x006c, 0x0079, 0x0020, 0x0069, 0x006d, 0x0070+      , 0x006c, 0x0065, 0x006d, 0x0065, 0x006e, 0x0074, 0x0073, 0x0020+      , 0x0061, 0x0020, 0x0063, 0x006f, 0x006e, 0x0074, 0x0069, 0x006e+      , 0x0067, 0x0065, 0x006e, 0x0063, 0x0079, 0x0020, 0x0070, 0x006c+      , 0x0061, 0x006e, 0x002d, 0x0061, 0x0020, 0x0073, 0x0065, 0x0063+      , 0x006f, 0x006e, 0x0064, 0x0020, 0x0046, 0x006f, 0x0075, 0x006e+      , 0x0064, 0x0061, 0x0074, 0x0069, 0x006f, 0x006e, 0x002d, 0x0061+      , 0x0074, 0x0020, 0x0074, 0x0068, 0x0065, 0x000a, 0x0022, 0x006f+      , 0x0070, 0x0070, 0x006f, 0x0073, 0x0069, 0x0074, 0x0065, 0x0020+      , 0x0065, 0x006e, 0x0064, 0x0022, 0x0020, 0x006f, 0x0066, 0x0020+      , 0x0074, 0x0068, 0x0065, 0x0020, 0x0067, 0x0061, 0x006c, 0x0061+      , 0x0078, 0x0079, 0x002e, 0x000a+      ]++sample0_ISO_8859_1 :: EncodedString+sample0_ISO_8859_1 = EncodedString ISO_8859_1 $ fromList+  [ 0x43, 0x61, 0x6c, 0x6c, 0x65, 0x64, 0x20, 0x66, 0x6f, 0x72, 0x74, 0x68, 0x20, 0x74, 0x6f, 0x20+  , 0x73, 0x74, 0x61, 0x6e, 0x64, 0x20, 0x74, 0x72, 0x69, 0x61, 0x6c, 0x20, 0x6f, 0x6e, 0x20, 0x54+  , 0x72, 0x61, 0x6e, 0x74, 0x6f, 0x72, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x61, 0x6c, 0x6c, 0x65, 0x67+  , 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x72, 0x65, 0x61, 0x73, 0x6f+  , 0x6e, 0x20, 0x28, 0x66, 0x6f, 0x72, 0x0a, 0x66, 0x6f, 0x72, 0x65, 0x73, 0x68, 0x61, 0x64, 0x6f+  , 0x77, 0x69, 0x6e, 0x67, 0x20, 0x74, 0x68, 0x65, 0x20, 0x64, 0x65, 0x63, 0x6c, 0x69, 0x6e, 0x65+  , 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x47, 0x61, 0x6c, 0x61, 0x63, 0x74, 0x69, 0x63+  , 0x20, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x29, 0x2c, 0x20, 0x53, 0x65, 0x6c, 0x64, 0x6f, 0x6e+  , 0x20, 0x65, 0x78, 0x70, 0x6c, 0x61, 0x69, 0x6e, 0x73, 0x20, 0x74, 0x68, 0x61, 0x74, 0x20, 0x68+  , 0x69, 0x73, 0x0a, 0x73, 0x63, 0x69, 0x65, 0x6e, 0x63, 0x65, 0x20, 0x6f, 0x66, 0x20, 0x70, 0x73+  , 0x79, 0x63, 0x68, 0x6f, 0x68, 0x69, 0x73, 0x74, 0x6f, 0x72, 0x79, 0x20, 0x66, 0x6f, 0x72, 0x65+  , 0x73, 0x65, 0x65, 0x73, 0x20, 0x6d, 0x61, 0x6e, 0x79, 0x20, 0x61, 0x6c, 0x74, 0x65, 0x72, 0x6e+  , 0x61, 0x74, 0x69, 0x76, 0x65, 0x73, 0x2c, 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x6f, 0x66, 0x20, 0x77+  , 0x68, 0x69, 0x63, 0x68, 0x20, 0x72, 0x65, 0x73, 0x75, 0x6c, 0x74, 0x20, 0x69, 0x6e, 0x20, 0x74+  , 0x68, 0x65, 0x0a, 0x47, 0x61, 0x6c, 0x61, 0x63, 0x74, 0x69, 0x63, 0x20, 0x45, 0x6d, 0x70, 0x69+  , 0x72, 0x65, 0x20, 0x65, 0x76, 0x65, 0x6e, 0x74, 0x75, 0x61, 0x6c, 0x6c, 0x79, 0x20, 0x66, 0x61+  , 0x6c, 0x6c, 0x69, 0x6e, 0x67, 0x2e, 0x20, 0x49, 0x66, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x6e, 0x69+  , 0x74, 0x79, 0x20, 0x66, 0x6f, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x69, 0x74, 0x73, 0x20, 0x63+  , 0x75, 0x72, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x70, 0x61, 0x74, 0x68, 0x2c, 0x20, 0x74, 0x68, 0x65+  , 0x0a, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x20, 0x77, 0x69, 0x6c, 0x6c, 0x20, 0x66, 0x61, 0x6c+  , 0x6c, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x33, 0x30, 0x2c, 0x30, 0x30, 0x30, 0x20, 0x79, 0x65, 0x61+  , 0x72, 0x73, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x75, 0x72, 0x6d, 0x6f, 0x69, 0x6c, 0x20, 0x77, 0x69+  , 0x6c, 0x6c, 0x20, 0x6f, 0x76, 0x65, 0x72, 0x63, 0x6f, 0x6d, 0x65, 0x20, 0x68, 0x75, 0x6d, 0x61+  , 0x6e, 0x69, 0x74, 0x79, 0x20, 0x62, 0x65, 0x66, 0x6f, 0x72, 0x65, 0x20, 0x61, 0x0a, 0x73, 0x65+  , 0x63, 0x6f, 0x6e, 0x64, 0x20, 0x45, 0x6d, 0x70, 0x69, 0x72, 0x65, 0x20, 0x61, 0x72, 0x69, 0x73+  , 0x65, 0x73, 0x2e, 0x20, 0x48, 0x6f, 0x77, 0x65, 0x76, 0x65, 0x72, 0x2c, 0x20, 0x61, 0x6e, 0x20+  , 0x61, 0x6c, 0x74, 0x65, 0x72, 0x6e, 0x61, 0x74, 0x69, 0x76, 0x65, 0x20, 0x70, 0x61, 0x74, 0x68+  , 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x66, 0x6f, 0x72, 0x20, 0x74, 0x68, 0x65, 0x20+  , 0x69, 0x6e, 0x74, 0x65, 0x72, 0x76, 0x65, 0x6e, 0x69, 0x6e, 0x67, 0x0a, 0x79, 0x65, 0x61, 0x72+  , 0x73, 0x20, 0x74, 0x6f, 0x20, 0x62, 0x65, 0x20, 0x6f, 0x6e, 0x6c, 0x79, 0x20, 0x6f, 0x6e, 0x65+  , 0x20, 0x74, 0x68, 0x6f, 0x75, 0x73, 0x61, 0x6e, 0x64, 0x2c, 0x20, 0x69, 0x66, 0x20, 0x53, 0x65+  , 0x6c, 0x64, 0x6f, 0x6e, 0x20, 0x69, 0x73, 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x65, 0x64, 0x20+  , 0x74, 0x6f, 0x20, 0x63, 0x6f, 0x6c, 0x6c, 0x65, 0x63, 0x74, 0x20, 0x74, 0x68, 0x65, 0x20, 0x6d+  , 0x6f, 0x73, 0x74, 0x0a, 0x69, 0x6e, 0x74, 0x65, 0x6c, 0x6c, 0x69, 0x67, 0x65, 0x6e, 0x74, 0x20+  , 0x6d, 0x69, 0x6e, 0x64, 0x73, 0x20, 0x61, 0x6e, 0x64, 0x20, 0x63, 0x72, 0x65, 0x61, 0x74, 0x65+  , 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6d, 0x70, 0x65, 0x6e, 0x64, 0x69, 0x75, 0x6d, 0x20, 0x6f, 0x66+  , 0x20, 0x61, 0x6c, 0x6c, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x6e, 0x20, 0x6b, 0x6e, 0x6f, 0x77, 0x6c+  , 0x65, 0x64, 0x67, 0x65, 0x2c, 0x20, 0x65, 0x6e, 0x74, 0x69, 0x74, 0x6c, 0x65, 0x64, 0x0a, 0x45+  , 0x6e, 0x63, 0x79, 0x63, 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69, 0x61, 0x20, 0x47, 0x61, 0x6c, 0x61+  , 0x63, 0x74, 0x69, 0x63, 0x61, 0x2e, 0x20, 0x54, 0x68, 0x65, 0x20, 0x62, 0x6f, 0x61, 0x72, 0x64+  , 0x20, 0x69, 0x73, 0x20, 0x73, 0x74, 0x69, 0x6c, 0x6c, 0x20, 0x77, 0x61, 0x72, 0x79, 0x20, 0x62+  , 0x75, 0x74, 0x20, 0x61, 0x6c, 0x6c, 0x6f, 0x77, 0x73, 0x20, 0x53, 0x65, 0x6c, 0x64, 0x6f, 0x6e+  , 0x20, 0x74, 0x6f, 0x20, 0x61, 0x73, 0x73, 0x65, 0x6d, 0x62, 0x6c, 0x65, 0x0a, 0x77, 0x68, 0x6f+  , 0x6d, 0x65, 0x76, 0x65, 0x72, 0x20, 0x68, 0x65, 0x20, 0x6e, 0x65, 0x65, 0x64, 0x73, 0x2c, 0x20+  , 0x70, 0x72, 0x6f, 0x76, 0x69, 0x64, 0x65, 0x64, 0x20, 0x68, 0x65, 0x20, 0x61, 0x6e, 0x64, 0x20+  , 0x74, 0x68, 0x65, 0x20, 0x22, 0x45, 0x6e, 0x63, 0x79, 0x63, 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69+  , 0x73, 0x74, 0x73, 0x22, 0x20, 0x62, 0x65, 0x20, 0x65, 0x78, 0x69, 0x6c, 0x65, 0x64, 0x20, 0x74+  , 0x6f, 0x20, 0x61, 0x20, 0x72, 0x65, 0x6d, 0x6f, 0x74, 0x65, 0x0a, 0x70, 0x6c, 0x61, 0x6e, 0x65+  , 0x74, 0x2c, 0x20, 0x54, 0x65, 0x72, 0x6d, 0x69, 0x6e, 0x75, 0x73, 0x2e, 0x20, 0x53, 0x65, 0x6c+  , 0x64, 0x6f, 0x6e, 0x20, 0x61, 0x67, 0x72, 0x65, 0x65, 0x73, 0x20, 0x74, 0x6f, 0x20, 0x73, 0x65+  , 0x74, 0x20, 0x75, 0x70, 0x20, 0x68, 0x69, 0x73, 0x20, 0x6f, 0x77, 0x6e, 0x20, 0x63, 0x6f, 0x6c+  , 0x6c, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6f, 0x66, 0x20, 0x45, 0x6e, 0x63, 0x79, 0x63+  , 0x6c, 0x6f, 0x70, 0x65, 0x64, 0x69, 0x73, 0x74, 0x73, 0x2c, 0x0a, 0x61, 0x6e, 0x64, 0x20, 0x61+  , 0x6c, 0x73, 0x6f, 0x20, 0x73, 0x65, 0x63, 0x72, 0x65, 0x74, 0x6c, 0x79, 0x20, 0x69, 0x6d, 0x70+  , 0x6c, 0x65, 0x6d, 0x65, 0x6e, 0x74, 0x73, 0x20, 0x61, 0x20, 0x63, 0x6f, 0x6e, 0x74, 0x69, 0x6e+  , 0x67, 0x65, 0x6e, 0x63, 0x79, 0x20, 0x70, 0x6c, 0x61, 0x6e, 0x2d, 0x61, 0x20, 0x73, 0x65, 0x63+  , 0x6f, 0x6e, 0x64, 0x20, 0x46, 0x6f, 0x75, 0x6e, 0x64, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x2d, 0x61+  , 0x74, 0x20, 0x74, 0x68, 0x65, 0x0a, 0x22, 0x6f, 0x70, 0x70, 0x6f, 0x73, 0x69, 0x74, 0x65, 0x20+  , 0x65, 0x6e, 0x64, 0x22, 0x20, 0x6f, 0x66, 0x20, 0x74, 0x68, 0x65, 0x20, 0x67, 0x61, 0x6c, 0x61+  , 0x78, 0x79, 0x2e, 0x0a+  ]++-- -------------------------- Sample 1 ------------------------------------- --++sample1 :: ([EncodedString], String)+sample1 = ( [sample1_UTF8, sample1_UTF16, sample1_ISO_8859_1]+          , sample1_String+          )++sample1_String :: String+sample1_String =+    "In French:\n\+    \\n\+    \1. un robot ne peut porter atteinte à un être humain, ni, en restant passif, permettre qu'un être humain soit exposé au danger ;\n\+    \2. un robot doit obéir aux ordres qui lui sont donnés par un être humain, sauf si de tels ordres entrent en conflit avec la première loi ;\n\+    \3. un robot doit protéger son existence tant que cette protection n'entre pas en conflit avec la première ou la deuxième loi.\n\+    \\n\+    \In Danish:\n\+    \\n\+    \1. En robot må ikke gøre et menneske fortræd, eller, ved ikke at gøre noget, lade et menneske komme til skade\n\+    \2. En robot skal adlyde ordrer givet af mennesker, så længe disse ikke er i konflikt med første lov\n\+    \3. En robot skal beskytte sin egen eksistens, så længe dette ikke er i konflikt med første eller anden lov\n"++sample1_UTF8 :: EncodedString+sample1_UTF8 = EncodedString UTF8 $ fromList+  [ 0x49, 0x6e, 0x20, 0x46, 0x72, 0x65, 0x6e, 0x63, 0x68, 0x3a, 0x0a, 0x0a, 0x31, 0x2e, 0x20, 0x75+  , 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x6e, 0x65, 0x20, 0x70, 0x65, 0x75, 0x74, 0x20+  , 0x70, 0x6f, 0x72, 0x74, 0x65, 0x72, 0x20, 0x61, 0x74, 0x74, 0x65, 0x69, 0x6e, 0x74, 0x65, 0x20+  , 0xc3, 0xa0, 0x20, 0x75, 0x6e, 0x20, 0xc3, 0xaa, 0x74, 0x72, 0x65, 0x20, 0x68, 0x75, 0x6d, 0x61+  , 0x69, 0x6e, 0x2c, 0x20, 0x6e, 0x69, 0x2c, 0x20, 0x65, 0x6e, 0x20, 0x72, 0x65, 0x73, 0x74, 0x61+  , 0x6e, 0x74, 0x20, 0x70, 0x61, 0x73, 0x73, 0x69, 0x66, 0x2c, 0x20, 0x70, 0x65, 0x72, 0x6d, 0x65+  , 0x74, 0x74, 0x72, 0x65, 0x20, 0x71, 0x75, 0x27, 0x75, 0x6e, 0x20, 0xc3, 0xaa, 0x74, 0x72, 0x65+  , 0x20, 0x68, 0x75, 0x6d, 0x61, 0x69, 0x6e, 0x20, 0x73, 0x6f, 0x69, 0x74, 0x20, 0x65, 0x78, 0x70+  , 0x6f, 0x73, 0xc3, 0xa9, 0x20, 0x61, 0x75, 0x20, 0x64, 0x61, 0x6e, 0x67, 0x65, 0x72, 0x20, 0x3b+  , 0x0a, 0x32, 0x2e, 0x20, 0x75, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x64, 0x6f, 0x69+  , 0x74, 0x20, 0x6f, 0x62, 0xc3, 0xa9, 0x69, 0x72, 0x20, 0x61, 0x75, 0x78, 0x20, 0x6f, 0x72, 0x64+  , 0x72, 0x65, 0x73, 0x20, 0x71, 0x75, 0x69, 0x20, 0x6c, 0x75, 0x69, 0x20, 0x73, 0x6f, 0x6e, 0x74+  , 0x20, 0x64, 0x6f, 0x6e, 0x6e, 0xc3, 0xa9, 0x73, 0x20, 0x70, 0x61, 0x72, 0x20, 0x75, 0x6e, 0x20+  , 0xc3, 0xaa, 0x74, 0x72, 0x65, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x69, 0x6e, 0x2c, 0x20, 0x73, 0x61+  , 0x75, 0x66, 0x20, 0x73, 0x69, 0x20, 0x64, 0x65, 0x20, 0x74, 0x65, 0x6c, 0x73, 0x20, 0x6f, 0x72+  , 0x64, 0x72, 0x65, 0x73, 0x20, 0x65, 0x6e, 0x74, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x65, 0x6e, 0x20+  , 0x63, 0x6f, 0x6e, 0x66, 0x6c, 0x69, 0x74, 0x20, 0x61, 0x76, 0x65, 0x63, 0x20, 0x6c, 0x61, 0x20+  , 0x70, 0x72, 0x65, 0x6d, 0x69, 0xc3, 0xa8, 0x72, 0x65, 0x20, 0x6c, 0x6f, 0x69, 0x20, 0x3b, 0x0a+  , 0x33, 0x2e, 0x20, 0x75, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x64, 0x6f, 0x69, 0x74+  , 0x20, 0x70, 0x72, 0x6f, 0x74, 0xc3, 0xa9, 0x67, 0x65, 0x72, 0x20, 0x73, 0x6f, 0x6e, 0x20, 0x65+  , 0x78, 0x69, 0x73, 0x74, 0x65, 0x6e, 0x63, 0x65, 0x20, 0x74, 0x61, 0x6e, 0x74, 0x20, 0x71, 0x75+  , 0x65, 0x20, 0x63, 0x65, 0x74, 0x74, 0x65, 0x20, 0x70, 0x72, 0x6f, 0x74, 0x65, 0x63, 0x74, 0x69+  , 0x6f, 0x6e, 0x20, 0x6e, 0x27, 0x65, 0x6e, 0x74, 0x72, 0x65, 0x20, 0x70, 0x61, 0x73, 0x20, 0x65+  , 0x6e, 0x20, 0x63, 0x6f, 0x6e, 0x66, 0x6c, 0x69, 0x74, 0x20, 0x61, 0x76, 0x65, 0x63, 0x20, 0x6c+  , 0x61, 0x20, 0x70, 0x72, 0x65, 0x6d, 0x69, 0xc3, 0xa8, 0x72, 0x65, 0x20, 0x6f, 0x75, 0x20, 0x6c+  , 0x61, 0x20, 0x64, 0x65, 0x75, 0x78, 0x69, 0xc3, 0xa8, 0x6d, 0x65, 0x20, 0x6c, 0x6f, 0x69, 0x2e+  , 0x0a, 0x0a, 0x49, 0x6e, 0x20, 0x44, 0x61, 0x6e, 0x69, 0x73, 0x68, 0x3a, 0x0a, 0x0a, 0x31, 0x2e+  , 0x20, 0x45, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x6d, 0xc3, 0xa5, 0x20, 0x69, 0x6b+  , 0x6b, 0x65, 0x20, 0x67, 0xc3, 0xb8, 0x72, 0x65, 0x20, 0x65, 0x74, 0x20, 0x6d, 0x65, 0x6e, 0x6e+  , 0x65, 0x73, 0x6b, 0x65, 0x20, 0x66, 0x6f, 0x72, 0x74, 0x72, 0xc3, 0xa6, 0x64, 0x2c, 0x20, 0x65+  , 0x6c, 0x6c, 0x65, 0x72, 0x2c, 0x20, 0x76, 0x65, 0x64, 0x20, 0x69, 0x6b, 0x6b, 0x65, 0x20, 0x61+  , 0x74, 0x20, 0x67, 0xc3, 0xb8, 0x72, 0x65, 0x20, 0x6e, 0x6f, 0x67, 0x65, 0x74, 0x2c, 0x20, 0x6c+  , 0x61, 0x64, 0x65, 0x20, 0x65, 0x74, 0x20, 0x6d, 0x65, 0x6e, 0x6e, 0x65, 0x73, 0x6b, 0x65, 0x20+  , 0x6b, 0x6f, 0x6d, 0x6d, 0x65, 0x20, 0x74, 0x69, 0x6c, 0x20, 0x73, 0x6b, 0x61, 0x64, 0x65, 0x0a+  , 0x32, 0x2e, 0x20, 0x45, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x73, 0x6b, 0x61, 0x6c+  , 0x20, 0x61, 0x64, 0x6c, 0x79, 0x64, 0x65, 0x20, 0x6f, 0x72, 0x64, 0x72, 0x65, 0x72, 0x20, 0x67+  , 0x69, 0x76, 0x65, 0x74, 0x20, 0x61, 0x66, 0x20, 0x6d, 0x65, 0x6e, 0x6e, 0x65, 0x73, 0x6b, 0x65+  , 0x72, 0x2c, 0x20, 0x73, 0xc3, 0xa5, 0x20, 0x6c, 0xc3, 0xa6, 0x6e, 0x67, 0x65, 0x20, 0x64, 0x69+  , 0x73, 0x73, 0x65, 0x20, 0x69, 0x6b, 0x6b, 0x65, 0x20, 0x65, 0x72, 0x20, 0x69, 0x20, 0x6b, 0x6f+  , 0x6e, 0x66, 0x6c, 0x69, 0x6b, 0x74, 0x20, 0x6d, 0x65, 0x64, 0x20, 0x66, 0xc3, 0xb8, 0x72, 0x73+  , 0x74, 0x65, 0x20, 0x6c, 0x6f, 0x76, 0x0a, 0x33, 0x2e, 0x20, 0x45, 0x6e, 0x20, 0x72, 0x6f, 0x62+  , 0x6f, 0x74, 0x20, 0x73, 0x6b, 0x61, 0x6c, 0x20, 0x62, 0x65, 0x73, 0x6b, 0x79, 0x74, 0x74, 0x65+  , 0x20, 0x73, 0x69, 0x6e, 0x20, 0x65, 0x67, 0x65, 0x6e, 0x20, 0x65, 0x6b, 0x73, 0x69, 0x73, 0x74+  , 0x65, 0x6e, 0x73, 0x2c, 0x20, 0x73, 0xc3, 0xa5, 0x20, 0x6c, 0xc3, 0xa6, 0x6e, 0x67, 0x65, 0x20+  , 0x64, 0x65, 0x74, 0x74, 0x65, 0x20, 0x69, 0x6b, 0x6b, 0x65, 0x20, 0x65, 0x72, 0x20, 0x69, 0x20+  , 0x6b, 0x6f, 0x6e, 0x66, 0x6c, 0x69, 0x6b, 0x74, 0x20, 0x6d, 0x65, 0x64, 0x20, 0x66, 0xc3, 0xb8+  , 0x72, 0x73, 0x74, 0x65, 0x20, 0x65, 0x6c, 0x6c, 0x65, 0x72, 0x20, 0x61, 0x6e, 0x64, 0x65, 0x6e+  , 0x20, 0x6c, 0x6f, 0x76, 0x0a+  ]++sample1_UTF16 :: EncodedString+sample1_UTF16 = EncodedString UTF16 $ recast array+  where+    array :: UArray Word16+    array = fromList+        [ 0x0049, 0x006e, 0x0020, 0x0046, 0x0072, 0x0065, 0x006e, 0x0063+        , 0x0068, 0x003a, 0x000a, 0x000a, 0x0031, 0x002e, 0x0020, 0x0075+        , 0x006e, 0x0020, 0x0072, 0x006f, 0x0062, 0x006f, 0x0074, 0x0020+        , 0x006e, 0x0065, 0x0020, 0x0070, 0x0065, 0x0075, 0x0074, 0x0020+        , 0x0070, 0x006f, 0x0072, 0x0074, 0x0065, 0x0072, 0x0020, 0x0061+        , 0x0074, 0x0074, 0x0065, 0x0069, 0x006e, 0x0074, 0x0065, 0x0020+        , 0x00e0, 0x0020, 0x0075, 0x006e, 0x0020, 0x00ea, 0x0074, 0x0072+        , 0x0065, 0x0020, 0x0068, 0x0075, 0x006d, 0x0061, 0x0069, 0x006e+        , 0x002c, 0x0020, 0x006e, 0x0069, 0x002c, 0x0020, 0x0065, 0x006e+        , 0x0020, 0x0072, 0x0065, 0x0073, 0x0074, 0x0061, 0x006e, 0x0074+        , 0x0020, 0x0070, 0x0061, 0x0073, 0x0073, 0x0069, 0x0066, 0x002c+        , 0x0020, 0x0070, 0x0065, 0x0072, 0x006d, 0x0065, 0x0074, 0x0074+        , 0x0072, 0x0065, 0x0020, 0x0071, 0x0075, 0x0027, 0x0075, 0x006e+        , 0x0020, 0x00ea, 0x0074, 0x0072, 0x0065, 0x0020, 0x0068, 0x0075+        , 0x006d, 0x0061, 0x0069, 0x006e, 0x0020, 0x0073, 0x006f, 0x0069+        , 0x0074, 0x0020, 0x0065, 0x0078, 0x0070, 0x006f, 0x0073, 0x00e9+        , 0x0020, 0x0061, 0x0075, 0x0020, 0x0064, 0x0061, 0x006e, 0x0067+        , 0x0065, 0x0072, 0x0020, 0x003b, 0x000a, 0x0032, 0x002e, 0x0020+        , 0x0075, 0x006e, 0x0020, 0x0072, 0x006f, 0x0062, 0x006f, 0x0074+        , 0x0020, 0x0064, 0x006f, 0x0069, 0x0074, 0x0020, 0x006f, 0x0062+        , 0x00e9, 0x0069, 0x0072, 0x0020, 0x0061, 0x0075, 0x0078, 0x0020+        , 0x006f, 0x0072, 0x0064, 0x0072, 0x0065, 0x0073, 0x0020, 0x0071+        , 0x0075, 0x0069, 0x0020, 0x006c, 0x0075, 0x0069, 0x0020, 0x0073+        , 0x006f, 0x006e, 0x0074, 0x0020, 0x0064, 0x006f, 0x006e, 0x006e+        , 0x00e9, 0x0073, 0x0020, 0x0070, 0x0061, 0x0072, 0x0020, 0x0075+        , 0x006e, 0x0020, 0x00ea, 0x0074, 0x0072, 0x0065, 0x0020, 0x0068+        , 0x0075, 0x006d, 0x0061, 0x0069, 0x006e, 0x002c, 0x0020, 0x0073+        , 0x0061, 0x0075, 0x0066, 0x0020, 0x0073, 0x0069, 0x0020, 0x0064+        , 0x0065, 0x0020, 0x0074, 0x0065, 0x006c, 0x0073, 0x0020, 0x006f+        , 0x0072, 0x0064, 0x0072, 0x0065, 0x0073, 0x0020, 0x0065, 0x006e+        , 0x0074, 0x0072, 0x0065, 0x006e, 0x0074, 0x0020, 0x0065, 0x006e+        , 0x0020, 0x0063, 0x006f, 0x006e, 0x0066, 0x006c, 0x0069, 0x0074+        , 0x0020, 0x0061, 0x0076, 0x0065, 0x0063, 0x0020, 0x006c, 0x0061+        , 0x0020, 0x0070, 0x0072, 0x0065, 0x006d, 0x0069, 0x00e8, 0x0072+        , 0x0065, 0x0020, 0x006c, 0x006f, 0x0069, 0x0020, 0x003b, 0x000a+        , 0x0033, 0x002e, 0x0020, 0x0075, 0x006e, 0x0020, 0x0072, 0x006f+        , 0x0062, 0x006f, 0x0074, 0x0020, 0x0064, 0x006f, 0x0069, 0x0074+        , 0x0020, 0x0070, 0x0072, 0x006f, 0x0074, 0x00e9, 0x0067, 0x0065+        , 0x0072, 0x0020, 0x0073, 0x006f, 0x006e, 0x0020, 0x0065, 0x0078+        , 0x0069, 0x0073, 0x0074, 0x0065, 0x006e, 0x0063, 0x0065, 0x0020+        , 0x0074, 0x0061, 0x006e, 0x0074, 0x0020, 0x0071, 0x0075, 0x0065+        , 0x0020, 0x0063, 0x0065, 0x0074, 0x0074, 0x0065, 0x0020, 0x0070+        , 0x0072, 0x006f, 0x0074, 0x0065, 0x0063, 0x0074, 0x0069, 0x006f+        , 0x006e, 0x0020, 0x006e, 0x0027, 0x0065, 0x006e, 0x0074, 0x0072+        , 0x0065, 0x0020, 0x0070, 0x0061, 0x0073, 0x0020, 0x0065, 0x006e+        , 0x0020, 0x0063, 0x006f, 0x006e, 0x0066, 0x006c, 0x0069, 0x0074+        , 0x0020, 0x0061, 0x0076, 0x0065, 0x0063, 0x0020, 0x006c, 0x0061+        , 0x0020, 0x0070, 0x0072, 0x0065, 0x006d, 0x0069, 0x00e8, 0x0072+        , 0x0065, 0x0020, 0x006f, 0x0075, 0x0020, 0x006c, 0x0061, 0x0020+        , 0x0064, 0x0065, 0x0075, 0x0078, 0x0069, 0x00e8, 0x006d, 0x0065+        , 0x0020, 0x006c, 0x006f, 0x0069, 0x002e, 0x000a, 0x000a, 0x0049+        , 0x006e, 0x0020, 0x0044, 0x0061, 0x006e, 0x0069, 0x0073, 0x0068+        , 0x003a, 0x000a, 0x000a, 0x0031, 0x002e, 0x0020, 0x0045, 0x006e+        , 0x0020, 0x0072, 0x006f, 0x0062, 0x006f, 0x0074, 0x0020, 0x006d+        , 0x00e5, 0x0020, 0x0069, 0x006b, 0x006b, 0x0065, 0x0020, 0x0067+        , 0x00f8, 0x0072, 0x0065, 0x0020, 0x0065, 0x0074, 0x0020, 0x006d+        , 0x0065, 0x006e, 0x006e, 0x0065, 0x0073, 0x006b, 0x0065, 0x0020+        , 0x0066, 0x006f, 0x0072, 0x0074, 0x0072, 0x00e6, 0x0064, 0x002c+        , 0x0020, 0x0065, 0x006c, 0x006c, 0x0065, 0x0072, 0x002c, 0x0020+        , 0x0076, 0x0065, 0x0064, 0x0020, 0x0069, 0x006b, 0x006b, 0x0065+        , 0x0020, 0x0061, 0x0074, 0x0020, 0x0067, 0x00f8, 0x0072, 0x0065+        , 0x0020, 0x006e, 0x006f, 0x0067, 0x0065, 0x0074, 0x002c, 0x0020+        , 0x006c, 0x0061, 0x0064, 0x0065, 0x0020, 0x0065, 0x0074, 0x0020+        , 0x006d, 0x0065, 0x006e, 0x006e, 0x0065, 0x0073, 0x006b, 0x0065+        , 0x0020, 0x006b, 0x006f, 0x006d, 0x006d, 0x0065, 0x0020, 0x0074+        , 0x0069, 0x006c, 0x0020, 0x0073, 0x006b, 0x0061, 0x0064, 0x0065+        , 0x000a, 0x0032, 0x002e, 0x0020, 0x0045, 0x006e, 0x0020, 0x0072+        , 0x006f, 0x0062, 0x006f, 0x0074, 0x0020, 0x0073, 0x006b, 0x0061+        , 0x006c, 0x0020, 0x0061, 0x0064, 0x006c, 0x0079, 0x0064, 0x0065+        , 0x0020, 0x006f, 0x0072, 0x0064, 0x0072, 0x0065, 0x0072, 0x0020+        , 0x0067, 0x0069, 0x0076, 0x0065, 0x0074, 0x0020, 0x0061, 0x0066+        , 0x0020, 0x006d, 0x0065, 0x006e, 0x006e, 0x0065, 0x0073, 0x006b+        , 0x0065, 0x0072, 0x002c, 0x0020, 0x0073, 0x00e5, 0x0020, 0x006c+        , 0x00e6, 0x006e, 0x0067, 0x0065, 0x0020, 0x0064, 0x0069, 0x0073+        , 0x0073, 0x0065, 0x0020, 0x0069, 0x006b, 0x006b, 0x0065, 0x0020+        , 0x0065, 0x0072, 0x0020, 0x0069, 0x0020, 0x006b, 0x006f, 0x006e+        , 0x0066, 0x006c, 0x0069, 0x006b, 0x0074, 0x0020, 0x006d, 0x0065+        , 0x0064, 0x0020, 0x0066, 0x00f8, 0x0072, 0x0073, 0x0074, 0x0065+        , 0x0020, 0x006c, 0x006f, 0x0076, 0x000a, 0x0033, 0x002e, 0x0020+        , 0x0045, 0x006e, 0x0020, 0x0072, 0x006f, 0x0062, 0x006f, 0x0074+        , 0x0020, 0x0073, 0x006b, 0x0061, 0x006c, 0x0020, 0x0062, 0x0065+        , 0x0073, 0x006b, 0x0079, 0x0074, 0x0074, 0x0065, 0x0020, 0x0073+        , 0x0069, 0x006e, 0x0020, 0x0065, 0x0067, 0x0065, 0x006e, 0x0020+        , 0x0065, 0x006b, 0x0073, 0x0069, 0x0073, 0x0074, 0x0065, 0x006e+        , 0x0073, 0x002c, 0x0020, 0x0073, 0x00e5, 0x0020, 0x006c, 0x00e6+        , 0x006e, 0x0067, 0x0065, 0x0020, 0x0064, 0x0065, 0x0074, 0x0074+        , 0x0065, 0x0020, 0x0069, 0x006b, 0x006b, 0x0065, 0x0020, 0x0065+        , 0x0072, 0x0020, 0x0069, 0x0020, 0x006b, 0x006f, 0x006e, 0x0066+        , 0x006c, 0x0069, 0x006b, 0x0074, 0x0020, 0x006d, 0x0065, 0x0064+        , 0x0020, 0x0066, 0x00f8, 0x0072, 0x0073, 0x0074, 0x0065, 0x0020+        , 0x0065, 0x006c, 0x006c, 0x0065, 0x0072, 0x0020, 0x0061, 0x006e+        , 0x0064, 0x0065, 0x006e, 0x0020, 0x006c, 0x006f, 0x0076, 0x000a+        ]++sample1_ISO_8859_1 :: EncodedString+sample1_ISO_8859_1 = EncodedString ISO_8859_1 $ fromList+  [ 0x49, 0x6e, 0x20, 0x46, 0x72, 0x65, 0x6e, 0x63, 0x68, 0x3a, 0x0a, 0x0a, 0x31, 0x2e, 0x20, 0x75+  , 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x6e, 0x65, 0x20, 0x70, 0x65, 0x75, 0x74, 0x20+  , 0x70, 0x6f, 0x72, 0x74, 0x65, 0x72, 0x20, 0x61, 0x74, 0x74, 0x65, 0x69, 0x6e, 0x74, 0x65, 0x20+  , 0xe0, 0x20, 0x75, 0x6e, 0x20, 0xea, 0x74, 0x72, 0x65, 0x20, 0x68, 0x75, 0x6d, 0x61, 0x69, 0x6e+  , 0x2c, 0x20, 0x6e, 0x69, 0x2c, 0x20, 0x65, 0x6e, 0x20, 0x72, 0x65, 0x73, 0x74, 0x61, 0x6e, 0x74+  , 0x20, 0x70, 0x61, 0x73, 0x73, 0x69, 0x66, 0x2c, 0x20, 0x70, 0x65, 0x72, 0x6d, 0x65, 0x74, 0x74+  , 0x72, 0x65, 0x20, 0x71, 0x75, 0x27, 0x75, 0x6e, 0x20, 0xea, 0x74, 0x72, 0x65, 0x20, 0x68, 0x75+  , 0x6d, 0x61, 0x69, 0x6e, 0x20, 0x73, 0x6f, 0x69, 0x74, 0x20, 0x65, 0x78, 0x70, 0x6f, 0x73, 0xe9+  , 0x20, 0x61, 0x75, 0x20, 0x64, 0x61, 0x6e, 0x67, 0x65, 0x72, 0x20, 0x3b, 0x0a, 0x32, 0x2e, 0x20+  , 0x75, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x64, 0x6f, 0x69, 0x74, 0x20, 0x6f, 0x62+  , 0xe9, 0x69, 0x72, 0x20, 0x61, 0x75, 0x78, 0x20, 0x6f, 0x72, 0x64, 0x72, 0x65, 0x73, 0x20, 0x71+  , 0x75, 0x69, 0x20, 0x6c, 0x75, 0x69, 0x20, 0x73, 0x6f, 0x6e, 0x74, 0x20, 0x64, 0x6f, 0x6e, 0x6e+  , 0xe9, 0x73, 0x20, 0x70, 0x61, 0x72, 0x20, 0x75, 0x6e, 0x20, 0xea, 0x74, 0x72, 0x65, 0x20, 0x68+  , 0x75, 0x6d, 0x61, 0x69, 0x6e, 0x2c, 0x20, 0x73, 0x61, 0x75, 0x66, 0x20, 0x73, 0x69, 0x20, 0x64+  , 0x65, 0x20, 0x74, 0x65, 0x6c, 0x73, 0x20, 0x6f, 0x72, 0x64, 0x72, 0x65, 0x73, 0x20, 0x65, 0x6e+  , 0x74, 0x72, 0x65, 0x6e, 0x74, 0x20, 0x65, 0x6e, 0x20, 0x63, 0x6f, 0x6e, 0x66, 0x6c, 0x69, 0x74+  , 0x20, 0x61, 0x76, 0x65, 0x63, 0x20, 0x6c, 0x61, 0x20, 0x70, 0x72, 0x65, 0x6d, 0x69, 0xe8, 0x72+  , 0x65, 0x20, 0x6c, 0x6f, 0x69, 0x20, 0x3b, 0x0a, 0x33, 0x2e, 0x20, 0x75, 0x6e, 0x20, 0x72, 0x6f+  , 0x62, 0x6f, 0x74, 0x20, 0x64, 0x6f, 0x69, 0x74, 0x20, 0x70, 0x72, 0x6f, 0x74, 0xe9, 0x67, 0x65+  , 0x72, 0x20, 0x73, 0x6f, 0x6e, 0x20, 0x65, 0x78, 0x69, 0x73, 0x74, 0x65, 0x6e, 0x63, 0x65, 0x20+  , 0x74, 0x61, 0x6e, 0x74, 0x20, 0x71, 0x75, 0x65, 0x20, 0x63, 0x65, 0x74, 0x74, 0x65, 0x20, 0x70+  , 0x72, 0x6f, 0x74, 0x65, 0x63, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x6e, 0x27, 0x65, 0x6e, 0x74, 0x72+  , 0x65, 0x20, 0x70, 0x61, 0x73, 0x20, 0x65, 0x6e, 0x20, 0x63, 0x6f, 0x6e, 0x66, 0x6c, 0x69, 0x74+  , 0x20, 0x61, 0x76, 0x65, 0x63, 0x20, 0x6c, 0x61, 0x20, 0x70, 0x72, 0x65, 0x6d, 0x69, 0xe8, 0x72+  , 0x65, 0x20, 0x6f, 0x75, 0x20, 0x6c, 0x61, 0x20, 0x64, 0x65, 0x75, 0x78, 0x69, 0xe8, 0x6d, 0x65+  , 0x20, 0x6c, 0x6f, 0x69, 0x2e, 0x0a, 0x0a, 0x49, 0x6e, 0x20, 0x44, 0x61, 0x6e, 0x69, 0x73, 0x68+  , 0x3a, 0x0a, 0x0a, 0x31, 0x2e, 0x20, 0x45, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x6d+  , 0xe5, 0x20, 0x69, 0x6b, 0x6b, 0x65, 0x20, 0x67, 0xf8, 0x72, 0x65, 0x20, 0x65, 0x74, 0x20, 0x6d+  , 0x65, 0x6e, 0x6e, 0x65, 0x73, 0x6b, 0x65, 0x20, 0x66, 0x6f, 0x72, 0x74, 0x72, 0xe6, 0x64, 0x2c+  , 0x20, 0x65, 0x6c, 0x6c, 0x65, 0x72, 0x2c, 0x20, 0x76, 0x65, 0x64, 0x20, 0x69, 0x6b, 0x6b, 0x65+  , 0x20, 0x61, 0x74, 0x20, 0x67, 0xf8, 0x72, 0x65, 0x20, 0x6e, 0x6f, 0x67, 0x65, 0x74, 0x2c, 0x20+  , 0x6c, 0x61, 0x64, 0x65, 0x20, 0x65, 0x74, 0x20, 0x6d, 0x65, 0x6e, 0x6e, 0x65, 0x73, 0x6b, 0x65+  , 0x20, 0x6b, 0x6f, 0x6d, 0x6d, 0x65, 0x20, 0x74, 0x69, 0x6c, 0x20, 0x73, 0x6b, 0x61, 0x64, 0x65+  , 0x0a, 0x32, 0x2e, 0x20, 0x45, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74, 0x20, 0x73, 0x6b, 0x61+  , 0x6c, 0x20, 0x61, 0x64, 0x6c, 0x79, 0x64, 0x65, 0x20, 0x6f, 0x72, 0x64, 0x72, 0x65, 0x72, 0x20+  , 0x67, 0x69, 0x76, 0x65, 0x74, 0x20, 0x61, 0x66, 0x20, 0x6d, 0x65, 0x6e, 0x6e, 0x65, 0x73, 0x6b+  , 0x65, 0x72, 0x2c, 0x20, 0x73, 0xe5, 0x20, 0x6c, 0xe6, 0x6e, 0x67, 0x65, 0x20, 0x64, 0x69, 0x73+  , 0x73, 0x65, 0x20, 0x69, 0x6b, 0x6b, 0x65, 0x20, 0x65, 0x72, 0x20, 0x69, 0x20, 0x6b, 0x6f, 0x6e+  , 0x66, 0x6c, 0x69, 0x6b, 0x74, 0x20, 0x6d, 0x65, 0x64, 0x20, 0x66, 0xf8, 0x72, 0x73, 0x74, 0x65+  , 0x20, 0x6c, 0x6f, 0x76, 0x0a, 0x33, 0x2e, 0x20, 0x45, 0x6e, 0x20, 0x72, 0x6f, 0x62, 0x6f, 0x74+  , 0x20, 0x73, 0x6b, 0x61, 0x6c, 0x20, 0x62, 0x65, 0x73, 0x6b, 0x79, 0x74, 0x74, 0x65, 0x20, 0x73+  , 0x69, 0x6e, 0x20, 0x65, 0x67, 0x65, 0x6e, 0x20, 0x65, 0x6b, 0x73, 0x69, 0x73, 0x74, 0x65, 0x6e+  , 0x73, 0x2c, 0x20, 0x73, 0xe5, 0x20, 0x6c, 0xe6, 0x6e, 0x67, 0x65, 0x20, 0x64, 0x65, 0x74, 0x74+  , 0x65, 0x20, 0x69, 0x6b, 0x6b, 0x65, 0x20, 0x65, 0x72, 0x20, 0x69, 0x20, 0x6b, 0x6f, 0x6e, 0x66+  , 0x6c, 0x69, 0x6b, 0x74, 0x20, 0x6d, 0x65, 0x64, 0x20, 0x66, 0xf8, 0x72, 0x73, 0x74, 0x65, 0x20+  , 0x65, 0x6c, 0x6c, 0x65, 0x72, 0x20, 0x61, 0x6e, 0x64, 0x65, 0x6e, 0x20, 0x6c, 0x6f, 0x76, 0x0a+  ]++-- -------------------------- Sample 2 ------------------------------------- --++sample2 :: ([EncodedString], String)+sample2 = ( [sample2_UTF8, sample2_UTF16]+          , sample2_String+          )++sample2_String :: String+sample2_String =+    "The sample text below has been taken from Wikipedia:\n\+    \https://zh.wikipedia.org/wiki/%E5%9F%BA%E5%9C%B0%E7%B3%BB%E5%88%97\n\+    \\n\+    \基地系列（The Foundation Series）是一部經典科幻小說系列，創作時間橫跨美國作家以撒·艾西莫夫49個寫作年頭，一共10冊（包括別人續寫3冊），彼此間劇情獨立，卻又緊密關聯。「基地系列」通常也將處在同一架空宇宙的「機器人系列」和「銀河帝國系列」包括進來，總計起來整個「大基地系列」作品共有14冊長篇，和數不清的短篇小說，另外6冊由其他作家在他死後續寫。「基地系列」備受讚譽，1965年得過雨果獎「史上最佳科幻小說系列」。\n\+    \\n\+    \《基地》原本是一系列8篇的短篇小說，在1942年5月到1950年1月期間發表於《驚奇雜誌》（Astounding Magazine）。艾西莫夫在自傳中表示，《基地》是在他拜訪編輯約翰·坎貝爾（John W. Campbell）的路上，天馬行空聯想自愛德華·吉本的《羅馬帝國衰亡史》，之後與坎貝爾兩相討論下，整體概念遂而成形[1]。\n\+    \\n\+    \「基地系列」第一部《基地》包含4篇短篇小說，劇情各自獨立，單行本發行於1951年。其它4篇中篇小說兩兩相對，分別收錄在《基地與帝國》和《第二基地》，成為名聞遐邇的「基地三部曲」。1981年，「基地三部曲」早已是世所公認最重要的現代科幻作品，艾西莫夫終於被出版商說服續寫「基地系列」第四部《基地邊緣》[2]。接下來他又寫了一部續集《基地與地球》，5年後發表兩部前傳《基地前奏》和《基地締造者》，在這幾年中，艾西莫夫將「基地系列」與其它系列相結合，將所有系列作品同置於一個「基地宇宙」架構下。\n\+    \\n\+    \艾西莫夫和坎貝爾聯手為「基地系列」打造出一門全新的統計科學，稱之為“心理史學”，這門學問由書中数學家哈里·謝頓窮盡畢生之力創建，根據大規模的人類活動數據，預測未來走向，規模一旦小於一顆星球或是一座帝國，結果就會失準。謝頓運用此一科學，預見銀河帝國的殞落，整片銀河將因此進入長達三萬年的黑暗時期，直到第二帝國建立。\n\+    \\n\+    \於是謝頓建立兩座基地，藉以縮減蠻荒時期，一座遠在邊陲，是藝術與科學的避風港，相對的另一座則在“群星的盡頭”。「基地三部曲」的主要焦點就在端點星上的基地。端點星上的學者為了搶在衰退期之前，保存人類物理科學的知識，努力編輯著一部全方位的《银河百科全书》，對謝頓真正的意圖毫不知情（如果他們知道，就會產生無法控制的變數）。基地的位置也是刻意選定的，千年後就是第二帝國的首都（並非三萬年後的那個帝國）\n"++sample2_UTF8 :: EncodedString+sample2_UTF8 = EncodedString UTF8 $ fromList+    [ 0x54, 0x68, 0x65, 0x20, 0x73, 0x61, 0x6d, 0x70, 0x6c, 0x65, 0x20, 0x74, 0x65, 0x78, 0x74, 0x20+    , 0x62, 0x65, 0x6c, 0x6f, 0x77, 0x20, 0x68, 0x61, 0x73, 0x20, 0x62, 0x65, 0x65, 0x6e, 0x20, 0x74+    , 0x61, 0x6b, 0x65, 0x6e, 0x20, 0x66, 0x72, 0x6f, 0x6d, 0x20, 0x57, 0x69, 0x6b, 0x69, 0x70, 0x65+    , 0x64, 0x69, 0x61, 0x3a, 0x0a, 0x68, 0x74, 0x74, 0x70, 0x73, 0x3a, 0x2f, 0x2f, 0x7a, 0x68, 0x2e+    , 0x77, 0x69, 0x6b, 0x69, 0x70, 0x65, 0x64, 0x69, 0x61, 0x2e, 0x6f, 0x72, 0x67, 0x2f, 0x77, 0x69+    , 0x6b, 0x69, 0x2f, 0x25, 0x45, 0x35, 0x25, 0x39, 0x46, 0x25, 0x42, 0x41, 0x25, 0x45, 0x35, 0x25+    , 0x39, 0x43, 0x25, 0x42, 0x30, 0x25, 0x45, 0x37, 0x25, 0x42, 0x33, 0x25, 0x42, 0x42, 0x25, 0x45+    , 0x35, 0x25, 0x38, 0x38, 0x25, 0x39, 0x37, 0x0a, 0x0a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7+    , 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xef, 0xbc, 0x88, 0x54, 0x68, 0x65, 0x20, 0x46, 0x6f, 0x75, 0x6e+    , 0x64, 0x61, 0x74, 0x69, 0x6f, 0x6e, 0x20, 0x53, 0x65, 0x72, 0x69, 0x65, 0x73, 0xef, 0xbc, 0x89+    , 0xe6, 0x98, 0xaf, 0xe4, 0xb8, 0x80, 0xe9, 0x83, 0xa8, 0xe7, 0xb6, 0x93, 0xe5, 0x85, 0xb8, 0xe7+    , 0xa7, 0x91, 0xe5, 0xb9, 0xbb, 0xe5, 0xb0, 0x8f, 0xe8, 0xaa, 0xaa, 0xe7, 0xb3, 0xbb, 0xe5, 0x88+    , 0x97, 0xef, 0xbc, 0x8c, 0xe5, 0x89, 0xb5, 0xe4, 0xbd, 0x9c, 0xe6, 0x99, 0x82, 0xe9, 0x96, 0x93+    , 0xe6, 0xa9, 0xab, 0xe8, 0xb7, 0xa8, 0xe7, 0xbe, 0x8e, 0xe5, 0x9c, 0x8b, 0xe4, 0xbd, 0x9c, 0xe5+    , 0xae, 0xb6, 0xe4, 0xbb, 0xa5, 0xe6, 0x92, 0x92, 0xc2, 0xb7, 0xe8, 0x89, 0xbe, 0xe8, 0xa5, 0xbf+    , 0xe8, 0x8e, 0xab, 0xe5, 0xa4, 0xab, 0x34, 0x39, 0xe5, 0x80, 0x8b, 0xe5, 0xaf, 0xab, 0xe4, 0xbd+    , 0x9c, 0xe5, 0xb9, 0xb4, 0xe9, 0xa0, 0xad, 0xef, 0xbc, 0x8c, 0xe4, 0xb8, 0x80, 0xe5, 0x85, 0xb1+    , 0x31, 0x30, 0xe5, 0x86, 0x8a, 0xef, 0xbc, 0x88, 0xe5, 0x8c, 0x85, 0xe6, 0x8b, 0xac, 0xe5, 0x88+    , 0xa5, 0xe4, 0xba, 0xba, 0xe7, 0xba, 0x8c, 0xe5, 0xaf, 0xab, 0x33, 0xe5, 0x86, 0x8a, 0xef, 0xbc+    , 0x89, 0xef, 0xbc, 0x8c, 0xe5, 0xbd, 0xbc, 0xe6, 0xad, 0xa4, 0xe9, 0x96, 0x93, 0xe5, 0x8a, 0x87+    , 0xe6, 0x83, 0x85, 0xe7, 0x8d, 0xa8, 0xe7, 0xab, 0x8b, 0xef, 0xbc, 0x8c, 0xe5, 0x8d, 0xbb, 0xe5+    , 0x8f, 0x88, 0xe7, 0xb7, 0x8a, 0xe5, 0xaf, 0x86, 0xe9, 0x97, 0x9c, 0xe8, 0x81, 0xaf, 0xe3, 0x80+    , 0x82, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97+    , 0xe3, 0x80, 0x8d, 0xe9, 0x80, 0x9a, 0xe5, 0xb8, 0xb8, 0xe4, 0xb9, 0x9f, 0xe5, 0xb0, 0x87, 0xe8+    , 0x99, 0x95, 0xe5, 0x9c, 0xa8, 0xe5, 0x90, 0x8c, 0xe4, 0xb8, 0x80, 0xe6, 0x9e, 0xb6, 0xe7, 0xa9+    , 0xba, 0xe5, 0xae, 0x87, 0xe5, 0xae, 0x99, 0xe7, 0x9a, 0x84, 0xe3, 0x80, 0x8c, 0xe6, 0xa9, 0x9f+    , 0xe5, 0x99, 0xa8, 0xe4, 0xba, 0xba, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe3, 0x80, 0x8d, 0xe5+    , 0x92, 0x8c, 0xe3, 0x80, 0x8c, 0xe9, 0x8a, 0x80, 0xe6, 0xb2, 0xb3, 0xe5, 0xb8, 0x9d, 0xe5, 0x9c+    , 0x8b, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe3, 0x80, 0x8d, 0xe5, 0x8c, 0x85, 0xe6, 0x8b, 0xac+    , 0xe9, 0x80, 0xb2, 0xe4, 0xbe, 0x86, 0xef, 0xbc, 0x8c, 0xe7, 0xb8, 0xbd, 0xe8, 0xa8, 0x88, 0xe8+    , 0xb5, 0xb7, 0xe4, 0xbe, 0x86, 0xe6, 0x95, 0xb4, 0xe5, 0x80, 0x8b, 0xe3, 0x80, 0x8c, 0xe5, 0xa4+    , 0xa7, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe3, 0x80, 0x8d+    , 0xe4, 0xbd, 0x9c, 0xe5, 0x93, 0x81, 0xe5, 0x85, 0xb1, 0xe6, 0x9c, 0x89, 0x31, 0x34, 0xe5, 0x86+    , 0x8a, 0xe9, 0x95, 0xb7, 0xe7, 0xaf, 0x87, 0xef, 0xbc, 0x8c, 0xe5, 0x92, 0x8c, 0xe6, 0x95, 0xb8+    , 0xe4, 0xb8, 0x8d, 0xe6, 0xb8, 0x85, 0xe7, 0x9a, 0x84, 0xe7, 0x9f, 0xad, 0xe7, 0xaf, 0x87, 0xe5+    , 0xb0, 0x8f, 0xe8, 0xaa, 0xaa, 0xef, 0xbc, 0x8c, 0xe5, 0x8f, 0xa6, 0xe5, 0xa4, 0x96, 0x36, 0xe5+    , 0x86, 0x8a, 0xe7, 0x94, 0xb1, 0xe5, 0x85, 0xb6, 0xe4, 0xbb, 0x96, 0xe4, 0xbd, 0x9c, 0xe5, 0xae+    , 0xb6, 0xe5, 0x9c, 0xa8, 0xe4, 0xbb, 0x96, 0xe6, 0xad, 0xbb, 0xe5, 0xbe, 0x8c, 0xe7, 0xba, 0x8c+    , 0xe5, 0xaf, 0xab, 0xe3, 0x80, 0x82, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7+    , 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe3, 0x80, 0x8d, 0xe5, 0x82, 0x99, 0xe5, 0x8f, 0x97, 0xe8, 0xae+    , 0x9a, 0xe8, 0xad, 0xbd, 0xef, 0xbc, 0x8c, 0x31, 0x39, 0x36, 0x35, 0xe5, 0xb9, 0xb4, 0xe5, 0xbe+    , 0x97, 0xe9, 0x81, 0x8e, 0xe9, 0x9b, 0xa8, 0xe6, 0x9e, 0x9c, 0xe7, 0x8d, 0x8e, 0xe3, 0x80, 0x8c+    , 0xe5, 0x8f, 0xb2, 0xe4, 0xb8, 0x8a, 0xe6, 0x9c, 0x80, 0xe4, 0xbd, 0xb3, 0xe7, 0xa7, 0x91, 0xe5+    , 0xb9, 0xbb, 0xe5, 0xb0, 0x8f, 0xe8, 0xaa, 0xaa, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe3, 0x80+    , 0x8d, 0xe3, 0x80, 0x82, 0x0a, 0x0a, 0xe3, 0x80, 0x8a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe3+    , 0x80, 0x8b, 0xe5, 0x8e, 0x9f, 0xe6, 0x9c, 0xac, 0xe6, 0x98, 0xaf, 0xe4, 0xb8, 0x80, 0xe7, 0xb3+    , 0xbb, 0xe5, 0x88, 0x97, 0x38, 0xe7, 0xaf, 0x87, 0xe7, 0x9a, 0x84, 0xe7, 0x9f, 0xad, 0xe7, 0xaf+    , 0x87, 0xe5, 0xb0, 0x8f, 0xe8, 0xaa, 0xaa, 0xef, 0xbc, 0x8c, 0xe5, 0x9c, 0xa8, 0x31, 0x39, 0x34+    , 0x32, 0xe5, 0xb9, 0xb4, 0x35, 0xe6, 0x9c, 0x88, 0xe5, 0x88, 0xb0, 0x31, 0x39, 0x35, 0x30, 0xe5+    , 0xb9, 0xb4, 0x31, 0xe6, 0x9c, 0x88, 0xe6, 0x9c, 0x9f, 0xe9, 0x96, 0x93, 0xe7, 0x99, 0xbc, 0xe8+    , 0xa1, 0xa8, 0xe6, 0x96, 0xbc, 0xe3, 0x80, 0x8a, 0xe9, 0xa9, 0x9a, 0xe5, 0xa5, 0x87, 0xe9, 0x9b+    , 0x9c, 0xe8, 0xaa, 0x8c, 0xe3, 0x80, 0x8b, 0xef, 0xbc, 0x88, 0x41, 0x73, 0x74, 0x6f, 0x75, 0x6e+    , 0x64, 0x69, 0x6e, 0x67, 0x20, 0x4d, 0x61, 0x67, 0x61, 0x7a, 0x69, 0x6e, 0x65, 0xef, 0xbc, 0x89+    , 0xe3, 0x80, 0x82, 0xe8, 0x89, 0xbe, 0xe8, 0xa5, 0xbf, 0xe8, 0x8e, 0xab, 0xe5, 0xa4, 0xab, 0xe5+    , 0x9c, 0xa8, 0xe8, 0x87, 0xaa, 0xe5, 0x82, 0xb3, 0xe4, 0xb8, 0xad, 0xe8, 0xa1, 0xa8, 0xe7, 0xa4+    , 0xba, 0xef, 0xbc, 0x8c, 0xe3, 0x80, 0x8a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe3, 0x80, 0x8b+    , 0xe6, 0x98, 0xaf, 0xe5, 0x9c, 0xa8, 0xe4, 0xbb, 0x96, 0xe6, 0x8b, 0x9c, 0xe8, 0xa8, 0xaa, 0xe7+    , 0xb7, 0xa8, 0xe8, 0xbc, 0xaf, 0xe7, 0xb4, 0x84, 0xe7, 0xbf, 0xb0, 0xc2, 0xb7, 0xe5, 0x9d, 0x8e+    , 0xe8, 0xb2, 0x9d, 0xe7, 0x88, 0xbe, 0xef, 0xbc, 0x88, 0x4a, 0x6f, 0x68, 0x6e, 0x20, 0x57, 0x2e+    , 0x20, 0x43, 0x61, 0x6d, 0x70, 0x62, 0x65, 0x6c, 0x6c, 0xef, 0xbc, 0x89, 0xe7, 0x9a, 0x84, 0xe8+    , 0xb7, 0xaf, 0xe4, 0xb8, 0x8a, 0xef, 0xbc, 0x8c, 0xe5, 0xa4, 0xa9, 0xe9, 0xa6, 0xac, 0xe8, 0xa1+    , 0x8c, 0xe7, 0xa9, 0xba, 0xe8, 0x81, 0xaf, 0xe6, 0x83, 0xb3, 0xe8, 0x87, 0xaa, 0xe6, 0x84, 0x9b+    , 0xe5, 0xbe, 0xb7, 0xe8, 0x8f, 0xaf, 0xc2, 0xb7, 0xe5, 0x90, 0x89, 0xe6, 0x9c, 0xac, 0xe7, 0x9a+    , 0x84, 0xe3, 0x80, 0x8a, 0xe7, 0xbe, 0x85, 0xe9, 0xa6, 0xac, 0xe5, 0xb8, 0x9d, 0xe5, 0x9c, 0x8b+    , 0xe8, 0xa1, 0xb0, 0xe4, 0xba, 0xa1, 0xe5, 0x8f, 0xb2, 0xe3, 0x80, 0x8b, 0xef, 0xbc, 0x8c, 0xe4+    , 0xb9, 0x8b, 0xe5, 0xbe, 0x8c, 0xe8, 0x88, 0x87, 0xe5, 0x9d, 0x8e, 0xe8, 0xb2, 0x9d, 0xe7, 0x88+    , 0xbe, 0xe5, 0x85, 0xa9, 0xe7, 0x9b, 0xb8, 0xe8, 0xa8, 0x8e, 0xe8, 0xab, 0x96, 0xe4, 0xb8, 0x8b+    , 0xef, 0xbc, 0x8c, 0xe6, 0x95, 0xb4, 0xe9, 0xab, 0x94, 0xe6, 0xa6, 0x82, 0xe5, 0xbf, 0xb5, 0xe9+    , 0x81, 0x82, 0xe8, 0x80, 0x8c, 0xe6, 0x88, 0x90, 0xe5, 0xbd, 0xa2, 0x5b, 0x31, 0x5d, 0xe3, 0x80+    , 0x82, 0x0a, 0x0a, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0xb3, 0xbb, 0xe5+    , 0x88, 0x97, 0xe3, 0x80, 0x8d, 0xe7, 0xac, 0xac, 0xe4, 0xb8, 0x80, 0xe9, 0x83, 0xa8, 0xe3, 0x80+    , 0x8a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe3, 0x80, 0x8b, 0xe5, 0x8c, 0x85, 0xe5, 0x90, 0xab+    , 0x34, 0xe7, 0xaf, 0x87, 0xe7, 0x9f, 0xad, 0xe7, 0xaf, 0x87, 0xe5, 0xb0, 0x8f, 0xe8, 0xaa, 0xaa+    , 0xef, 0xbc, 0x8c, 0xe5, 0x8a, 0x87, 0xe6, 0x83, 0x85, 0xe5, 0x90, 0x84, 0xe8, 0x87, 0xaa, 0xe7+    , 0x8d, 0xa8, 0xe7, 0xab, 0x8b, 0xef, 0xbc, 0x8c, 0xe5, 0x96, 0xae, 0xe8, 0xa1, 0x8c, 0xe6, 0x9c+    , 0xac, 0xe7, 0x99, 0xbc, 0xe8, 0xa1, 0x8c, 0xe6, 0x96, 0xbc, 0x31, 0x39, 0x35, 0x31, 0xe5, 0xb9+    , 0xb4, 0xe3, 0x80, 0x82, 0xe5, 0x85, 0xb6, 0xe5, 0xae, 0x83, 0x34, 0xe7, 0xaf, 0x87, 0xe4, 0xb8+    , 0xad, 0xe7, 0xaf, 0x87, 0xe5, 0xb0, 0x8f, 0xe8, 0xaa, 0xaa, 0xe5, 0x85, 0xa9, 0xe5, 0x85, 0xa9+    , 0xe7, 0x9b, 0xb8, 0xe5, 0xb0, 0x8d, 0xef, 0xbc, 0x8c, 0xe5, 0x88, 0x86, 0xe5, 0x88, 0xa5, 0xe6+    , 0x94, 0xb6, 0xe9, 0x8c, 0x84, 0xe5, 0x9c, 0xa8, 0xe3, 0x80, 0x8a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c+    , 0xb0, 0xe8, 0x88, 0x87, 0xe5, 0xb8, 0x9d, 0xe5, 0x9c, 0x8b, 0xe3, 0x80, 0x8b, 0xe5, 0x92, 0x8c+    , 0xe3, 0x80, 0x8a, 0xe7, 0xac, 0xac, 0xe4, 0xba, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe3+    , 0x80, 0x8b, 0xef, 0xbc, 0x8c, 0xe6, 0x88, 0x90, 0xe7, 0x82, 0xba, 0xe5, 0x90, 0x8d, 0xe8, 0x81+    , 0x9e, 0xe9, 0x81, 0x90, 0xe9, 0x82, 0x87, 0xe7, 0x9a, 0x84, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba+    , 0xe5, 0x9c, 0xb0, 0xe4, 0xb8, 0x89, 0xe9, 0x83, 0xa8, 0xe6, 0x9b, 0xb2, 0xe3, 0x80, 0x8d, 0xe3+    , 0x80, 0x82, 0x31, 0x39, 0x38, 0x31, 0xe5, 0xb9, 0xb4, 0xef, 0xbc, 0x8c, 0xe3, 0x80, 0x8c, 0xe5+    , 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe4, 0xb8, 0x89, 0xe9, 0x83, 0xa8, 0xe6, 0x9b, 0xb2, 0xe3, 0x80+    , 0x8d, 0xe6, 0x97, 0xa9, 0xe5, 0xb7, 0xb2, 0xe6, 0x98, 0xaf, 0xe4, 0xb8, 0x96, 0xe6, 0x89, 0x80+    , 0xe5, 0x85, 0xac, 0xe8, 0xaa, 0x8d, 0xe6, 0x9c, 0x80, 0xe9, 0x87, 0x8d, 0xe8, 0xa6, 0x81, 0xe7+    , 0x9a, 0x84, 0xe7, 0x8f, 0xbe, 0xe4, 0xbb, 0xa3, 0xe7, 0xa7, 0x91, 0xe5, 0xb9, 0xbb, 0xe4, 0xbd+    , 0x9c, 0xe5, 0x93, 0x81, 0xef, 0xbc, 0x8c, 0xe8, 0x89, 0xbe, 0xe8, 0xa5, 0xbf, 0xe8, 0x8e, 0xab+    , 0xe5, 0xa4, 0xab, 0xe7, 0xb5, 0x82, 0xe6, 0x96, 0xbc, 0xe8, 0xa2, 0xab, 0xe5, 0x87, 0xba, 0xe7+    , 0x89, 0x88, 0xe5, 0x95, 0x86, 0xe8, 0xaa, 0xaa, 0xe6, 0x9c, 0x8d, 0xe7, 0xba, 0x8c, 0xe5, 0xaf+    , 0xab, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97+    , 0xe3, 0x80, 0x8d, 0xe7, 0xac, 0xac, 0xe5, 0x9b, 0x9b, 0xe9, 0x83, 0xa8, 0xe3, 0x80, 0x8a, 0xe5+    , 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe9, 0x82, 0x8a, 0xe7, 0xb7, 0xa3, 0xe3, 0x80, 0x8b, 0x5b, 0x32+    , 0x5d, 0xe3, 0x80, 0x82, 0xe6, 0x8e, 0xa5, 0xe4, 0xb8, 0x8b, 0xe4, 0xbe, 0x86, 0xe4, 0xbb, 0x96+    , 0xe5, 0x8f, 0x88, 0xe5, 0xaf, 0xab, 0xe4, 0xba, 0x86, 0xe4, 0xb8, 0x80, 0xe9, 0x83, 0xa8, 0xe7+    , 0xba, 0x8c, 0xe9, 0x9b, 0x86, 0xe3, 0x80, 0x8a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe8, 0x88+    , 0x87, 0xe5, 0x9c, 0xb0, 0xe7, 0x90, 0x83, 0xe3, 0x80, 0x8b, 0xef, 0xbc, 0x8c, 0x35, 0xe5, 0xb9+    , 0xb4, 0xe5, 0xbe, 0x8c, 0xe7, 0x99, 0xbc, 0xe8, 0xa1, 0xa8, 0xe5, 0x85, 0xa9, 0xe9, 0x83, 0xa8+    , 0xe5, 0x89, 0x8d, 0xe5, 0x82, 0xb3, 0xe3, 0x80, 0x8a, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe5+    , 0x89, 0x8d, 0xe5, 0xa5, 0x8f, 0xe3, 0x80, 0x8b, 0xe5, 0x92, 0x8c, 0xe3, 0x80, 0x8a, 0xe5, 0x9f+    , 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0xb7, 0xa0, 0xe9, 0x80, 0xa0, 0xe8, 0x80, 0x85, 0xe3, 0x80, 0x8b+    , 0xef, 0xbc, 0x8c, 0xe5, 0x9c, 0xa8, 0xe9, 0x80, 0x99, 0xe5, 0xb9, 0xbe, 0xe5, 0xb9, 0xb4, 0xe4+    , 0xb8, 0xad, 0xef, 0xbc, 0x8c, 0xe8, 0x89, 0xbe, 0xe8, 0xa5, 0xbf, 0xe8, 0x8e, 0xab, 0xe5, 0xa4+    , 0xab, 0xe5, 0xb0, 0x87, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0xb3, 0xbb+    , 0xe5, 0x88, 0x97, 0xe3, 0x80, 0x8d, 0xe8, 0x88, 0x87, 0xe5, 0x85, 0xb6, 0xe5, 0xae, 0x83, 0xe7+    , 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe7, 0x9b, 0xb8, 0xe7, 0xb5, 0x90, 0xe5, 0x90, 0x88, 0xef, 0xbc+    , 0x8c, 0xe5, 0xb0, 0x87, 0xe6, 0x89, 0x80, 0xe6, 0x9c, 0x89, 0xe7, 0xb3, 0xbb, 0xe5, 0x88, 0x97+    , 0xe4, 0xbd, 0x9c, 0xe5, 0x93, 0x81, 0xe5, 0x90, 0x8c, 0xe7, 0xbd, 0xae, 0xe6, 0x96, 0xbc, 0xe4+    , 0xb8, 0x80, 0xe5, 0x80, 0x8b, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe5, 0xae+    , 0x87, 0xe5, 0xae, 0x99, 0xe3, 0x80, 0x8d, 0xe6, 0x9e, 0xb6, 0xe6, 0xa7, 0x8b, 0xe4, 0xb8, 0x8b+    , 0xe3, 0x80, 0x82, 0x0a, 0x0a, 0xe8, 0x89, 0xbe, 0xe8, 0xa5, 0xbf, 0xe8, 0x8e, 0xab, 0xe5, 0xa4+    , 0xab, 0xe5, 0x92, 0x8c, 0xe5, 0x9d, 0x8e, 0xe8, 0xb2, 0x9d, 0xe7, 0x88, 0xbe, 0xe8, 0x81, 0xaf+    , 0xe6, 0x89, 0x8b, 0xe7, 0x82, 0xba, 0xe3, 0x80, 0x8c, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7+    , 0xb3, 0xbb, 0xe5, 0x88, 0x97, 0xe3, 0x80, 0x8d, 0xe6, 0x89, 0x93, 0xe9, 0x80, 0xa0, 0xe5, 0x87+    , 0xba, 0xe4, 0xb8, 0x80, 0xe9, 0x96, 0x80, 0xe5, 0x85, 0xa8, 0xe6, 0x96, 0xb0, 0xe7, 0x9a, 0x84+    , 0xe7, 0xb5, 0xb1, 0xe8, 0xa8, 0x88, 0xe7, 0xa7, 0x91, 0xe5, 0xad, 0xb8, 0xef, 0xbc, 0x8c, 0xe7+    , 0xa8, 0xb1, 0xe4, 0xb9, 0x8b, 0xe7, 0x82, 0xba, 0xe2, 0x80, 0x9c, 0xe5, 0xbf, 0x83, 0xe7, 0x90+    , 0x86, 0xe5, 0x8f, 0xb2, 0xe5, 0xad, 0xb8, 0xe2, 0x80, 0x9d, 0xef, 0xbc, 0x8c, 0xe9, 0x80, 0x99+    , 0xe9, 0x96, 0x80, 0xe5, 0xad, 0xb8, 0xe5, 0x95, 0x8f, 0xe7, 0x94, 0xb1, 0xe6, 0x9b, 0xb8, 0xe4+    , 0xb8, 0xad, 0xe6, 0x95, 0xb0, 0xe5, 0xad, 0xb8, 0xe5, 0xae, 0xb6, 0xe5, 0x93, 0x88, 0xe9, 0x87+    , 0x8c, 0xc2, 0xb7, 0xe8, 0xac, 0x9d, 0xe9, 0xa0, 0x93, 0xe7, 0xaa, 0xae, 0xe7, 0x9b, 0xa1, 0xe7+    , 0x95, 0xa2, 0xe7, 0x94, 0x9f, 0xe4, 0xb9, 0x8b, 0xe5, 0x8a, 0x9b, 0xe5, 0x89, 0xb5, 0xe5, 0xbb+    , 0xba, 0xef, 0xbc, 0x8c, 0xe6, 0xa0, 0xb9, 0xe6, 0x93, 0x9a, 0xe5, 0xa4, 0xa7, 0xe8, 0xa6, 0x8f+    , 0xe6, 0xa8, 0xa1, 0xe7, 0x9a, 0x84, 0xe4, 0xba, 0xba, 0xe9, 0xa1, 0x9e, 0xe6, 0xb4, 0xbb, 0xe5+    , 0x8b, 0x95, 0xe6, 0x95, 0xb8, 0xe6, 0x93, 0x9a, 0xef, 0xbc, 0x8c, 0xe9, 0xa0, 0x90, 0xe6, 0xb8+    , 0xac, 0xe6, 0x9c, 0xaa, 0xe4, 0xbe, 0x86, 0xe8, 0xb5, 0xb0, 0xe5, 0x90, 0x91, 0xef, 0xbc, 0x8c+    , 0xe8, 0xa6, 0x8f, 0xe6, 0xa8, 0xa1, 0xe4, 0xb8, 0x80, 0xe6, 0x97, 0xa6, 0xe5, 0xb0, 0x8f, 0xe6+    , 0x96, 0xbc, 0xe4, 0xb8, 0x80, 0xe9, 0xa1, 0x86, 0xe6, 0x98, 0x9f, 0xe7, 0x90, 0x83, 0xe6, 0x88+    , 0x96, 0xe6, 0x98, 0xaf, 0xe4, 0xb8, 0x80, 0xe5, 0xba, 0xa7, 0xe5, 0xb8, 0x9d, 0xe5, 0x9c, 0x8b+    , 0xef, 0xbc, 0x8c, 0xe7, 0xb5, 0x90, 0xe6, 0x9e, 0x9c, 0xe5, 0xb0, 0xb1, 0xe6, 0x9c, 0x83, 0xe5+    , 0xa4, 0xb1, 0xe6, 0xba, 0x96, 0xe3, 0x80, 0x82, 0xe8, 0xac, 0x9d, 0xe9, 0xa0, 0x93, 0xe9, 0x81+    , 0x8b, 0xe7, 0x94, 0xa8, 0xe6, 0xad, 0xa4, 0xe4, 0xb8, 0x80, 0xe7, 0xa7, 0x91, 0xe5, 0xad, 0xb8+    , 0xef, 0xbc, 0x8c, 0xe9, 0xa0, 0x90, 0xe8, 0xa6, 0x8b, 0xe9, 0x8a, 0x80, 0xe6, 0xb2, 0xb3, 0xe5+    , 0xb8, 0x9d, 0xe5, 0x9c, 0x8b, 0xe7, 0x9a, 0x84, 0xe6, 0xae, 0x9e, 0xe8, 0x90, 0xbd, 0xef, 0xbc+    , 0x8c, 0xe6, 0x95, 0xb4, 0xe7, 0x89, 0x87, 0xe9, 0x8a, 0x80, 0xe6, 0xb2, 0xb3, 0xe5, 0xb0, 0x87+    , 0xe5, 0x9b, 0xa0, 0xe6, 0xad, 0xa4, 0xe9, 0x80, 0xb2, 0xe5, 0x85, 0xa5, 0xe9, 0x95, 0xb7, 0xe9+    , 0x81, 0x94, 0xe4, 0xb8, 0x89, 0xe8, 0x90, 0xac, 0xe5, 0xb9, 0xb4, 0xe7, 0x9a, 0x84, 0xe9, 0xbb+    , 0x91, 0xe6, 0x9a, 0x97, 0xe6, 0x99, 0x82, 0xe6, 0x9c, 0x9f, 0xef, 0xbc, 0x8c, 0xe7, 0x9b, 0xb4+    , 0xe5, 0x88, 0xb0, 0xe7, 0xac, 0xac, 0xe4, 0xba, 0x8c, 0xe5, 0xb8, 0x9d, 0xe5, 0x9c, 0x8b, 0xe5+    , 0xbb, 0xba, 0xe7, 0xab, 0x8b, 0xe3, 0x80, 0x82, 0x0a, 0x0a, 0xe6, 0x96, 0xbc, 0xe6, 0x98, 0xaf+    , 0xe8, 0xac, 0x9d, 0xe9, 0xa0, 0x93, 0xe5, 0xbb, 0xba, 0xe7, 0xab, 0x8b, 0xe5, 0x85, 0xa9, 0xe5+    , 0xba, 0xa7, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xef, 0xbc, 0x8c, 0xe8, 0x97, 0x89, 0xe4, 0xbb+    , 0xa5, 0xe7, 0xb8, 0xae, 0xe6, 0xb8, 0x9b, 0xe8, 0xa0, 0xbb, 0xe8, 0x8d, 0x92, 0xe6, 0x99, 0x82+    , 0xe6, 0x9c, 0x9f, 0xef, 0xbc, 0x8c, 0xe4, 0xb8, 0x80, 0xe5, 0xba, 0xa7, 0xe9, 0x81, 0xa0, 0xe5+    , 0x9c, 0xa8, 0xe9, 0x82, 0x8a, 0xe9, 0x99, 0xb2, 0xef, 0xbc, 0x8c, 0xe6, 0x98, 0xaf, 0xe8, 0x97+    , 0x9d, 0xe8, 0xa1, 0x93, 0xe8, 0x88, 0x87, 0xe7, 0xa7, 0x91, 0xe5, 0xad, 0xb8, 0xe7, 0x9a, 0x84+    , 0xe9, 0x81, 0xbf, 0xe9, 0xa2, 0xa8, 0xe6, 0xb8, 0xaf, 0xef, 0xbc, 0x8c, 0xe7, 0x9b, 0xb8, 0xe5+    , 0xb0, 0x8d, 0xe7, 0x9a, 0x84, 0xe5, 0x8f, 0xa6, 0xe4, 0xb8, 0x80, 0xe5, 0xba, 0xa7, 0xe5, 0x89+    , 0x87, 0xe5, 0x9c, 0xa8, 0xe2, 0x80, 0x9c, 0xe7, 0xbe, 0xa4, 0xe6, 0x98, 0x9f, 0xe7, 0x9a, 0x84+    , 0xe7, 0x9b, 0xa1, 0xe9, 0xa0, 0xad, 0xe2, 0x80, 0x9d, 0xe3, 0x80, 0x82, 0xe3, 0x80, 0x8c, 0xe5+    , 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe4, 0xb8, 0x89, 0xe9, 0x83, 0xa8, 0xe6, 0x9b, 0xb2, 0xe3, 0x80+    , 0x8d, 0xe7, 0x9a, 0x84, 0xe4, 0xb8, 0xbb, 0xe8, 0xa6, 0x81, 0xe7, 0x84, 0xa6, 0xe9, 0xbb, 0x9e+    , 0xe5, 0xb0, 0xb1, 0xe5, 0x9c, 0xa8, 0xe7, 0xab, 0xaf, 0xe9, 0xbb, 0x9e, 0xe6, 0x98, 0x9f, 0xe4+    , 0xb8, 0x8a, 0xe7, 0x9a, 0x84, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe3, 0x80, 0x82, 0xe7, 0xab+    , 0xaf, 0xe9, 0xbb, 0x9e, 0xe6, 0x98, 0x9f, 0xe4, 0xb8, 0x8a, 0xe7, 0x9a, 0x84, 0xe5, 0xad, 0xb8+    , 0xe8, 0x80, 0x85, 0xe7, 0x82, 0xba, 0xe4, 0xba, 0x86, 0xe6, 0x90, 0xb6, 0xe5, 0x9c, 0xa8, 0xe8+    , 0xa1, 0xb0, 0xe9, 0x80, 0x80, 0xe6, 0x9c, 0x9f, 0xe4, 0xb9, 0x8b, 0xe5, 0x89, 0x8d, 0xef, 0xbc+    , 0x8c, 0xe4, 0xbf, 0x9d, 0xe5, 0xad, 0x98, 0xe4, 0xba, 0xba, 0xe9, 0xa1, 0x9e, 0xe7, 0x89, 0xa9+    , 0xe7, 0x90, 0x86, 0xe7, 0xa7, 0x91, 0xe5, 0xad, 0xb8, 0xe7, 0x9a, 0x84, 0xe7, 0x9f, 0xa5, 0xe8+    , 0xad, 0x98, 0xef, 0xbc, 0x8c, 0xe5, 0x8a, 0xaa, 0xe5, 0x8a, 0x9b, 0xe7, 0xb7, 0xa8, 0xe8, 0xbc+    , 0xaf, 0xe8, 0x91, 0x97, 0xe4, 0xb8, 0x80, 0xe9, 0x83, 0xa8, 0xe5, 0x85, 0xa8, 0xe6, 0x96, 0xb9+    , 0xe4, 0xbd, 0x8d, 0xe7, 0x9a, 0x84, 0xe3, 0x80, 0x8a, 0xe9, 0x93, 0xb6, 0xe6, 0xb2, 0xb3, 0xe7+    , 0x99, 0xbe, 0xe7, 0xa7, 0x91, 0xe5, 0x85, 0xa8, 0xe4, 0xb9, 0xa6, 0xe3, 0x80, 0x8b, 0xef, 0xbc+    , 0x8c, 0xe5, 0xb0, 0x8d, 0xe8, 0xac, 0x9d, 0xe9, 0xa0, 0x93, 0xe7, 0x9c, 0x9f, 0xe6, 0xad, 0xa3+    , 0xe7, 0x9a, 0x84, 0xe6, 0x84, 0x8f, 0xe5, 0x9c, 0x96, 0xe6, 0xaf, 0xab, 0xe4, 0xb8, 0x8d, 0xe7+    , 0x9f, 0xa5, 0xe6, 0x83, 0x85, 0xef, 0xbc, 0x88, 0xe5, 0xa6, 0x82, 0xe6, 0x9e, 0x9c, 0xe4, 0xbb+    , 0x96, 0xe5, 0x80, 0x91, 0xe7, 0x9f, 0xa5, 0xe9, 0x81, 0x93, 0xef, 0xbc, 0x8c, 0xe5, 0xb0, 0xb1+    , 0xe6, 0x9c, 0x83, 0xe7, 0x94, 0xa2, 0xe7, 0x94, 0x9f, 0xe7, 0x84, 0xa1, 0xe6, 0xb3, 0x95, 0xe6+    , 0x8e, 0xa7, 0xe5, 0x88, 0xb6, 0xe7, 0x9a, 0x84, 0xe8, 0xae, 0x8a, 0xe6, 0x95, 0xb8, 0xef, 0xbc+    , 0x89, 0xe3, 0x80, 0x82, 0xe5, 0x9f, 0xba, 0xe5, 0x9c, 0xb0, 0xe7, 0x9a, 0x84, 0xe4, 0xbd, 0x8d+    , 0xe7, 0xbd, 0xae, 0xe4, 0xb9, 0x9f, 0xe6, 0x98, 0xaf, 0xe5, 0x88, 0xbb, 0xe6, 0x84, 0x8f, 0xe9+    , 0x81, 0xb8, 0xe5, 0xae, 0x9a, 0xe7, 0x9a, 0x84, 0xef, 0xbc, 0x8c, 0xe5, 0x8d, 0x83, 0xe5, 0xb9+    , 0xb4, 0xe5, 0xbe, 0x8c, 0xe5, 0xb0, 0xb1, 0xe6, 0x98, 0xaf, 0xe7, 0xac, 0xac, 0xe4, 0xba, 0x8c+    , 0xe5, 0xb8, 0x9d, 0xe5, 0x9c, 0x8b, 0xe7, 0x9a, 0x84, 0xe9, 0xa6, 0x96, 0xe9, 0x83, 0xbd, 0xef+    , 0xbc, 0x88, 0xe4, 0xb8, 0xa6, 0xe9, 0x9d, 0x9e, 0xe4, 0xb8, 0x89, 0xe8, 0x90, 0xac, 0xe5, 0xb9+    , 0xb4, 0xe5, 0xbe, 0x8c, 0xe7, 0x9a, 0x84, 0xe9, 0x82, 0xa3, 0xe5, 0x80, 0x8b, 0xe5, 0xb8, 0x9d+    , 0xe5, 0x9c, 0x8b, 0xef, 0xbc, 0x89, 0x0a+    ]++++sample2_UTF16 :: EncodedString+sample2_UTF16 = EncodedString UTF16 $ recast array+  where+    array :: UArray Word16+    array = fromList+        [ 0x0054, 0x0068, 0x0065, 0x0020, 0x0073, 0x0061, 0x006d, 0x0070+        , 0x006c, 0x0065, 0x0020, 0x0074, 0x0065, 0x0078, 0x0074, 0x0020+        , 0x0062, 0x0065, 0x006c, 0x006f, 0x0077, 0x0020, 0x0068, 0x0061+        , 0x0073, 0x0020, 0x0062, 0x0065, 0x0065, 0x006e, 0x0020, 0x0074+        , 0x0061, 0x006b, 0x0065, 0x006e, 0x0020, 0x0066, 0x0072, 0x006f+        , 0x006d, 0x0020, 0x0057, 0x0069, 0x006b, 0x0069, 0x0070, 0x0065+        , 0x0064, 0x0069, 0x0061, 0x003a, 0x000a, 0x0068, 0x0074, 0x0074+        , 0x0070, 0x0073, 0x003a, 0x002f, 0x002f, 0x007a, 0x0068, 0x002e+        , 0x0077, 0x0069, 0x006b, 0x0069, 0x0070, 0x0065, 0x0064, 0x0069+        , 0x0061, 0x002e, 0x006f, 0x0072, 0x0067, 0x002f, 0x0077, 0x0069+        , 0x006b, 0x0069, 0x002f, 0x0025, 0x0045, 0x0035, 0x0025, 0x0039+        , 0x0046, 0x0025, 0x0042, 0x0041, 0x0025, 0x0045, 0x0035, 0x0025+        , 0x0039, 0x0043, 0x0025, 0x0042, 0x0030, 0x0025, 0x0045, 0x0037+        , 0x0025, 0x0042, 0x0033, 0x0025, 0x0042, 0x0042, 0x0025, 0x0045+        , 0x0035, 0x0025, 0x0038, 0x0038, 0x0025, 0x0039, 0x0037, 0x000a+        , 0x000a, 0x57fa, 0x5730, 0x7cfb, 0x5217, 0xff08, 0x0054, 0x0068+        , 0x0065, 0x0020, 0x0046, 0x006f, 0x0075, 0x006e, 0x0064, 0x0061+        , 0x0074, 0x0069, 0x006f, 0x006e, 0x0020, 0x0053, 0x0065, 0x0072+        , 0x0069, 0x0065, 0x0073, 0xff09, 0x662f, 0x4e00, 0x90e8, 0x7d93+        , 0x5178, 0x79d1, 0x5e7b, 0x5c0f, 0x8aaa, 0x7cfb, 0x5217, 0xff0c+        , 0x5275, 0x4f5c, 0x6642, 0x9593, 0x6a6b, 0x8de8, 0x7f8e, 0x570b+        , 0x4f5c, 0x5bb6, 0x4ee5, 0x6492, 0x00b7, 0x827e, 0x897f, 0x83ab+        , 0x592b, 0x0034, 0x0039, 0x500b, 0x5beb, 0x4f5c, 0x5e74, 0x982d+        , 0xff0c, 0x4e00, 0x5171, 0x0031, 0x0030, 0x518a, 0xff08, 0x5305+        , 0x62ec, 0x5225, 0x4eba, 0x7e8c, 0x5beb, 0x0033, 0x518a, 0xff09+        , 0xff0c, 0x5f7c, 0x6b64, 0x9593, 0x5287, 0x60c5, 0x7368, 0x7acb+        , 0xff0c, 0x537b, 0x53c8, 0x7dca, 0x5bc6, 0x95dc, 0x806f, 0x3002+        , 0x300c, 0x57fa, 0x5730, 0x7cfb, 0x5217, 0x300d, 0x901a, 0x5e38+        , 0x4e5f, 0x5c07, 0x8655, 0x5728, 0x540c, 0x4e00, 0x67b6, 0x7a7a+        , 0x5b87, 0x5b99, 0x7684, 0x300c, 0x6a5f, 0x5668, 0x4eba, 0x7cfb+        , 0x5217, 0x300d, 0x548c, 0x300c, 0x9280, 0x6cb3, 0x5e1d, 0x570b+        , 0x7cfb, 0x5217, 0x300d, 0x5305, 0x62ec, 0x9032, 0x4f86, 0xff0c+        , 0x7e3d, 0x8a08, 0x8d77, 0x4f86, 0x6574, 0x500b, 0x300c, 0x5927+        , 0x57fa, 0x5730, 0x7cfb, 0x5217, 0x300d, 0x4f5c, 0x54c1, 0x5171+        , 0x6709, 0x0031, 0x0034, 0x518a, 0x9577, 0x7bc7, 0xff0c, 0x548c+        , 0x6578, 0x4e0d, 0x6e05, 0x7684, 0x77ed, 0x7bc7, 0x5c0f, 0x8aaa+        , 0xff0c, 0x53e6, 0x5916, 0x0036, 0x518a, 0x7531, 0x5176, 0x4ed6+        , 0x4f5c, 0x5bb6, 0x5728, 0x4ed6, 0x6b7b, 0x5f8c, 0x7e8c, 0x5beb+        , 0x3002, 0x300c, 0x57fa, 0x5730, 0x7cfb, 0x5217, 0x300d, 0x5099+        , 0x53d7, 0x8b9a, 0x8b7d, 0xff0c, 0x0031, 0x0039, 0x0036, 0x0035+        , 0x5e74, 0x5f97, 0x904e, 0x96e8, 0x679c, 0x734e, 0x300c, 0x53f2+        , 0x4e0a, 0x6700, 0x4f73, 0x79d1, 0x5e7b, 0x5c0f, 0x8aaa, 0x7cfb+        , 0x5217, 0x300d, 0x3002, 0x000a, 0x000a, 0x300a, 0x57fa, 0x5730+        , 0x300b, 0x539f, 0x672c, 0x662f, 0x4e00, 0x7cfb, 0x5217, 0x0038+        , 0x7bc7, 0x7684, 0x77ed, 0x7bc7, 0x5c0f, 0x8aaa, 0xff0c, 0x5728+        , 0x0031, 0x0039, 0x0034, 0x0032, 0x5e74, 0x0035, 0x6708, 0x5230+        , 0x0031, 0x0039, 0x0035, 0x0030, 0x5e74, 0x0031, 0x6708, 0x671f+        , 0x9593, 0x767c, 0x8868, 0x65bc, 0x300a, 0x9a5a, 0x5947, 0x96dc+        , 0x8a8c, 0x300b, 0xff08, 0x0041, 0x0073, 0x0074, 0x006f, 0x0075+        , 0x006e, 0x0064, 0x0069, 0x006e, 0x0067, 0x0020, 0x004d, 0x0061+        , 0x0067, 0x0061, 0x007a, 0x0069, 0x006e, 0x0065, 0xff09, 0x3002+        , 0x827e, 0x897f, 0x83ab, 0x592b, 0x5728, 0x81ea, 0x50b3, 0x4e2d+        , 0x8868, 0x793a, 0xff0c, 0x300a, 0x57fa, 0x5730, 0x300b, 0x662f+        , 0x5728, 0x4ed6, 0x62dc, 0x8a2a, 0x7de8, 0x8f2f, 0x7d04, 0x7ff0+        , 0x00b7, 0x574e, 0x8c9d, 0x723e, 0xff08, 0x004a, 0x006f, 0x0068+        , 0x006e, 0x0020, 0x0057, 0x002e, 0x0020, 0x0043, 0x0061, 0x006d+        , 0x0070, 0x0062, 0x0065, 0x006c, 0x006c, 0xff09, 0x7684, 0x8def+        , 0x4e0a, 0xff0c, 0x5929, 0x99ac, 0x884c, 0x7a7a, 0x806f, 0x60f3+        , 0x81ea, 0x611b, 0x5fb7, 0x83ef, 0x00b7, 0x5409, 0x672c, 0x7684+        , 0x300a, 0x7f85, 0x99ac, 0x5e1d, 0x570b, 0x8870, 0x4ea1, 0x53f2+        , 0x300b, 0xff0c, 0x4e4b, 0x5f8c, 0x8207, 0x574e, 0x8c9d, 0x723e+        , 0x5169, 0x76f8, 0x8a0e, 0x8ad6, 0x4e0b, 0xff0c, 0x6574, 0x9ad4+        , 0x6982, 0x5ff5, 0x9042, 0x800c, 0x6210, 0x5f62, 0x005b, 0x0031+        , 0x005d, 0x3002, 0x000a, 0x000a, 0x300c, 0x57fa, 0x5730, 0x7cfb+        , 0x5217, 0x300d, 0x7b2c, 0x4e00, 0x90e8, 0x300a, 0x57fa, 0x5730+        , 0x300b, 0x5305, 0x542b, 0x0034, 0x7bc7, 0x77ed, 0x7bc7, 0x5c0f+        , 0x8aaa, 0xff0c, 0x5287, 0x60c5, 0x5404, 0x81ea, 0x7368, 0x7acb+        , 0xff0c, 0x55ae, 0x884c, 0x672c, 0x767c, 0x884c, 0x65bc, 0x0031+        , 0x0039, 0x0035, 0x0031, 0x5e74, 0x3002, 0x5176, 0x5b83, 0x0034+        , 0x7bc7, 0x4e2d, 0x7bc7, 0x5c0f, 0x8aaa, 0x5169, 0x5169, 0x76f8+        , 0x5c0d, 0xff0c, 0x5206, 0x5225, 0x6536, 0x9304, 0x5728, 0x300a+        , 0x57fa, 0x5730, 0x8207, 0x5e1d, 0x570b, 0x300b, 0x548c, 0x300a+        , 0x7b2c, 0x4e8c, 0x57fa, 0x5730, 0x300b, 0xff0c, 0x6210, 0x70ba+        , 0x540d, 0x805e, 0x9050, 0x9087, 0x7684, 0x300c, 0x57fa, 0x5730+        , 0x4e09, 0x90e8, 0x66f2, 0x300d, 0x3002, 0x0031, 0x0039, 0x0038+        , 0x0031, 0x5e74, 0xff0c, 0x300c, 0x57fa, 0x5730, 0x4e09, 0x90e8+        , 0x66f2, 0x300d, 0x65e9, 0x5df2, 0x662f, 0x4e16, 0x6240, 0x516c+        , 0x8a8d, 0x6700, 0x91cd, 0x8981, 0x7684, 0x73fe, 0x4ee3, 0x79d1+        , 0x5e7b, 0x4f5c, 0x54c1, 0xff0c, 0x827e, 0x897f, 0x83ab, 0x592b+        , 0x7d42, 0x65bc, 0x88ab, 0x51fa, 0x7248, 0x5546, 0x8aaa, 0x670d+        , 0x7e8c, 0x5beb, 0x300c, 0x57fa, 0x5730, 0x7cfb, 0x5217, 0x300d+        , 0x7b2c, 0x56db, 0x90e8, 0x300a, 0x57fa, 0x5730, 0x908a, 0x7de3+        , 0x300b, 0x005b, 0x0032, 0x005d, 0x3002, 0x63a5, 0x4e0b, 0x4f86+        , 0x4ed6, 0x53c8, 0x5beb, 0x4e86, 0x4e00, 0x90e8, 0x7e8c, 0x96c6+        , 0x300a, 0x57fa, 0x5730, 0x8207, 0x5730, 0x7403, 0x300b, 0xff0c+        , 0x0035, 0x5e74, 0x5f8c, 0x767c, 0x8868, 0x5169, 0x90e8, 0x524d+        , 0x50b3, 0x300a, 0x57fa, 0x5730, 0x524d, 0x594f, 0x300b, 0x548c+        , 0x300a, 0x57fa, 0x5730, 0x7de0, 0x9020, 0x8005, 0x300b, 0xff0c+        , 0x5728, 0x9019, 0x5e7e, 0x5e74, 0x4e2d, 0xff0c, 0x827e, 0x897f+        , 0x83ab, 0x592b, 0x5c07, 0x300c, 0x57fa, 0x5730, 0x7cfb, 0x5217+        , 0x300d, 0x8207, 0x5176, 0x5b83, 0x7cfb, 0x5217, 0x76f8, 0x7d50+        , 0x5408, 0xff0c, 0x5c07, 0x6240, 0x6709, 0x7cfb, 0x5217, 0x4f5c+        , 0x54c1, 0x540c, 0x7f6e, 0x65bc, 0x4e00, 0x500b, 0x300c, 0x57fa+        , 0x5730, 0x5b87, 0x5b99, 0x300d, 0x67b6, 0x69cb, 0x4e0b, 0x3002+        , 0x000a, 0x000a, 0x827e, 0x897f, 0x83ab, 0x592b, 0x548c, 0x574e+        , 0x8c9d, 0x723e, 0x806f, 0x624b, 0x70ba, 0x300c, 0x57fa, 0x5730+        , 0x7cfb, 0x5217, 0x300d, 0x6253, 0x9020, 0x51fa, 0x4e00, 0x9580+        , 0x5168, 0x65b0, 0x7684, 0x7d71, 0x8a08, 0x79d1, 0x5b78, 0xff0c+        , 0x7a31, 0x4e4b, 0x70ba, 0x201c, 0x5fc3, 0x7406, 0x53f2, 0x5b78+        , 0x201d, 0xff0c, 0x9019, 0x9580, 0x5b78, 0x554f, 0x7531, 0x66f8+        , 0x4e2d, 0x6570, 0x5b78, 0x5bb6, 0x54c8, 0x91cc, 0x00b7, 0x8b1d+        , 0x9813, 0x7aae, 0x76e1, 0x7562, 0x751f, 0x4e4b, 0x529b, 0x5275+        , 0x5efa, 0xff0c, 0x6839, 0x64da, 0x5927, 0x898f, 0x6a21, 0x7684+        , 0x4eba, 0x985e, 0x6d3b, 0x52d5, 0x6578, 0x64da, 0xff0c, 0x9810+        , 0x6e2c, 0x672a, 0x4f86, 0x8d70, 0x5411, 0xff0c, 0x898f, 0x6a21+        , 0x4e00, 0x65e6, 0x5c0f, 0x65bc, 0x4e00, 0x9846, 0x661f, 0x7403+        , 0x6216, 0x662f, 0x4e00, 0x5ea7, 0x5e1d, 0x570b, 0xff0c, 0x7d50+        , 0x679c, 0x5c31, 0x6703, 0x5931, 0x6e96, 0x3002, 0x8b1d, 0x9813+        , 0x904b, 0x7528, 0x6b64, 0x4e00, 0x79d1, 0x5b78, 0xff0c, 0x9810+        , 0x898b, 0x9280, 0x6cb3, 0x5e1d, 0x570b, 0x7684, 0x6b9e, 0x843d+        , 0xff0c, 0x6574, 0x7247, 0x9280, 0x6cb3, 0x5c07, 0x56e0, 0x6b64+        , 0x9032, 0x5165, 0x9577, 0x9054, 0x4e09, 0x842c, 0x5e74, 0x7684+        , 0x9ed1, 0x6697, 0x6642, 0x671f, 0xff0c, 0x76f4, 0x5230, 0x7b2c+        , 0x4e8c, 0x5e1d, 0x570b, 0x5efa, 0x7acb, 0x3002, 0x000a, 0x000a+        , 0x65bc, 0x662f, 0x8b1d, 0x9813, 0x5efa, 0x7acb, 0x5169, 0x5ea7+        , 0x57fa, 0x5730, 0xff0c, 0x85c9, 0x4ee5, 0x7e2e, 0x6e1b, 0x883b+        , 0x8352, 0x6642, 0x671f, 0xff0c, 0x4e00, 0x5ea7, 0x9060, 0x5728+        , 0x908a, 0x9672, 0xff0c, 0x662f, 0x85dd, 0x8853, 0x8207, 0x79d1+        , 0x5b78, 0x7684, 0x907f, 0x98a8, 0x6e2f, 0xff0c, 0x76f8, 0x5c0d+        , 0x7684, 0x53e6, 0x4e00, 0x5ea7, 0x5247, 0x5728, 0x201c, 0x7fa4+        , 0x661f, 0x7684, 0x76e1, 0x982d, 0x201d, 0x3002, 0x300c, 0x57fa+        , 0x5730, 0x4e09, 0x90e8, 0x66f2, 0x300d, 0x7684, 0x4e3b, 0x8981+        , 0x7126, 0x9ede, 0x5c31, 0x5728, 0x7aef, 0x9ede, 0x661f, 0x4e0a+        , 0x7684, 0x57fa, 0x5730, 0x3002, 0x7aef, 0x9ede, 0x661f, 0x4e0a+        , 0x7684, 0x5b78, 0x8005, 0x70ba, 0x4e86, 0x6436, 0x5728, 0x8870+        , 0x9000, 0x671f, 0x4e4b, 0x524d, 0xff0c, 0x4fdd, 0x5b58, 0x4eba+        , 0x985e, 0x7269, 0x7406, 0x79d1, 0x5b78, 0x7684, 0x77e5, 0x8b58+        , 0xff0c, 0x52aa, 0x529b, 0x7de8, 0x8f2f, 0x8457, 0x4e00, 0x90e8+        , 0x5168, 0x65b9, 0x4f4d, 0x7684, 0x300a, 0x94f6, 0x6cb3, 0x767e+        , 0x79d1, 0x5168, 0x4e66, 0x300b, 0xff0c, 0x5c0d, 0x8b1d, 0x9813+        , 0x771f, 0x6b63, 0x7684, 0x610f, 0x5716, 0x6beb, 0x4e0d, 0x77e5+        , 0x60c5, 0xff08, 0x5982, 0x679c, 0x4ed6, 0x5011, 0x77e5, 0x9053+        , 0xff0c, 0x5c31, 0x6703, 0x7522, 0x751f, 0x7121, 0x6cd5, 0x63a7+        , 0x5236, 0x7684, 0x8b8a, 0x6578, 0xff09, 0x3002, 0x57fa, 0x5730+        , 0x7684, 0x4f4d, 0x7f6e, 0x4e5f, 0x662f, 0x523b, 0x610f, 0x9078+        , 0x5b9a, 0x7684, 0xff0c, 0x5343, 0x5e74, 0x5f8c, 0x5c31, 0x662f+        , 0x7b2c, 0x4e8c, 0x5e1d, 0x570b, 0x7684, 0x9996, 0x90fd, 0xff08+        , 0x4e26, 0x975e, 0x4e09, 0x842c, 0x5e74, 0x5f8c, 0x7684, 0x90a3+        , 0x500b, 0x5e1d, 0x570b, 0xff09, 0x000a+        ]
+ tests/ForeignUtils.hs view
@@ -0,0 +1,26 @@+module ForeignUtils+    ( Ptr+    , Storable+    , createPtr+    , free+    ) where++import           Foreign.Marshal.Alloc++import           Foreign.Ptr+import           Foreign.Storable+import           Foundation+import           Prelude (length, head, zip, null)+import           Control.Monad (forM_)++import           Foundation.Foreign++createPtr :: Storable e => [e] -> IO (FinalPtr e)+createPtr l+    | null l    = toFinalPtr nullPtr (\_ -> return ())+    | otherwise = do+        let szElem = sizeOf (head l)+            nbBytes = szElem * length l+        ptr <- mallocBytes nbBytes+        forM_ (zip [0..] l) $ \(o, e) -> pokeElemOff ptr o e+        toFinalPtr ptr (\p -> free p)
+ tests/Tests.hs view
@@ -0,0 +1,571 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+module Main where++import           Test.Tasty+--import           Test.Tasty.Options+import           Control.Monad+import           Test.QuickCheck.Monadic+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck++import           Foundation+import           Foundation.Array+import           Foundation.Collection+import           Foundation.Foreign+import           Foundation.String+import           Foundation.VFS                (Path (..), filename, parent)+import           Foundation.VFS.FilePath+import qualified Data.List               as L+import qualified Prelude++import           ForeignUtils+import           Encoding++data Unicode = Unicode { unUnicode :: LString }+    deriving (Show)++data Split = Split Unicode Char+    deriving (Show)++data CharMap = CharMap Unicode Prelude.Int+    deriving (Show)++addChar :: Prelude.Int -> Char -> Char+addChar n c = toEnum ((fromEnum c + n) `Prelude.mod` 0x10ffff)++--instance Show Unicode where+--    show = unUnicode+--+data ListElement a = ListElement [a]++--instance Element a => Arbitrary ListElement where++-- | A better version of arbitrary for Char+arbitraryChar :: Gen Char+arbitraryChar =+    toEnum <$> oneof [choose (1, 0xff), choose (0x100, 0x1000), choose (0x100, 0x10000), choose (0x1, 0x1000)]++instance Arbitrary Unicode where+    arbitrary = do+        n <- choose (0,49)+        oneof+            [ Unicode <$> replicateM n (toEnum <$> choose (1, 0xff))+            , Unicode <$> replicateM n (toEnum <$> choose (0x100, 0x1000))+            , Unicode <$> replicateM n (toEnum <$> choose (0x100, 0x10000))+            , Unicode <$> replicateM n (toEnum <$> choose (0x1, 0x1000))+            ]++instance Arbitrary Split where+    arbitrary = do+        ch <- oneof [ toEnum <$> choose (0,0x7f), toEnum <$> choose (0x100, 0x10000) ]+        l <- choose (0,4) >>= \n -> fmap unUnicode <$> replicateM n arbitrary+        return (Split (Unicode $ L.intercalate [ch] l) ch)++instance Arbitrary CharMap where+    arbitrary =+        CharMap <$> arbitrary <*> choose (1,12)++instance Arbitrary FileName where+    arbitrary = do+        s <- choose (1, 30)+        unsafeFileName . fromList <$> vectorOf s genChar+      where+        genChar :: Gen Word8+        genChar = frequency+                    [ (10, pure 0x2e) -- '.'+                    , (10, choose (0x41, 0x5A)) -- [A-Z]+                    , (10, choose (0x61, 0x7A)) -- [a-z]+                    , (5, choose (0x30, 0x39)) -- [a-z]+                    , (5, elements [0x2d, 0x5f]) -- [-_]+                    ]++instance Arbitrary Relativity where+    arbitrary = elements [ Absolute, Relative ]++instance Arbitrary FilePath where+    arbitrary = do+        s <- choose (0, 10)+        unsafeFilePath <$> arbitrary+                       <*> vectorOf s arbitrary++transEq :: Eq a => (t -> t1) -> (t1 -> a) -> (t1 -> a) -> t -> Bool+transEq unWrap f g s =+    let s' = unWrap s in f s' == g s'++--stringEq :: Eq a => (b -> a) -> (String -> b) -> (LString -> a) -> Unicode -> Bool+--stringEq back f g s =++assertEq :: (Eq a, Show a) => a -> a -> Bool+assertEq got expected+    | got == expected = True+    | otherwise       = error ("got: " <> show got <> " expected: " <> show expected)++listOfElement :: Gen e -> Gen [e]+listOfElement e = choose (0,49) >>= flip replicateM e++listOfElementMaxN :: Int -> Gen e -> Gen [e]+listOfElementMaxN n e = choose (0,n) >>= flip replicateM e++-- | Set in front of tests to make them verbose+qcv :: TestTree -> TestTree+qcv = adjustOption (\(QuickCheckVerbose _) -> QuickCheckVerbose True)++-- | Set the number of tests+qcnSet :: Int -> TestTree -> TestTree+qcnSet n = adjustOption (\(QuickCheckTests _) -> QuickCheckTests n)++-- | Scale the number of tests+qcnScale :: Int -> TestTree -> TestTree+qcnScale n = adjustOption (\(QuickCheckTests actual) -> QuickCheckTests (actual * n))++testEq :: (Show e, Eq e, Eq a, Element a ~ e, IsList a, Item a ~ Element a) => Proxy a -> Gen e -> [TestTree]+testEq proxy genElement =+    [ testProperty "x == x" $ withElements $ \l -> let col = fromListP proxy l in col == col+    , testProperty "x == y" $ with2Elements $ \(l1, l2) ->+        (fromListP proxy l1 == fromListP proxy l2) == (l1 == l2)+    ]+  where+    withElements f = forAll (listOfElement genElement) f+    with2Elements f = forAll ((,) <$> listOfElement genElement <*> listOfElement genElement) f++testOrd :: (Show e, Ord a, Ord e, Element a ~ e, IsList a, Item a ~ Element a) => Proxy a -> Gen e -> [TestTree]+testOrd proxy genElement =+    [ testProperty "x `compare` y" $ with2Elements $ \(l1, l2) ->+        (fromListP proxy l1 `compare` fromListP proxy l2) == (l1 `compare` l2)+    ]+  where+    with2Elements f = forAll ((,) <$> listOfElement genElement <*> listOfElement genElement) f++testMonoid :: (Show a, Show e, Ord a, Ord e, Monoid a, Element a ~ e, IsList a, Item a ~ Element a) => Proxy a -> Gen e -> [TestTree]+testMonoid proxy genElement =+    testEq proxy genElement <>+    testOrd proxy genElement <>+    --[ testProperty "mempty <> mempty == mempty" $ \l ->+    [ testProperty "mempty <> x == x" $ withElements $ \l -> let col = fromListP proxy l in (col <> mempty) === col+    , testProperty "x <> mempty == x" $ withElements $ \l -> let col = fromListP proxy l in (mempty <> col) === col+    , testProperty "x1 <> x2 == x1|x2" $ with2Elements $ \(l1,l2) ->+        (fromListP proxy l1 <> fromListP proxy l2) === fromListP proxy (l1 <> l2)+    , testProperty "mconcat [map fromList [e]] = fromList (concat [e])" $ withNElements $ \l ->+        mconcat (fmap (fromListP proxy) l) === fromListP proxy (mconcat l)+    ]+  where+    withElements f = forAll (listOfElement genElement) f+    with2Elements f = forAll ((,) <$> listOfElement genElement <*> listOfElement genElement) f+    withNElements f = forAll (listOfElementMaxN 5 (listOfElement genElement)) f++testCollectionProps :: (Show a, Sequential a, Eq a, e ~ Item a) => Proxy a -> Gen e -> [TestTree]+testCollectionProps proxy genElement =+    [ testProperty "splitAt == (take, drop)" $ withCollection2 $ \(col, n) ->+        splitAt n col == (take n col, drop n col)+    , testProperty "revSplitAt == (revTake, revDrop)" $ withCollection2 $ \(col, n) ->+        revSplitAt n col == (revTake n col, revDrop n col)+    ]+  where+    withCollection2 f = forAll ((,) <$> (fromListP proxy <$> listOfElement genElement) <*> arbitrary) f++testCaseFilePath :: [TestTree]+testCaseFilePath = Prelude.map (makeTestCases . (\x -> (show x, x)))+    [ "/"+    , "."+    , ".."+    , "C:" </> "Users" </> "haskell-lang"+    , "/home"+    , "/home" </> "haskell-lang" </> "new hope" </> "foundation"+    , "~" </> "new hope" </> "foundation"+    , "new hope" </> "foundation"+    , "new hope" </> "foundation" </> ".."+    , "." </> "new hope" </> ".." </> ".." </> "haskell-lang" </> "new hope"+    ]+  where+    makeTestCases :: ([Char], FilePath) -> TestTree+    makeTestCases (title, p) = testGroup title+        [ testCase "buildPath . splitPath == id)" $ assertBuildSplitIdemPotent p+        , testCase "p == (parent p </> filename p)" $ assertParentFilenameIdemPotent p+        ]++    assertParentFilenameIdemPotent :: FilePath -> Assertion+    assertParentFilenameIdemPotent p =+      unless (assertEq (parent p </> filename p) p) $+         error "assertion failed"+    assertBuildSplitIdemPotent :: FilePath -> Assertion+    assertBuildSplitIdemPotent p =+      unless (assertEq (buildPath $ splitPath p) p) $+         error "assertion failed"++testPath :: (Path path, Show path, Eq path)+         => Gen path+         -> [TestTree]+testPath genElement =+    [ testProperty "buildPath . splitPath == id" $ withElements $ \l -> (buildPath $ splitPath l) === l+    ]+  where+    withElements f = forAll genElement f++testCollection :: (Sequential a, Show a, Show (Element a), Eq (Element a), Ord a, Ord (Item a))+               => Proxy a -> Gen (Element a) -> [TestTree]+testCollection proxy genElement =+    testMonoid proxy genElement <>+    [ testProperty "c == [Element(c)]" $ withElements $ \l -> (toList $ fromListP proxy l) === l+    , testProperty "length" $ withElements $ \l -> (length $ fromListP proxy l) === length l+    , testProperty "take" $ withElements2 $ \(l, n) -> toList (take n $ fromListP proxy l) === (take n) l+    , testProperty "drop" $ withElements2 $ \(l, n) -> toList (drop n $ fromListP proxy l) === (drop n) l+    , testProperty "splitAt" $ withElements2 $ \(l, n) -> toList2 (splitAt n $ fromListP proxy l) === (splitAt n) l+    , testProperty "revTake" $ withElements2 $ \(l, n) -> toList (revTake n $ fromListP proxy l) === (revTake n) l+    , testProperty "revDrop" $ withElements2 $ \(l, n) -> toList (revDrop n $ fromListP proxy l) === (revDrop n) l+    , testProperty "revSplitAt" $ withElements2 $ \(l, n) -> toList2 (revSplitAt n $ fromListP proxy l) === (revSplitAt n) l+    , testProperty "break" $ withElements2E $ \(l, c) -> toList2 (break (== c) $ fromListP proxy l) === (break (== c)) l+    , testProperty "breakElem" $ withElements2E $ \(l, c) -> toList2 (breakElem c $ fromListP proxy l) === (breakElem c) l+    , testProperty "snoc" $ withElements2E $ \(l, c) -> toList (snoc (fromListP proxy l) c) === (l <> [c])+    , testProperty "cons" $ withElements2E $ \(l, c) -> toList (cons c (fromListP proxy l)) === (c : l)+    , testProperty "unsnoc" $ withElements $ \l -> fmap toListFirst (unsnoc (fromListP proxy l)) === unsnoc l+    , testProperty "uncons" $ withElements $ \l -> fmap toListSecond (uncons (fromListP proxy l)) === uncons l+    , testProperty "splitOn" $ withElements2E $ \(l, ch) ->+         fmap toList (splitOn (== ch) (fromListP proxy l)) === splitOn (== ch) l+    , testProperty "intersperse" $ withElements2E $ \(l, c) ->+        toList (intersperse c (fromListP proxy l)) === intersperse c l+    , testProperty "intercalate" $ withElements2E $ \(l, c) ->+        let ls = Prelude.replicate 5 l+            cs = Prelude.replicate 5 c+        in toList (intercalate (fromListP proxy cs) (fromListP proxy <$> ls)) === intercalate cs ls+    , testProperty "sortBy" $ withElements $ \l ->+        (sortBy compare $ fromListP proxy l) === fromListP proxy (sortBy compare l)+    , testProperty "reverse" $ withElements $ \l ->+        (reverse $ fromListP proxy l) === fromListP proxy (reverse l)+    -- stress slicing+    , testProperty "take . take" $ withElements3 $ \(l, n1, n2) -> toList (take n2 $ take n1 $ fromListP proxy l) === (take n2 $ take n1 l)+    , testProperty "drop . take" $ withElements3 $ \(l, n1, n2) -> toList (drop n2 $ take n1 $ fromListP proxy l) === (drop n2 $ take n1 l)+    , testProperty "drop . drop" $ withElements3 $ \(l, n1, n2) -> toList (drop n2 $ drop n1 $ fromListP proxy l) === (drop n2 $ drop n1 l)+    , testProperty "drop . take" $ withElements3 $ \(l, n1, n2) -> toList (drop n2 $ take n1 $ fromListP proxy l) === (drop n2 $ take n1 l)+    , testProperty "second take . splitAt" $ withElements3 $ \(l, n1, n2) ->+        (toList2 $ (second (take n1) . splitAt n2) $ fromListP proxy l) === (second (take n1) . splitAt n2) l+    ]+    <> testCollectionProps proxy genElement+{-+    , testProperty "imap" $ \(CharMap (Unicode u) i) ->+        (imap (addChar i) (fromList u) :: String) `assertEq` fromList (Prelude.map (addChar i) u)+    ]+-}+  where+    toList2 (x,y) = (toList x, toList y)+    toListFirst (x,y) = (toList x, y)+    toListSecond (x,y) = (x, toList y)+    withElements f = forAll (listOfElement genElement) f+    withElements2 f = forAll ((,) <$> listOfElement genElement <*> arbitrary) f+    withElements3 f = forAll ((,,) <$> listOfElement genElement <*> arbitrary <*> arbitrary) f+    withElements2E f = forAll ((,) <$> listOfElement genElement <*> genElement) f++testBoxedZippable :: ( Eq (Element col) , Show (Item a), Show (Item b)+                     , BoxedZippable col, Zippable a, Zippable b+                     , Element col ~ (Item a, Item b) )+                  => Proxy a -> Proxy b -> Proxy col -> Gen (Element a) -> Gen (Element b) -> [TestTree]+testBoxedZippable proxyA proxyB proxyCol genElementA genElementB =+    [ testProperty "zip" $ withList2 $ \(as, bs) ->+        toListP proxyCol (zip (fromListP proxyA as) (fromListP proxyB bs)) == zip as bs+    , testProperty "zip . unzip == id" $ withListOfTuples $ \xs ->+        let (as, bs) = unzip (fromListP proxyCol xs)+        in toListP proxyCol (zip (as `asProxyTypeOf` proxyA) (bs `asProxyTypeOf` proxyB)) == xs+    ]+  where+    withList2 = forAll ((,) <$> listOfElement genElementA <*> listOfElement genElementB)+    withListOfTuples = forAll (listOfElement ((,) <$> genElementA <*> genElementB))++testZippable :: ( Eq (Element col), Show (Item col), Show (Item a), Show (Item b)+                , Zippable col, Zippable a, Zippable b )+             => Proxy a -> Proxy b -> Proxy col -> Gen (Element a) -> Gen (Element b) -> Gen (Element col) -> [TestTree]+testZippable proxyA proxyB proxyCol genElementA genElementB genElementCol =+    [ testProperty "zipWith" $ withList2AndE $ \(as, bs, c) ->+        toListP proxyCol (zipWith (const (const c)) (fromListP proxyA as) (fromListP proxyB bs)+            ) == Prelude.replicate (Prelude.min (length as) (length bs)) c+    ]+  where+    withList2AndE = forAll ( (,,) <$> listOfElement genElementA <*> listOfElement genElementB+                                  <*> genElementCol )++testZippableProps :: (Eq (Item a), Eq (Item b), Show (Item a), Show (Item b), Zippable a, Zippable b)+                  => Proxy a -> Proxy b -> Gen (Element a) -> Gen (Element b) -> [TestTree]+testZippableProps proxyA proxyB genElementA genElementB =+    [ testProperty "zipWith ⊥ [] xs == []" $ withList $ \as ->+        toListP proxyA (zipWith undefined [] (fromListP proxyA as)) == []+    , testProperty "zipWith f a b == zipWith (flip f) b a" $ withList2 $ \(as, bs) ->+        let f = ignore1+            as' = fromListP proxyA as+            bs' = fromListP proxyB bs+        in toListP proxyB (zipWith f as' bs')+            == toListP proxyB (zipWith (flip f) bs' as')+    , testProperty "zipWith3 f […] xs == zipWith id (zipWith f […]) xs)" $ withList2 $ \(as, bs) ->+        let f = ignore2+            as' = fromListP proxyA as+            bs' = fromListP proxyB bs+        in toListP proxyB (zipWith3 f as' as' bs')+            == Prelude.zipWith id (zipWith f as as) bs+    , testProperty "zipWith4 f […] xs == zipWith id (zipWith3 f […]) xs)" $ withList2 $ \(as, bs) ->+        let f = ignore3+            as' = fromListP proxyA as+            bs' = fromListP proxyB bs+        in toListP proxyB (zipWith4 f as' as' as' bs')+            == Prelude.zipWith id (zipWith3 f as as as) bs+    , testProperty "zipWith5 f […] xs == zipWith id (zipWith4 f […]) xs)" $ withList2 $ \(as, bs) ->+        let f = ignore4+            as' = fromListP proxyA as+            bs' = fromListP proxyB bs+        in toListP proxyB (zipWith5 f as' as' as' as' bs')+            == Prelude.zipWith id (zipWith4 f as as as as) bs+    , testProperty "zipWith6 f […] xs == zipWith id (zipWith5 f […]) xs)" $ withList2 $ \(as, bs) ->+        let f = ignore5+            as' = fromListP proxyA as+            bs' = fromListP proxyB bs+        in toListP proxyB (zipWith6 f as' as' as' as' as' bs')+            == Prelude.zipWith id (zipWith5 f as as as as as) bs+    , testProperty "zipWith7 f […] xs == zipWith id (zipWith6 f […]) xs)" $ withList2 $ \(as, bs) ->+        let f = ignore6+            as' = fromListP proxyA as+            bs' = fromListP proxyB bs+        in toListP proxyB (zipWith7 f as' as' as' as' as' as' bs')+            == Prelude.zipWith id (zipWith6 f as as as as as as) bs+    ]+  where+    -- ignore the first n arguments+    ignore1 = flip const+    ignore2 = const . ignore1+    ignore3 = const . ignore2+    ignore4 = const . ignore3+    ignore5 = const . ignore4+    ignore6 = const . ignore5+    withList  = forAll (listOfElement genElementA)+    withList2 = forAll ((,) <$> listOfElement genElementA <*> listOfElement genElementB)++testUnboxedForeign :: (PrimType e, Show e, Element a ~ e, Storable e)+                   => Proxy a -> Gen e -> [TestTree]+testUnboxedForeign proxy genElement =+    [ testProperty "equal" $ withElementsM $ \fptr l ->+        return $ toArrayP proxy l == foreignMem fptr (length l)+    , testProperty "take" $ withElementsM $ \fptr l -> do+        n <- pick arbitrary+        return $ take n (toArrayP proxy l) == take n (foreignMem fptr (length l))+    , testProperty "take" $ withElementsM $ \fptr l -> do+        n <- pick arbitrary+        return $ drop n (toArrayP proxy l) == drop n (foreignMem fptr (length l))+    ]+  where+    withElementsM f = monadicIO $ forAllM (listOfElement genElement) $ \l -> run (createPtr l) >>= \fptr -> f fptr l+    toArrayP :: PrimType (Element c) => Proxy c -> [Element c] -> UArray (Element c)+    toArrayP _ l = fromList l++fromListP :: (IsList c, Item c ~ Element c) => Proxy c -> [Element c] -> c+fromListP p = \x -> asProxyTypeOf (fromList x) p++toListP :: (IsList c, Item c ~ Element c) => Proxy c -> c -> [Element c]+toListP p x = toList (asProxyTypeOf x p)++data RandomList = RandomList [Int]+    deriving (Show,Eq)++instance Arbitrary RandomList where+    arbitrary = RandomList <$> (choose (100,400) >>= flip replicateM (choose (0,8)))++chunks :: Sequential c => RandomList -> c -> [c]+chunks (RandomList randomInts) = loop (randomInts <> [1..])+  where+    loop rx c+        | null c  = []+        | otherwise =+            case rx of+                r:rs ->+                    let (c1,c2) = splitAt r c+                     in c1 : loop rs c2+                [] ->+                    loop randomInts c+++testStringCases :: [TestTree]+testStringCases =+    [ testGroup "Validation"+        [ testProperty "fromBytes . toBytes == valid" $ \(Unicode l) ->+            let s = fromList l+             in (fromBytes UTF8 $ toBytes UTF8 s) === (s, Nothing, mempty)+        , testProperty "Streaming" $ \(Unicode l, randomInts) ->+            let wholeS  = fromList l+                wholeBA = toBytes UTF8 wholeS+                reconstruct (prevBa, errs, acc) ba =+                    let ba' = prevBa `mappend` ba+                        (s, merr, nextBa) = fromBytes UTF8 ba'+                     in (nextBa, merr : errs, s : acc)++                (remainingBa, allErrs, chunkS) = foldl reconstruct (mempty, [], []) $ chunks randomInts wholeBA+             in (catMaybes allErrs === []) .&&. (remainingBa === mempty) .&&. (mconcat (reverse chunkS) === wholeS)+        ]+    , testGroup "Cases"+        [ testGroup "Invalid-UTF8"+            [ testCase "ff" $ expectFromBytesErr ("", Just InvalidHeader, 0) (fromList [0xff])+            , testCase "80" $ expectFromBytesErr ("", Just InvalidHeader, 0) (fromList [0x80])+            , testCase "E2 82 0C" $ expectFromBytesErr ("", Just InvalidContinuation, 0) (fromList [0xE2,0x82,0x0c])+            , testCase "30 31 E2 82 0C" $ expectFromBytesErr ("01", Just InvalidContinuation, 2) (fromList [0x30,0x31,0xE2,0x82,0x0c])+            ]+        ]+    ]+  where+    expectFromBytesErr (expectedString,expectedErr,positionErr) ba = do+        let (s', merr, ba') = fromBytes UTF8 ba+        assertEqual "error" expectedErr merr+        assertEqual "remaining" (drop positionErr ba) ba'+        assertEqual "string" expectedString (toList s')++tests :: [TestTree]+tests =+    [ testGroup "Array"+        [ testGroup "Unboxed"+            [ testGroup "UArray(W8)"  (testCollection (Proxy :: Proxy (UArray Word8))  arbitrary)+            , testGroup "UArray(W16)" (testCollection (Proxy :: Proxy (UArray Word16)) arbitrary)+            , testGroup "UArray(W32)" (testCollection (Proxy :: Proxy (UArray Word32)) arbitrary)+            , testGroup "UArray(W64)" (testCollection (Proxy :: Proxy (UArray Word64)) arbitrary)+            , testGroup "UArray(I8)"  (testCollection (Proxy :: Proxy (UArray Int8))   arbitrary)+            , testGroup "UArray(I16)" (testCollection (Proxy :: Proxy (UArray Int16))  arbitrary)+            , testGroup "UArray(I32)" (testCollection (Proxy :: Proxy (UArray Int32))  arbitrary)+            , testGroup "UArray(I64)" (testCollection (Proxy :: Proxy (UArray Int64))  arbitrary)+            , testGroup "UArray(F32)" (testCollection (Proxy :: Proxy (UArray Float))  arbitrary)+            , testGroup "UArray(F64)" (testCollection (Proxy :: Proxy (UArray Double)) arbitrary)+            ]+        , testGroup "Unboxed-Foreign"+            [ testGroup "UArray(W8)"  (testUnboxedForeign (Proxy :: Proxy (UArray Word8))  arbitrary)+            , testGroup "UArray(W16)" (testUnboxedForeign (Proxy :: Proxy (UArray Word16)) arbitrary)+            , testGroup "UArray(W32)" (testUnboxedForeign (Proxy :: Proxy (UArray Word32)) arbitrary)+            , testGroup "UArray(W64)" (testUnboxedForeign (Proxy :: Proxy (UArray Word64)) arbitrary)+            , testGroup "UArray(I8)"  (testUnboxedForeign (Proxy :: Proxy (UArray Int8))   arbitrary)+            , testGroup "UArray(I16)" (testUnboxedForeign (Proxy :: Proxy (UArray Int16))  arbitrary)+            , testGroup "UArray(I32)" (testUnboxedForeign (Proxy :: Proxy (UArray Int32))  arbitrary)+            , testGroup "UArray(I64)" (testUnboxedForeign (Proxy :: Proxy (UArray Int64))  arbitrary)+            , testGroup "UArray(F32)" (testUnboxedForeign (Proxy :: Proxy (UArray Float))  arbitrary)+            , testGroup "UArray(F64)" (testUnboxedForeign (Proxy :: Proxy (UArray Double)) arbitrary)+            ]+        , testGroup "Boxed"+            [ testGroup "Array(W8)"  (testCollection (Proxy :: Proxy (Array Word8))  arbitrary)+            , testGroup "Array(W16)" (testCollection (Proxy :: Proxy (Array Word16)) arbitrary)+            , testGroup "Array(W32)" (testCollection (Proxy :: Proxy (Array Word32)) arbitrary)+            , testGroup "Array(W64)" (testCollection (Proxy :: Proxy (Array Word64)) arbitrary)+            , testGroup "Array(I8)"  (testCollection (Proxy :: Proxy (Array Int8))   arbitrary)+            , testGroup "Array(I16)" (testCollection (Proxy :: Proxy (Array Int16))  arbitrary)+            , testGroup "Array(I32)" (testCollection (Proxy :: Proxy (Array Int32))  arbitrary)+            , testGroup "Array(I64)" (testCollection (Proxy :: Proxy (Array Int64))  arbitrary)+            , testGroup "Array(F32)" (testCollection (Proxy :: Proxy (Array Float))  arbitrary)+            , testGroup "Array(F64)" (testCollection (Proxy :: Proxy (Array Double)) arbitrary)+            , testGroup "Array(Int)" (testCollection (Proxy :: Proxy (Array Int))  arbitrary)+            , testGroup "Array(Int,Int)" (testCollection (Proxy :: Proxy (Array (Int,Int)))  arbitrary)+            , testGroup "Array(Integer)" (testCollection (Proxy :: Proxy (Array Integer)) arbitrary)+            ]+        , testGroup "Bitmap"  (testCollection (Proxy :: Proxy (Bitmap))  arbitrary)+        ]+    , testGroup "String"+        (  testCollection (Proxy :: Proxy String) arbitraryChar+        <> testStringCases+        <> [ testGroup "Encoding Sample0" (testEncodings sample0)+           , testGroup "Encoding Sample1" (testEncodings sample1)+           , testGroup "Encoding Sample2" (testEncodings sample2)+           ]+        )+    , testGroup "VFS"+        [ testGroup "FilePath" $ testCaseFilePath <> (testPath (arbitrary :: Gen FilePath))+        ]+    , testGroup "Number"+        [ testGroup "Precedence"+            [ testProperty "+ and - (1)" $ \a (b :: Int) (c :: Int) -> (a + b - c) === ((a + b) - c)+            , testProperty "+ and - (2)" $ \a (b :: Int) (c :: Int) -> (a - b + c) === ((a - b) + c)+            , testProperty "+ and * (1)" $ \a b (c :: Int) -> (a + b * c) === (a + (b * c))+            , testProperty "+ and * (2)" $ \a b (c :: Int) -> (a * b + c) === ((a * b) + c)+            , testProperty "- and * (1)" $ \a b (c :: Int) -> (a - b * c) === (a - (b * c))+            , testProperty "- and * (2)" $ \a b (c :: Int) -> (a * b - c) === ((a * b) - c)+            , testProperty "* and ^ (1)" $ \a (Positive b :: Positive Int) (c :: Int) -> (a ^ b * c) === ((a ^ b) * c)+            , testProperty "* and ^ (2)" $ \a (b :: Int) (Positive c :: Positive Int) -> (a * b ^ c) === (a * (b ^ c))+            ]+        ]+    , testGroup "ModifiedUTF8"+        [ testCase "The foundation Serie" $ testCaseModifiedUTF8 "基地系列" "基地系列"+        , testCase "has null bytes" $ testCaseModifiedUTF8 "let's\0 do \0 it" "let's\0 do \0 it"+        , testCase "Vincent's special" $ testCaseModifiedUTF8 "abc\0안, 蠀\0, ☃" "abc\0안, 蠀\0, ☃"+        , testCase "Long string" $ testCaseModifiedUTF8+              "this is only a simple string but quite longer than the 64 bytes used in the modified UTF8 parser"+              "this is only a simple string but quite longer than the 64 bytes used in the modified UTF8 parser"+        ]+    , testGroup "BoxedZippable"+        [ testGroup "Array"+            [ testGroup "from Array Int"+                ( testBoxedZippable+                    (Proxy :: Proxy (Array Int)) (Proxy :: Proxy (Array Int))+                    (Proxy :: Proxy (Array (Int, Int))) arbitrary arbitrary )+            , testGroup "from String"+                ( testBoxedZippable+                    (Proxy :: Proxy String) (Proxy :: Proxy String)+                    (Proxy :: Proxy (Array (Char, Char))) arbitrary arbitrary )+            , testGroup "from String and Array Char"+                ( testBoxedZippable+                    (Proxy :: Proxy String) (Proxy :: Proxy (Array Char))+                    (Proxy :: Proxy (Array (Char, Char))) arbitrary arbitrary )+            , testGroup "from Array Int and Array Char"+                ( testBoxedZippable+                    (Proxy :: Proxy (Array Int)) (Proxy :: Proxy (Array Char))+                    (Proxy :: Proxy (Array (Int, Char))) arbitrary arbitrary )+            ]+        ]+    , testGroup "Zippable"+        [ testGroup "String"+            [ testGroup "from String"+                ( testZippable+                    (Proxy :: Proxy String) (Proxy :: Proxy String)+                    (Proxy :: Proxy String) arbitrary arbitrary arbitrary )+            , testGroup "from Array Char"+                ( testZippable+                    (Proxy :: Proxy (Array Char)) (Proxy :: Proxy (Array Char))+                    (Proxy :: Proxy String) arbitrary arbitrary arbitrary )+            , testGroup "from UArray Word8 and Array Int"+                ( testZippable+                    (Proxy :: Proxy (UArray Word8)) (Proxy :: Proxy (Array Int))+                    (Proxy :: Proxy String) arbitrary arbitrary arbitrary )+            ]+        , testGroup "Array"+            [ testGroup "from String"+                ( testZippable+                    (Proxy :: Proxy String) (Proxy :: Proxy String)+                    (Proxy :: Proxy (Array Int)) arbitrary arbitrary arbitrary )+            , testGroup "from Array Char"+                ( testZippable+                    (Proxy :: Proxy (Array Char)) (Proxy :: Proxy (Array Char))+                    (Proxy :: Proxy (Array Char)) arbitrary arbitrary arbitrary )+            , testGroup "from UArray Word8 and Array Int"+                ( testZippable+                    (Proxy :: Proxy (UArray Word8)) (Proxy :: Proxy (Array Int))+                    (Proxy :: Proxy (Array Int)) arbitrary arbitrary arbitrary )+            ]+        , testGroup "UArray"+            [ testGroup "from String"+                ( testZippable+                    (Proxy :: Proxy String) (Proxy :: Proxy String)+                    (Proxy :: Proxy (UArray Word8)) arbitrary arbitrary arbitrary )+            , testGroup "from Array Char"+                ( testZippable+                    (Proxy :: Proxy (Array Char)) (Proxy :: Proxy (Array Char))+                    (Proxy :: Proxy (UArray Word16)) arbitrary arbitrary arbitrary )+            , testGroup "from UArray Word8 and Array Int"+                ( testZippable+                    (Proxy :: Proxy (UArray Word8)) (Proxy :: Proxy (Array Int))+                    (Proxy :: Proxy (UArray Word32)) arbitrary arbitrary arbitrary )+            ]+        , testGroup "Properties"+            ( testZippableProps (Proxy :: Proxy (Array Int)) (Proxy :: Proxy (Array Char))+                arbitrary arbitrary )+        ]+    ]++testCaseModifiedUTF8 :: [Char] -> String -> Assertion+testCaseModifiedUTF8 ghcStr str+    | ghcStr == fStr = return ()+    | otherwise      = assertFailure $+        "expecting: " <> show ghcStr <> " received: " <> show fStr+  where+    fStr :: [Char]+    fStr = toList str++main :: IO ()+main = defaultMain $ testGroup "foundation" tests