never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 
    3 -- |
    4 -- Copyright: © 2018-2020 IOHK
    5 -- License: Apache-2.0
    6 
    7 module Data.Word7
    8     (
    9       -- * Types
   10       Word7
   11 
   12       -- * Conversions
   13     , toWord7
   14     , toWord8
   15     , toWord7s
   16     , toNatural
   17 
   18       -- * Encode / Decode
   19     , putVariableLengthNat
   20     , getVariableLengthNat
   21     ) where
   22 
   23 import Prelude
   24 
   25 import Data.Binary.Get
   26     ( Get, getWord8 )
   27 import Data.Binary.Put
   28     ( Put, putWord8 )
   29 import Data.Bits
   30     ( shiftL, shiftR, (.&.), (.|.) )
   31 import Data.List
   32     ( foldl' )
   33 import Data.Word
   34     ( Word8 )
   35 import Numeric.Natural
   36     ( Natural )
   37 
   38 
   39 -- | A 'Word7' algebraic data-type.
   40 -- @since 2.0.0
   41 newtype Word7 = Word7 Word8
   42   deriving (Eq, Show)
   43 
   44 
   45 --
   46 -- Conversions
   47 --
   48 -- > toWord7 1
   49 -- > Word7 1
   50 -- > toWord7 127
   51 -- > Word7 127
   52 -- > toWord7 128
   53 -- > Word7 0
   54 toWord7 :: Word8 -> Word7
   55 toWord7 x = Word7 (x .&. 0x7F)
   56 
   57 toWord8 :: Word7 -> Word8
   58 toWord8 (Word7 x) = x
   59 
   60 -- > toWord7s 1
   61 -- > [Word7 1]
   62 -- > toWord7s 128
   63 -- > [Word7 1,Word7 0]
   64 -- > toWord7s 19099
   65 -- > [Word7 1,Word7 21,Word7 27]
   66 toWord7s :: Natural -> [Word7]
   67 toWord7s = reverse . go
   68   where
   69     go n
   70         | n <= 0x7F = [Word7 . fromIntegral $ n]
   71         | otherwise = (toWord7 . fromIntegral) n : go (shiftR n 7)
   72 
   73 word7sToNat :: [Word7] -> Natural
   74 word7sToNat = foldl' f 0
   75   where
   76     f n (Word7 r) = shiftL n 7 .|. (fromIntegral r)
   77 
   78 toNatural :: [Word7] -> Natural
   79 toNatural =
   80     fst .
   81     foldr (\(Word7 x) (res, pow) ->
   82                (res + (fromIntegral x)*(limit pow + 1), pow + 7)
   83           )
   84     (0,0)
   85   where
   86     limit :: Int -> Natural
   87     limit pow = 2 ^ pow - 1
   88 
   89 --
   90 -- Decoding
   91 --
   92 putVariableLengthNat :: Natural -> Put
   93 putVariableLengthNat = putWord7s . toWord7s
   94   where
   95     putWord7s :: [Word7] -> Put
   96     putWord7s [] = pure ()
   97     putWord7s [Word7 x] = putWord8 x
   98     putWord7s (Word7 x : xs) = putWord8 (x .|. 0x80) >> putWord7s xs
   99 
  100 getVariableLengthNat :: Get Natural
  101 getVariableLengthNat = word7sToNat <$> getWord7s
  102   where
  103     getWord7s :: Get [Word7]
  104     getWord7s = do
  105       next <- getWord8
  106       case next .&. 0x80 of
  107         0x80 -> (:) (toWord7 next) <$> getWord7s
  108         _ -> pure [Word7 next]