massiv-serialise (empty) → 0.1.0.0
raw patch · 11 files changed
+461/−0 lines, 11 filesdep +QuickCheckdep +basedep +deepseqsetup-changed
Dependencies added: QuickCheck, base, deepseq, doctest, hspec, massiv, massiv-serialise, massiv-test, serialise, vector
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +6/−0
- massiv-serialise.cabal +77/−0
- src/Massiv/Serialise.hs +190/−0
- tests/Common.hs +6/−0
- tests/Main.hs +11/−0
- tests/Spec.hs +1/−0
- tests/Test/Massiv/SerialiseSpec.hs +112/−0
- tests/doctests.hs +17/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog for `massiv-serialise`++## 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexey Kuleshevich (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Alexey Kuleshevich nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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,6 @@+# massiv-serialise++Orphan `Serialise` class instances from+[serialise](https://hackage.haskell.org/package/serialise) package that allow+serialization of arrays defined in [`massiv`](https://hackage.haskell.org/package/massiv)+package.
+ Setup.hs view
@@ -0,0 +1,6 @@+import Distribution.Simple++main :: IO ()+main = defaultMain+#endif+
+ massiv-serialise.cabal view
@@ -0,0 +1,77 @@+name: massiv-serialise+version: 0.1.0.0+synopsis: Compatibility of 'massiv' with 'serialise'+description: Orphan 'Serialise' class instances from <https://hackage.haskell.org/package/serialise serialise> package that allow serialization of arrays defined in <https://hackage.haskell.org/package/massiv massiv> package+homepage: https://github.com/lehins/massiv-compat+license: BSD3+license-file: LICENSE+author: Alexey Kuleshevich+maintainer: alexey@kuleshevi.ch+copyright: 2021 Alexey Kuleshevich+category: Algorithms+build-type: Simple+extra-source-files: README.md+ , CHANGELOG.md+cabal-version: 1.18+tested-with: GHC == 8.4.3+ , GHC == 8.4.4+ , GHC == 8.6.3+ , GHC == 8.6.4+ , GHC == 8.6.5+ , GHC == 8.8.1+ , GHC == 8.8.2+ , GHC == 8.10.1++library+ hs-source-dirs: src+ exposed-modules: Massiv.Serialise++ other-modules:+ build-depends: base >= 4.8 && < 5+ , deepseq+ , massiv >= 0.5.0.0+ , serialise >= 0.2.0.0+ , vector++ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs+ other-modules: Common+ , Test.Massiv.SerialiseSpec+ , Spec+ build-tool-depends: hspec-discover:hspec-discover+ build-depends: base >= 4.8 && < 5+ , massiv-serialise+ , massiv-test+ , massiv+ , serialise+ , hspec+ , QuickCheck++ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -fno-warn-orphans+ -threaded+ -with-rtsopts=-N2++test-suite doctests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: doctests.hs+ build-depends: base+ , doctest >=0.15+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/lehins/massiv-compat
+ src/Massiv/Serialise.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Massiv.Serialise+-- Copyright : (c) Alexey Kuleshevich 2021+-- License : BSD3+-- Maintainer : Alexey Kuleshevich <alexey@kuleshevi.ch>+-- Stability : experimental+-- Portability : non-portable+--+-- This package provides instances for `Serialise` class for all mutable `Array`+-- representations in [@massiv@](https://hackage.haskell.org/package/massiv) package. These+-- instances are provided as orphans from a separate package in order to avoid direct+-- dependency on [@serialise@](https://hackage.haskell.org/package/serialise) package in+-- @massiv@.+--+-- Array serialisation is done by falling back onto instances for `VG.Vector` types from+-- [@vector@](https://hackage.haskell.org/package/vector) package.+--+-- Below is a simple example how to use it. Note a blank module import: @import+-- Massiv.Serialise ()@, which is the only thing needed from this module in order to use+-- provided orphan instances.+--+-- >>> import Massiv.Serialise ()+-- >>> import Data.Massiv.Array as A+-- >>> let arr = A.fromList A.Seq [72,97,115,107,101,108,108] :: A.Vector A.P Int+-- >>> serialise arr+-- "\NUL\a\135\CANH\CANa\CANs\CANk\CANe\CANl\CANl"+-- >>> deserialise (serialise arr) :: A.Vector A.P Int+-- Array P Seq (Sz1 7)+-- [ 72, 97, 115, 107, 101, 108, 108 ]+--+module Massiv.Serialise+ ( -- * Helper functions used to define Serialise instances+ encodeIx+ , decodeIx+ , mkSzFail+ , encodeArray+ , decodeArray+ ) where++import Codec.Serialise+import Codec.Serialise.Decoding+import Codec.Serialise.Encoding+import Control.DeepSeq (NFData)+import Control.Monad+import qualified Control.Monad.Fail as Fail+import Data.Foldable as F+import Data.Massiv.Array+import Data.Massiv.Array.Manifest.Vector+import Data.Proxy+import Data.Typeable+import qualified Data.Vector as V+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Primitive as VP+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU++instance Serialise Comp where+ encode comp =+ case comp of+ Seq -> encode (0 :: Int)+ ParOn xs -> encode (1 :: Int) <> encode xs+ ParN n -> encode (2 :: Int) <> encode n+ decode = do+ ty :: Int <- decode+ case ty of+ 0 -> pure Seq+ 1 -> ParOn <$> decode+ 2 -> ParN <$> decode+ n -> Fail.fail $ "Unexpected Comp tag: " <> show n++++-- | Encode index+--+-- @since 0.1.0+encodeIx ::+ forall ix. Index ix+ => ix+ -> Encoding+encodeIx = foldlIndex (\ !acc i -> encode i <> acc) mempty++-- | Decode index+--+-- @since 0.1.0+decodeIx ::+ forall s ix. Index ix+ => Decoder s ix+decodeIx = do+ let decodeDim ix dim = do+ i <- decode+ either (Fail.fail . show) pure $! setDimM ix dim i+ F.foldlM decodeDim zeroIndex [1 .. dimensions (Proxy :: Proxy ix)]++instance Serialise Ix2 where+ encode = encodeIx+ decode = decodeIx++instance Index (IxN n) => Serialise (IxN n) where+ encode = encodeIx+ decode = decodeIx++++-- | Construct size from index verifying its correctness.+--+-- @since 0.1.0+mkSzFail ::+ forall ix m. (Index ix, Fail.MonadFail m)+ => ix+ -> m (Sz ix)+mkSzFail ix = do+ let guardNegativeOverflow i !acc = do+ when (i < 0) $ Fail.fail $ "Negative size encountered: " <> show i+ let acc' = i * acc+ when (acc' /= 0 && acc' < acc) $ Fail.fail $ "Overflow detected, size is too big: " <> show i+ pure acc'+ Sz ix <$ foldlIndex (\acc i -> acc >>= guardNegativeOverflow i) (pure 1) ix++instance (Index ix, Serialise ix) => Serialise (Sz ix) where+ encode = encodeIx . unSz+ decode = mkSzFail =<< decodeIx++++-- | Encode array by using its corresponding vector instance+--+-- @since 0.1.0+encodeArray ::+ forall v r ix e.+ ( Manifest r ix e+ , Mutable (ARepr v) ix e+ , VG.Vector v e+ , VRepr (ARepr v) ~ v+ , Serialise ix+ , Serialise (v e)+ )+ => Array r ix e+ -> Encoding+encodeArray arr =+ encode (getComp arr) <> encode (size arr) <> encode (toVector arr :: v e)++-- | Decode array by using its corresponding vector instance+--+-- @since 0.1.0+decodeArray ::+ forall v r ix e s.+ ( Typeable v+ , VG.Vector v e+ , Mutable (ARepr v) ix e+ , Mutable r ix e+ , Serialise ix+ , Serialise (v e)+ )+ => Decoder s (Array r ix e)+decodeArray = do+ comp <- decode+ sz <- decode+ vector :: v e <- decode+ -- setComp is to workaround a minor bug for boxed arrays in massiv < 0.6+ either (Fail.fail . show) (pure . setComp comp) $ fromVectorM comp sz vector++instance (Index ix, Serialise ix, Serialise e) => Serialise (Array B ix e) where+ encode = encodeArray @V.Vector+ decode = decodeArray @V.Vector++instance (Index ix, NFData e, Serialise ix, Serialise e) => Serialise (Array N ix e) where+ encode = encode . unwrapNormalForm+ decode = evalNormalForm <$> decode++instance (Index ix, Storable e, Serialise ix, Serialise e) => Serialise (Array S ix e) where+ encode = encodeArray @VS.Vector+ decode = decodeArray @VS.Vector++instance (Index ix, Unbox e, Serialise ix, Serialise e) => Serialise (Array U ix e) where+ encode = encodeArray @VU.Vector+ decode = decodeArray @VU.Vector++instance (Index ix, Prim e, Serialise ix, Serialise e) => Serialise (Array P ix e) where+ encode = encodeArray @VP.Vector+ decode = decodeArray @VP.Vector+
+ tests/Common.hs view
@@ -0,0 +1,6 @@+module Common+ ( module X+ ) where++import Test.Hspec as X+import Test.QuickCheck as X
+ tests/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import Spec+import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8)+import Test.Hspec++main :: IO ()+main = do+ hSetBuffering stdout LineBuffering+ hSetEncoding stdout utf8+ hspec spec
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
+ tests/Test/Massiv/SerialiseSpec.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Test.Massiv.SerialiseSpec (spec) where++import Codec.Serialise+import Common+import Massiv.Serialise ()+import Test.Massiv.Core+import Data.Massiv.Array+import Data.Word++roundtrip :: (Eq a, Show a, Serialise a) => a -> Property+roundtrip val = deserialise (serialise val) === val++roundtripArray ::+ forall r ix e.+ ( Load r ix e+ , Serialise (Array r ix e)+ , Eq (Array r ix e)+ , Show (Array r ix e)+ )+ => Array r ix e+ -> Property+roundtripArray arr =+ let arr' = deserialise (serialise arr)+ in (arr' === arr) .&&. (getComp arr' === getComp arr)++roundtripArraySpec ::+ forall r ix e.+ ( Eq (Array r ix e)+ , Show (Array r ix e)+ , Typeable ix+ , Typeable e+ , Arbitrary ix+ , Construct r ix e+ , Load r ix e+ , Arbitrary e+ , Serialise (Array r ix e)+ )+ => Spec+roundtripArraySpec =+ prop (showsType @(Array r ix e) "") $ roundtripArray @r @ix @e++spec :: Spec+spec = do+ describe "Serialise" $ do+ prop "Comp" $ roundtrip @Comp+ describe "Ix" $ do+ prop "Ix2" $ roundtrip @Ix2+ prop "Ix3" $ roundtrip @Ix3+ prop "Ix4" $ roundtrip @Ix4+ prop "Ix5" $ roundtrip @Ix5+ describe "Sz" $ do+ prop "Sz1" $ roundtrip @Sz1+ prop "Sz2" $ roundtrip @Sz2+ prop "Sz3" $ roundtrip @Sz3+ prop "Sz4" $ roundtrip @Sz4+ prop "Sz5" $ roundtrip @Sz5+ describe "Array" $ do+ describe "P" $ do+ roundtripArraySpec @P @Ix1 @Word8+ roundtripArraySpec @P @Ix2 @Word8+ roundtripArraySpec @P @Ix3 @Word8+ roundtripArraySpec @P @Ix4 @Word8+ roundtripArraySpec @P @Ix5 @Word8+ roundtripArraySpec @P @Ix1 @Word16+ roundtripArraySpec @P @Ix2 @Word16+ roundtripArraySpec @P @Ix3 @Word16+ roundtripArraySpec @P @Ix4 @Word16+ roundtripArraySpec @P @Ix5 @Word16+ roundtripArraySpec @P @Ix1 @Word32+ roundtripArraySpec @P @Ix2 @Word32+ roundtripArraySpec @P @Ix3 @Word32+ roundtripArraySpec @P @Ix4 @Word32+ roundtripArraySpec @P @Ix5 @Word32+ roundtripArraySpec @P @Ix1 @Word64+ roundtripArraySpec @P @Ix2 @Word64+ roundtripArraySpec @P @Ix3 @Word64+ roundtripArraySpec @P @Ix4 @Word64+ roundtripArraySpec @P @Ix5 @Word64+ roundtripArraySpec @P @Ix1 @Word+ roundtripArraySpec @P @Ix2 @Word+ roundtripArraySpec @P @Ix3 @Word+ roundtripArraySpec @P @Ix4 @Word+ roundtripArraySpec @P @Ix5 @Word+ describe "U" $ do+ roundtripArraySpec @U @Ix1 @Word+ roundtripArraySpec @U @Ix2 @Word+ roundtripArraySpec @U @Ix3 @Word+ roundtripArraySpec @U @Ix4 @Word+ roundtripArraySpec @U @Ix5 @Word+ describe "S" $ do+ roundtripArraySpec @S @Ix1 @Word+ roundtripArraySpec @S @Ix2 @Word+ roundtripArraySpec @S @Ix3 @Word+ roundtripArraySpec @S @Ix4 @Word+ roundtripArraySpec @S @Ix5 @Word+ describe "B" $ do+ roundtripArraySpec @B @Ix1 @Integer+ roundtripArraySpec @B @Ix2 @Integer+ roundtripArraySpec @B @Ix3 @Integer+ roundtripArraySpec @B @Ix4 @Integer+ roundtripArraySpec @B @Ix5 @Integer+ describe "N" $ do+ roundtripArraySpec @N @Ix1 @Integer+ roundtripArraySpec @N @Ix2 @Integer+ roundtripArraySpec @N @Ix3 @Integer+ roundtripArraySpec @N @Ix4 @Integer+ roundtripArraySpec @N @Ix5 @Integer
+ tests/doctests.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+module Main where++#if __GLASGOW_HASKELL__ >= 802 && __GLASGOW_HASKELL__ != 810++import Test.DocTest (doctest)++main :: IO ()+main = doctest ["src"]++#else++-- TODO: fix doctest support+main :: IO ()+main = putStrLn "\nDoctests are not supported for older ghc version\n"++#endif