foundation 0.0.23 → 0.0.24

raw patch · 12 files changed

+71/−54 lines, 12 filesdep ~basedep ~basementPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, basement

API changes (from Hackage documentation)

Files

• Foundation/Check/Main.hs +5/−4
• Foundation/Collection/Indexed.hs +2/−2
• Foundation/Monad/Except.hs +13/−5
• Foundation/Monad/Exception.hs +1/−2
• Foundation/Monad/MonadIO.hs +0/−16
• Foundation/Monad/Reader.hs +4/−5
• Foundation/Monad/Transformer.hs +2/−2
• Foundation/Network/IPv4.hs +7/−1
• Foundation/Network/IPv6.hs +18/−13
• LICENSE +1/−1
• foundation.cabal +3/−3
• tests/Test/Foundation/Network/IPv4.hs +15/−0

@@ -179,11 +179,12 @@ test (CheckPlan name plan) = do     testCheckPlan name plan test (Property name prop) = do-    r'@(PropertyResult _ nb r) <- testProperty name (property prop)+    r <- testProperty name (property prop)     case r of-        PropertySuccess  -> whenVerbose $ displayPropertySucceed name nb-        PropertyFailed w -> whenErrorOnly $ displayPropertyFailed name nb w-    return r'+        (PropertyResult _ nb PropertySuccess)    -> whenVerbose $ displayPropertySucceed name nb+        (PropertyResult _ nb (PropertyFailed w)) -> whenErrorOnly $ displayPropertyFailed name nb w+        GroupResult {} -> error "internal error: should not happen"+    return r  displayCurrent :: String -> CheckMain () displayCurrent name = do

@@ -69,7 +69,7 @@         loop i             | i .==# len                     = Nothing             | predicate (UV.unsafeIndex c i) = Just i-            | otherwise                      = Nothing+            | otherwise                      = loop (i + 1)  instance IndexedCollection (BA.Array ty) where     (!) l n@@ -81,7 +81,7 @@         loop i             | i .==# len = Nothing             | otherwise  =-                if predicate (BA.unsafeIndex c i) then Just i else Nothing+                if predicate (BA.unsafeIndex c i) then Just i else loop (i + 1)  instance IndexedCollection S.String where     (!) = S.index

@@ -1,21 +1,24 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-} module Foundation.Monad.Except     ( ExceptT(..)     ) where  import Basement.Imports-import Basement.Compat.AMP import Foundation.Monad.Base import Foundation.Monad.Reader+#if MIN_VERSION_base(4,13,0)+import Control.Monad.Fail+#endif  newtype ExceptT e m a = ExceptT { runExceptT :: m (Either e a) }  instance Functor m => Functor (ExceptT e m) where     fmap f = ExceptT . fmap (fmap f) . runExceptT -instance AMPMonad m => Applicative (ExceptT e m) where+instance Monad m => Applicative (ExceptT e m) where     pure a = ExceptT $ pure (Right a)     ExceptT f <*> ExceptT v = ExceptT $ do         mf <- f@@ -27,20 +30,25 @@                     Left e -> pure (Left e)                     Right x -> pure (Right (k x)) -instance AMPMonad m => MonadFailure (ExceptT e m) where+instance Monad m => MonadFailure (ExceptT e m) where     type Failure (ExceptT e m) = e     mFail = ExceptT . pure . Left -instance AMPMonad m => Monad (ExceptT e m) where+instance Monad m => Monad (ExceptT e m) where     return a = ExceptT $ return (Right a)     m >>= k = ExceptT $ do         a <- runExceptT m         case a of             Left e -> return (Left e)             Right x -> runExceptT (k x)+#if !MIN_VERSION_base(4,13,0)     fail = ExceptT . fail+#else+instance MonadFail m => MonadFail (ExceptT e m) where+    fail = ExceptT . fail+#endif -instance (AMPMonad m, MonadFix m) => MonadFix (ExceptT e m) where+instance (Monad m, MonadFix m) => MonadFix (ExceptT e m) where     mfix f = ExceptT (mfix (runExceptT . f . fromEither))       where         fromEither (Right x) = x

@@ -7,11 +7,10 @@     ) where  import           Basement.Compat.Base-import           Basement.Compat.AMP import qualified Control.Exception as E  -- | Monad that can throw exception-class AMPMonad m => MonadThrow m where+class Monad m => MonadThrow m where     -- | Throw immediatity an exception.     -- Only a 'MonadCatch' monad will be able to catch the exception using 'catch'     throw :: Exception e => e -> m a

@@ -1,21 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-} module Foundation.Monad.MonadIO     ( MonadIO(..)     ) where -#if MIN_VERSION_base(4,9,0) import Control.Monad.IO.Class-#else-import Basement.Compat.Base-import Basement.Compat.AMP---- | Monads in which 'IO' computations may be embedded.-class AMPMonad m => MonadIO m where-    -- | Lift a computation from the 'IO' monad.-    liftIO :: IO a -> m a--instance MonadIO IO where-    liftIO io = io--#endif

@@ -13,11 +13,10 @@     ) where  import Basement.Compat.Base (($), (.), const)-import Basement.Compat.AMP import Foundation.Monad.Base import Foundation.Monad.Exception -class AMPMonad m => MonadReader m where+class Monad m => MonadReader m where     type ReaderContext m     ask :: m (ReaderContext m) @@ -34,13 +33,13 @@     fab <*> fa = ReaderT $ \r -> runReaderT fab r <*> runReaderT fa r     {-# INLINE (<*>) #-} -instance AMPMonad m => Monad (ReaderT r m) where+instance Monad m => Monad (ReaderT r m) where     return a = ReaderT $ const (return a)     {-# INLINE return #-}     ma >>= mab = ReaderT $ \r -> runReaderT ma r >>= \a -> runReaderT (mab a) r     {-# INLINE (>>=) #-} -instance (AMPMonad m, MonadFix m) => MonadFix (ReaderT s m) where+instance (Monad m, MonadFix m) => MonadFix (ReaderT s m) where     mfix f = ReaderT $ \r -> mfix $ \a -> runReaderT (f a) r     {-# INLINE mfix #-} @@ -70,6 +69,6 @@                               (\a exn -> runReaderT (cleanupExcept a exn) c)                               (\a -> runReaderT (innerAction a) c) -instance AMPMonad m => MonadReader (ReaderT r m) where+instance Monad m => MonadReader (ReaderT r m) where     type ReaderContext (ReaderT r m) = r     ask = ReaderT return

@@ -3,9 +3,9 @@     ( MonadTrans(..)     ) where -import Basement.Compat.AMP+import Basement.Compat.Base (Monad)  -- | Basic Transformer class class MonadTrans trans where     -- | Lift a computation from an inner monad to the current transformer monad-    lift :: AMPMonad m => m a -> trans m a+    lift :: Monad m => m a -> trans m a

@@ -32,6 +32,8 @@ import Foundation.Parser hiding (peek) import Foundation.Collection (Sequential, Element, elem) +import qualified Prelude (String)+ -- | IPv4 data type newtype IPv4 = IPv4 Word32     deriving (Eq, Ord, Typeable, Hashable)@@ -104,5 +106,9 @@     i4 <- takeAWord8     return $ fromTuple (i1, i2, i3, i4)   where-    takeAWord8 = read . toList <$> takeWhile isAsciiDecimal+    takeAWord8 = do+      n <- (read :: Prelude.String -> Integer) . toList <$> takeWhile isAsciiDecimal+      if n > 256+        then reportError $ Satisfy $ Just "expected smaller integer than 256"+        else return (fromIntegral n)     isAsciiDecimal = flip elem ['0'..'9']

@@ -207,15 +207,18 @@     let (CountOf lenBs1) = length bs1     bs2 <- repeat (Between $ 0 `And` (fromIntegral $ 6 - lenBs1)) $ takeAWord16 <* skipColon     _ <- optional skipColon-    [i1,i2,i3,i4,i5,i6] <- format 6 bs1 bs2-    m1 <- takeAWord8 <* skipDot-    m2 <- takeAWord8 <* skipDot-    m3 <- takeAWord8 <* skipDot-    m4 <- takeAWord8-    return $ fromTuple ( i1,i2,i3,i4,i5,i6-                       , m1 `shiftL` 8 .|. m2-                       , m3 `shiftL` 8 .|. m4-                       )+    is <- format 6 bs1 bs2+    case is of+        [i1,i2,i3,i4,i5,i6] -> do+            m1 <- takeAWord8 <* skipDot+            m2 <- takeAWord8 <* skipDot+            m3 <- takeAWord8 <* skipDot+            m4 <- takeAWord8+            return $ fromTuple ( i1,i2,i3,i4,i5,i6+                               , m1 `shiftL` 8 .|. m2+                               , m3 `shiftL` 8 .|. m4+                               )+        _ -> error "internal error: format should return 6"  -- | IPv6 parser as described in RFC4291 section 2.2.2 --@@ -236,12 +239,14 @@     let (CountOf bs1Len) = length bs1     bs2 <- repeat (Between $ 0 `And` fromIntegral (8 - bs1Len)) $               skipColon *> takeAWord16-    [i1,i2,i3,i4,i5,i6,i7,i8] <- format 8 bs1 bs2-    return $ fromTuple (i1,i2,i3,i4,i5,i6,i7,i8)+    is <- format 8 bs1 bs2+    case is of+        [i1,i2,i3,i4,i5,i6,i7,i8] -> pure $ fromTuple (i1,i2,i3,i4,i5,i6,i7,i8)+        _ -> error "internal error: format should return 8"  format :: (Integral a, Monad m) => CountOf a -> [a] -> [a] -> m [a] format sz bs1 bs2-    | sz <= (length bs1 + length bs2) = fail "invalid compressed IPv6 addressed"+    | sz <= (length bs1 + length bs2) = error "invalid compressed IPv6 addressed"     | otherwise = do         let len = sz `sizeSub` (length bs1 + length bs2)         return $ bs1 <> replicate len 0 <> bs2@@ -262,4 +267,4 @@     let lhs = readHex l      in case lhs of           [(w, [])] -> return w-          _ -> fail "can't fall here"+          _ -> error "internal error: can't fall here"

@@ -1,5 +1,5 @@ Copyright (c) 2015-2017 Vincent Hanquez <vincent@snarc.org>-Copyright (c) 2017-2018 Foundation Maintainers+Copyright (c) 2017-2019 Foundation Maintainers  All rights reserved. 

@@ -1,5 +1,5 @@ name:                foundation-version:             0.0.23+version:             0.0.24 synopsis:            Alternative prelude with batteries and no dependencies description:     A custom prelude with no dependencies apart from base.@@ -28,7 +28,7 @@ build-type:          Simple homepage:            https://github.com/haskell-foundation/foundation bug-reports:         https://github.com/haskell-foundation/foundation/issues-cabal-version:       >=1.18+cabal-version:       1.18 extra-source-files:  cbits/*.h  source-repository head@@ -206,7 +206,7 @@       if arch(i386)         extra-libraries: gcc -  build-depends: basement == 0.0.10+  build-depends: basement == 0.0.11    -- FIXME add suport for armel mipsel   --  CPP-options: -DARCH_IS_LITTLE_ENDIAN

@@ -7,6 +7,8 @@ import Foundation import Foundation.Network.IPv4 import Foundation.Check+import Data.Either (isLeft)+import Foundation.Parser (parseOnly)  import Test.Data.Network import Test.Foundation.Storable@@ -25,6 +27,17 @@     forAll ((,) <$> genElement <*> genElement) $ \(x, y) ->         (toTuple x `compare` toTuple y) === x `compare` y +-- | generate IPv4 like string but with bigger numbers+genOverflowingIPv4String :: Gen String+genOverflowingIPv4String = do+  w1 <- bigWordGen+  w2 <- bigWordGen+  w3 <- bigWordGen+  w4 <- bigWordGen+  return $ show w1 <> "." <> show w2 <> "." <> show w3 <> "." <> show w4 where+    bigWordGen :: Gen Word+    bigWordGen = between (256,maxBound)+ testNetworkIPv4 :: Test testNetworkIPv4 = Group "IPv4"     [ Property "toTuple . fromTuple == id" $@@ -35,4 +48,6 @@     , testOrdering genIPv4     , testPropertyStorable      "Storable" (Proxy :: Proxy IPv4)     , testPropertyStorableFixed "StorableFixed" (Proxy :: Proxy IPv4)+    , Property "Word8 overflow is detected" $+        forAll genOverflowingIPv4String $ \x -> isLeft $ parseOnly ipv4Parser x     ]