packages feed

halves (empty) → 0.1.0.0

raw patch · 7 files changed

+439/−0 lines, 7 filesdep +basedep +halvesdep +hedgehogsetup-changed

Dependencies added: base, halves, hedgehog, lens

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Brian McKenna++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 Brian McKenna 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ halves.cabal view
@@ -0,0 +1,34 @@+name:                halves+version:             0.1.0.0+synopsis:            Splitting/combining data structures to/from halves, quarters, eighths+description:         Splitting/combining data structures to/from halves, quarters, eighths.+license:             BSD3+license-file:        LICENSE+author:              Brian McKenna+maintainer:          brian@brianmckenna.org+category:            Data+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Data.Halves+                     , Data.Halves.FiniteBits+                     , Data.Halves.Tuple++  build-depends:       base >=4.7 && <4.11+                     , lens >=4.15 && <4.17+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite props+  type:                exitcode-stdio-1.0+  main-is:             tests/Props.hs+  build-depends:       base+                     , lens+                     , halves+                     , hedgehog >= 0.5 && <0.6+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/puffnfresh/halves
+ src/Data/Halves.hs view
@@ -0,0 +1,218 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE ScopedTypeVariables    #-}++module Data.Halves (+  Halves(..)+, quarters+, eighths++, upperHalf+, lowerHalf+, swappedHalves++, chunkHalves+, chunkQuarters+, chunkEighths+, collectHalves+, collectQuarters+, collectEighths++, finiteBitHalves+) where++import           Control.Lens+import           Data.Bits              (Bits (..), finiteBitSize)+import           Data.Halves.FiniteBits (AsFiniteBits (..))+import           Data.Halves.Tuple      (tuple4, tuple8)+import           Data.Int+import           Data.Monoid            ((<>))+import           Data.Word++class Halves a b | a -> b, b -> a where+  halves :: Iso' a (b, b)++-- >>> (300 :: Word16) ^. halves+-- (1,44)+-- >>> (1 :: Word8, 44 :: Word8) ^. from halves+-- 300+instance Halves Word16 Word8 where+  halves =+    finiteBitHalves++-- >>> (65538 :: Word32) ^. halves+-- (1,2)+-- >>> (1 :: Word16, 2 :: Word16) ^. from halves+-- 65538+instance Halves Word32 Word16 where+  halves =+    finiteBitHalves++-- >>> (4294967299 :: Word64) ^. halves+-- (1,3)+-- >>> (1 :: Word32, 3 :: Word32) ^. from halves+-- 4294967299+instance Halves Word64 Word32 where+  halves =+    finiteBitHalves++-- >>> (-30748 :: Int16) ^. halves+-- (-121,-28)+-- >>> ((-121) :: Int8, (-28) :: Int8) ^. from halves+-- -30748+instance Halves Int16 Int8 where+  halves =+    finiteBitHalves++-- >>> (-1610312736 :: Int32) ^. halves+-- (-24572,-27680)+-- >>> (-24572 :: Int16, -27680 :: Int16) ^. from halves+-- -1610312736+instance Halves Int32 Int16 where+  halves =+    finiteBitHalves++-- >>> (-6917529027641081356 :: Int64) ^. halves+-- (-1610612736,500)+-- >>> (-1610612736 :: Int32, 500 :: Int32) ^. from halves+-- -6917529027641081356+instance Halves Int64 Int32 where+  halves =+    finiteBitHalves++-- >>> (3201205369 :: Word32) ^. quarters+-- (190,206,132,121)+-- >>> (190 :: Word8, 206 :: Word8, 132 :: Word8, 121 :: Word8) ^. from quarters+-- 3201205369+quarters ::+  (Halves a b, Halves b c) =>+  Iso' a (c, c, c, c)+quarters =+  halves . bimapping halves halves . tuple4++-- >>> (13832053055282163709 :: Word64) ^. eighths+-- (191,245,82,247,234,115,47,253)+eighths ::+  (Halves a b, Halves b c, Halves c d) =>+  Iso' a (d, d, d, d, d, d, d, d)+eighths =+  halves . bimapping quarters quarters . tuple8++-- >>> (4294967299 :: Word64) ^. upperHalf+-- 1+upperHalf ::+  (Halves a b) =>+  Lens' a b+upperHalf =+  halves . _1++-- >>> (4294967299 :: Word64) ^. lowerHalf+-- 3+lowerHalf ::+  (Halves a b) =>+  Lens' a b+lowerHalf =+  halves . _2++-- >>> (4294967299 :: Word64) ^. swappedHalves+-- 12884901889+swappedHalves ::+  (Halves a b) =>+  Iso' a a+swappedHalves =+  halves . swapped . from halves++-- >>> ([1,2,3,4,5,6,7,8,9] :: [Word8]) ^. chunkHalves+-- ([258,772,1286,1800],[9])+-- >>> ([258,772,1286,1800 :: Word16],[9]) ^. from chunkHalves+-- [1,2,3,4,5,6,7,8,9]+chunkHalves ::+  (Halves a b) =>+  Iso' [b] ([a], [b])+chunkHalves =+  iso f g+  where+    f (a:b:xs) =+      ([(a, b) ^. from halves], []) <> f xs+    f xs =+      ([], xs)+    g (xs, ys) =+      ((h . (^. halves)) =<< xs) <> ys+    h (a, b) =+      [a, b]++-- >>> ([1,2,3,4,5,6,7,8,9] :: [Word8]) ^. chunkQuarters+-- ([16909060,84281096],[9])+-- >>> ([16909060,84281096 :: Word32],[9]) ^. from chunkQuarters+-- [1,2,3,4,5,6,7,8,9]+chunkQuarters ::+  (Halves a b, Halves b c) =>+  Iso' [c] ([a], [c])+chunkQuarters =+  iso f g+  where+    f (a:b:c:d:xs) =+      ([(a, b, c, d) ^. from quarters], []) <> f xs+    f xs =+      ([], xs)+    g (xs, ys) =+      ((h . (^. quarters)) =<< xs) <> ys+    h (a, b, c, d) =+      [a, b, c, d]++-- >>> ([1,2,3,4,5,6,7,8,9] :: [Word8]) ^. chunkEighths+-- ([72623859790382856],[9])+-- >>> ([72623859790382856 :: Word64],[9]) ^. from chunkEighths+-- [1,2,3,4,5,6,7,8,9]+chunkEighths ::+  (Halves a b, Halves b c, Halves c d) =>+  Iso' [d] ([a], [d])+chunkEighths =+  iso f g+  where+    f (a:b:c:d:e:f':g':h':xs) =+      ([(a, b, c, d, e, f', g', h') ^. from eighths], []) <> f xs+    f xs =+      ([], xs)+    g (xs, ys) =+      ((h . (^. eighths)) =<< xs) <> ys+    h (a, b, c, d, e, f', g', h') =+      [a, b, c, d, e, f', g', h']++-- >>> ([1,2,3,4,5,6,7,8,9] :: [Word8]) ^. collectHalves+-- [258,772,1286,1800]+collectHalves ::+  (Halves a b) =>+  Lens' [b] [a]+collectHalves =+  chunkHalves . _1++-- >>> ([1,2,3,4,5,6,7,8,9] :: [Word8]) ^. collectQuarters+-- [16909060,84281096]+collectQuarters ::+  (Halves a b, Halves b c) =>+  Lens' [c] [a]+collectQuarters =+  chunkQuarters . _1++-- >>> ([1,2,3,4,5,6,7,8,9] :: [Word8]) ^. collectEighths+-- [72623859790382856]+collectEighths ::+  (Halves a b, Halves b c, Halves c d) =>+  Lens' [d] [a]+collectEighths =+  chunkEighths . _1++finiteBitHalves ::+  forall a b c.+  (Integral a, Integral b, Integral c, Bits a, AsFiniteBits b c) =>+  Iso' a (b, b)+finiteBitHalves =+  iso f g+  where+    s =+      finiteBitSize (zeroBits :: c)+    f a =+      (fromIntegral (unsafeShiftR a s), fromIntegral a)+    g (a, b) =+      unsafeShiftL (fromIntegral a) s .|. fromIntegral (b ^. asFiniteBits)
+ src/Data/Halves/FiniteBits.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}++module Data.Halves.FiniteBits (+  AsFiniteBits(..)+, asFiniteBitsDefault+) where++import           Control.Lens+import           Data.Bits+import           Data.Int+import           Data.Word++class FiniteBits b => AsFiniteBits a b | a -> b where+  asFiniteBits :: Iso' a b++asFiniteBitsDefault ::+  (Integral a, Integral b) =>+  Iso' a b+asFiniteBitsDefault =+    iso fromIntegral fromIntegral++instance AsFiniteBits Word8 Word8 where+  asFiniteBits =+    simple++instance AsFiniteBits Word16 Word16 where+  asFiniteBits =+    simple++instance AsFiniteBits Word32 Word32 where+  asFiniteBits =+    simple++instance AsFiniteBits Word64 Word64 where+  asFiniteBits =+    simple++instance AsFiniteBits Int8 Word8 where+  asFiniteBits =+    asFiniteBitsDefault++instance AsFiniteBits Int16 Word16 where+  asFiniteBits =+    asFiniteBitsDefault++instance AsFiniteBits Int32 Word32 where+  asFiniteBits =+    asFiniteBitsDefault++instance AsFiniteBits Int64 Word64 where+  asFiniteBits =+    asFiniteBitsDefault
+ src/Data/Halves/Tuple.hs view
@@ -0,0 +1,32 @@+module Data.Halves.Tuple (+  tuple4+, tuple8+) where++import           Control.Lens++-- >>> (((), True), ("three", 'f')) ^. tuple4+-- ((),True,"three",'f')+-- >>> ((), True, "three", 'f') ^. from tuple4+-- (((),True),("three",'f'))+tuple4 ::+  Iso' ((a, b), (c, d)) (a, b, c, d)+tuple4 =+  iso f g+  where+    f ((a, b), (c, d)) =+      (a, b, c, d)+    g (a, b, c, d) =+      ((a, b), (c, d))++-- >>> (((), True, "three", 'f'), ('a', False, "x", ())) ^. tuple8+-- ((),True,"three",'f','a',False,"x",())+tuple8 ::+  Iso' ((a, b, c, d), (e, f, g, h)) (a, b, c, d, e, f, g, h)+tuple8 =+  iso f g+  where+    f ((a, b, c, d), (e, f', g', h)) =+      (a, b, c, d, e, f', g', h)+    g (a, b, c, d, e, f', g', h) =+      ((a, b, c, d), (e, f', g', h))
+ tests/Props.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}++import           Control.Lens+import           Control.Monad  (unless)+import           Data.Halves+import           Hedgehog+import qualified Hedgehog.Gen   as Gen+import qualified Hedgehog.Range as Range+import           System.Exit    (exitFailure)+import           System.IO++isoToFrom ::+  (MonadTest m, Eq a, Show a) =>+  Iso' a b ->+  a ->+  m ()+isoToFrom i a =+  a ^. i ^. from i === a++prop_iso ::+  (Halves a b, Eq a, Show a) =>+  Gen a ->+  Property+prop_iso g =+  property $ forAll g >>= isoToFrom halves++prop_word16 ::+  Property+prop_word16 =+  prop_iso $ Gen.word16 Range.linearBounded++prop_word32 ::+  Property+prop_word32 =+  prop_iso $ Gen.word32 Range.linearBounded++prop_word64 ::+  Property+prop_word64 =+  prop_iso $ Gen.word64 Range.linearBounded++prop_int16 ::+  Property+prop_int16 =+  prop_iso $ Gen.int16 Range.linearBounded++prop_int32 ::+  Property+prop_int32 =+  prop_iso $ Gen.int32 Range.linearBounded++prop_int64 ::+  Property+prop_int64 =+  prop_iso $ Gen.int64 Range.linearBounded++main :: IO ()+main = do+  hSetBuffering stdout LineBuffering+  hSetBuffering stderr LineBuffering+  result <- checkParallel $ Group "Props"+    [ ("prop_word16", prop_word16)+    , ("prop_word32", prop_word32)+    , ("prop_word64", prop_word64)+    , ("prop_int16",  prop_int16)+    , ("prop_int32",  prop_int32)+    , ("prop_int64",  prop_int64)+    ]+  unless result $ exitFailure