serokell-util 0.1.3.5 → 0.1.4.0

raw patch · 10 files changed

+202/−48 lines, 10 filesdep +ansi-terminaldep +universumPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-terminal, universum

API changes (from Hackage documentation)

Files

• serokell-util.cabal +8/−4
• src/Serokell/AcidState/Instances.hs +43/−3
• src/Serokell/Util.hs +2/−0
• src/Serokell/Util/ANSI.hs +29/−0
• src/Serokell/Util/Common.hs +18/−1
• src/Serokell/Util/Lens.hs +26/−2
• src/Serokell/Util/Parse/Base64.hs +13/−10
• src/Serokell/Util/Parse/Common.hs +20/−8
• src/Serokell/Util/Parse/Network.hs +22/−20
• src/Serokell/Util/Time.hs +21/−0

@@ -1,5 +1,5 @@ name:                serokell-util-version:             0.1.3.5+version:             0.1.4.0 synopsis:            General-purpose functions by Serokell homepage:            https://github.com/serokell/serokell-util license:             MIT@@ -29,6 +29,7 @@                        Serokell.Data.Memory.Units                        Serokell.Data.Variant                        Serokell.Util+                       Serokell.Util.ANSI                        Serokell.Util.Base                        Serokell.Util.Base16                        Serokell.Util.Base64@@ -43,6 +44,7 @@                        Serokell.Util.Lens                        Serokell.Util.StaticAssert                        Serokell.Util.Text+                       Serokell.Util.Time                        Serokell.Util.Verify   other-modules:       Serokell.Data.Variant.Class                        Serokell.Data.Variant.Helpers@@ -53,8 +55,9 @@                        Serokell.Util.Parse.Network   build-depends:       QuickCheck >= 2.8.1                      , acid-state-                     , aeson >= 0.11.0.0 && < 2.0.0.0+                     , aeson >= 0.11.0.0 && < 1.2.0.0                      , aeson-extra >= 0.4.0.0+                     , ansi-terminal                      , base >= 4.8 && < 5                      , base16-bytestring                      , base64-bytestring@@ -63,8 +66,8 @@                      , bytestring                      , cereal                      , cereal-vector-                     , containers                      , clock+                     , containers                      , data-msgpack >= 0.0.8                      , deepseq                      , directory@@ -90,6 +93,7 @@                      , text-format                      , time-units                      , transformers+                     , universum                      , unordered-containers >= 0.2.7.0                      , vector                      , yaml@@ -112,7 +116,7 @@                        Test.Serokell.Util.VerifySpec                        Spec   type:                exitcode-stdio-1.0-  build-depends:       aeson >= 0.11.0.0 && < 2.0.0.0+  build-depends:       aeson >= 0.11.0.0 && < 1.2.0.0                      , base >=4.8                      , binary                      , bytestring

@@ -1,4 +1,6 @@--- | Helper instances for Acid State to remove boilerplate and introduce+{-# LANGUAGE CPP #-}++-- | Helper instances for acid-state to remove boilerplate and introduce -- redundant instances for other data types.  module Serokell.AcidState.Instances where@@ -6,14 +8,16 @@ import           Control.Exception   (throw) import           Control.Monad.Catch (MonadThrow (throwM)) +import qualified Data.Time.Units     as Time import           Data.Acid           (Query, Update) import           Data.Hashable       (Hashable) import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM hiding (HashMap) import           Data.HashSet        (HashSet) import qualified Data.HashSet        as HS hiding (HashSet)-import           Data.SafeCopy       (SafeCopy (getCopy, putCopy), contain,-                                      safeGet, safePut)+import qualified Data.List.NonEmpty  as NE+import           Data.SafeCopy       (SafeCopy (..), contain, safeGet,+                                      safePut)  -- | Usually Queries shouldn't throw anything. This is a dirty hack. instance MonadThrow (Query s) where@@ -29,3 +33,39 @@ instance (Eq a, Hashable a, SafeCopy a, SafeCopy b) => SafeCopy (HashMap a b) where     putCopy = contain . safePut . HM.toList     getCopy = contain $ HM.fromList <$> safeGet++-- [SRK-51]: we should try to get this one into safecopy itself though it's+-- unlikely that they will choose a different implementation (if they do+-- choose a different implementation we'll have to write a migration)+--+-- update: made a PR <https://github.com/acid-state/safecopy/pull/47>;+-- remove this instance when the pull request is merged+instance SafeCopy a => SafeCopy (NE.NonEmpty a) where+    getCopy = contain $ do+        xs <- safeGet+        case NE.nonEmpty xs of+            Nothing -> fail "getCopy@NonEmpty: list can't be empty"+            Just xx -> return xx+    putCopy = contain . safePut . NE.toList+    errorTypeName _ = "NonEmpty"++#define SAFECOPY_TIME(T, TS)                     \+  instance SafeCopy T where {                    \+    getCopy = contain (fromInteger <$> safeGet); \+    putCopy = contain . safePut . toInteger;     \+    errorTypeName _ = TS }                       \++SAFECOPY_TIME(Time.Fortnight, "Fortnight")+SAFECOPY_TIME(Time.Week, "Week")+SAFECOPY_TIME(Time.Day, "Day")+SAFECOPY_TIME(Time.Hour, "Hour")+SAFECOPY_TIME(Time.Minute, "Minute")+SAFECOPY_TIME(Time.Second, "Second")+SAFECOPY_TIME(Time.Millisecond, "Millisecond")+SAFECOPY_TIME(Time.Microsecond, "Microsecond")+SAFECOPY_TIME(Time.Nanosecond, "Nanosecond")+SAFECOPY_TIME(Time.Picosecond, "Picosecond")+SAFECOPY_TIME(Time.Femtosecond, "Femtosecond")+SAFECOPY_TIME(Time.Attosecond, "Attosecond")++#undef SAFECOPY_TIME

@@ -5,6 +5,7 @@          module Exports        ) where +import           Serokell.Util.ANSI         as Exports import           Serokell.Util.Bench        as Exports import           Serokell.Util.Binary       as Exports import           Serokell.Util.Common       as Exports@@ -14,4 +15,5 @@ import           Serokell.Util.OptParse     as Exports import           Serokell.Util.StaticAssert as Exports import           Serokell.Util.Text         as Exports+import           Serokell.Util.Time         as Exports import           Serokell.Util.Verify       as Exports

@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | Functions for working with ANSI-colored text.+module Serokell.Util.ANSI+       ( Color(..)+       , colorize+       , withColoredMessages+       ) where++import           System.Console.ANSI (Color (..), ColorIntensity (Vivid),+                                      ConsoleLayer (Foreground), SGR (Reset, SetColor),+                                      setSGRCode)+import           Universum++-- | Prettify 'Text' message with 'Vivid' color.+colorize :: Color -> Text -> Text+colorize color msg =+    toText (setSGRCode [SetColor Foreground Vivid color]) <>+    msg <>+    toText (setSGRCode [Reset])++-- | Write colored message, do some action, write colored message.+-- Intended for debug only.+withColoredMessages :: MonadIO m => Color -> Text -> m a -> m a+withColoredMessages color activity action = do+    putStrLn (colorize color ("Entered " <> activity))+    res <- action+    putStrLn (colorize color ("Finished " <> activity))+    return res

@@ -6,10 +6,11 @@        , indexModuloMay        , indexedSubList        , subList+       , allDistinct        ) where  import           Control.Monad.State (evalState, get, modify)-import           Data.List           (genericDrop, genericIndex, genericLength,+import           Data.List           (sort, genericDrop, genericIndex, genericLength,                                       genericTake) import           Data.Maybe          (fromMaybe) @@ -70,3 +71,19 @@ -- | Like indexedSubList, but not indexed :) subList :: Integral i => (i, i) -> [a] -> [a] subList range = map snd . indexedSubList range++-- | Determine whether all elements in a list are distinct.+--+-- >>> allDistinct [1,2,3]+-- True+-- >>> allDistinct [1,3,3]+-- False+--+-- Naturally, all elements in an empty list are distinct:+--+-- >>> allDistinct []+-- True+allDistinct :: Ord a => [a] -> Bool+allDistinct xs = and $ zipWith (/=) sorted (drop 1 sorted)+  where+    sorted = sort xs

@@ -7,11 +7,15 @@        , (%?=)        , WrappedM (..)        , _UnwrappedM+       , zoom'+       , magnify'        ) where  import qualified Control.Lens               as L-import           Control.Monad.Reader       (ReaderT)-import           Control.Monad.State        (State, get, runState)+import           Control.Monad.Reader       (MonadReader, Reader, ReaderT, reader,+                                             runReader)+import           Control.Monad.State        (MonadState, State, StateT, get, runState,+                                             state) import           Control.Monad.Trans.Except (ExceptT, mapExceptT) import           System.Wlog                (LoggerName, LoggerNameBox (..)) @@ -50,3 +54,23 @@ instance Monad m => WrappedM (LoggerNameBox m) where     type UnwrappedM (LoggerNameBox m) = ReaderT LoggerName m     _WrappedM = L.iso loggerNameBoxEntry LoggerNameBox++-- | A 'zoom' which works in arbitrary 'MonadState'.+--+-- See <https://github.com/ekmett/lens/issues/580>. You might be surprised+-- but actual 'zoom' doesn't work in any 'MonadState', it only works in a+-- handful of state monads and their combinations defined by 'Zoom'.+zoom'+    :: MonadState s m+    => L.LensLike' (L.Zoomed (State s) a) s t+    -> StateT t L.Identity a+    -> m a+zoom' l = state . runState . L.zoom l++-- | A 'magnify' which works in arbitrary 'MonadReader'.+magnify'+    :: MonadReader s m+    => L.LensLike' (L.Magnified (Reader s) a) s t+    -> ReaderT t L.Identity a+    -> m a+magnify' l = reader . runReader . L.magnify l

@@ -1,26 +1,29 @@+{-# LANGUAGE FlexibleContexts #-}+ -- | Parsing Base64  module Serokell.Util.Parse.Base64        ( base64        , base64Url        ) where-import qualified Data.ByteString                    as BS-import           Data.Text                          (pack, unpack)-import           Serokell.Util.Base64               (decode, decodeUrl)-import           Serokell.Util.Parse.Common         (Parser, asciiAlphaNum)-import           Text.Parsec                        (many, many1, (<|>))-import           Text.ParserCombinators.Parsec.Char (char) -base64 :: Parser BS.ByteString+import           Control.Applicative        (many, some, (<|>))+import qualified Data.ByteString            as BS+import           Data.Text                  (pack, unpack)+import           Serokell.Util.Base64       (decode, decodeUrl)+import           Serokell.Util.Parse.Common (CharParser, asciiAlphaNum)+import           Text.Parsec.Char           (char)++base64 :: CharParser BS.ByteString base64 = do-  str <- (++) <$> many1 (asciiAlphaNum <|> char '+' <|> char '/') <*> many (char '=')+  str <- (++) <$> some (asciiAlphaNum <|> char '+' <|> char '/') <*> many (char '=')   case decode $ pack str of     Left e   -> fail $ unpack e     Right bs -> return bs -base64Url :: Parser BS.ByteString+base64Url :: CharParser BS.ByteString base64Url = do-  str <- (++) <$> many1 (asciiAlphaNum <|> char '_' <|> char '-') <*> many (char '=')+  str <- (++) <$> some (asciiAlphaNum <|> char '_' <|> char '-') <*> many (char '=')   case decodeUrl $ pack str of     Left e   -> fail $ unpack e     Right bs -> return bs

@@ -1,20 +1,23 @@+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}  -- | Parsing common helpers  module Serokell.Util.Parse.Common-       ( Parser+       ( CharParser        , countMinMax        , limitedInt        , byte        , asciiAlphaNum+       , parseIntegralSafe        ) where -import           Text.Parsec                        (Parsec, ParsecT, Stream, option,-                                                     satisfy)-import           Text.ParserCombinators.Parsec.Char (digit)+import           Control.Applicative (some)+import           Text.Parsec         (Parsec, ParsecT, Stream, option, satisfy)+import           Text.Parsec.Char    (digit) -type Parser = Parsec String ()+type CharParser a = forall s u m. Stream s m Char => ParsecT s u m a  isAsciiAlpha :: Char -> Bool isAsciiAlpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')@@ -25,7 +28,7 @@ isAsciiAlphaNum :: Char -> Bool isAsciiAlphaNum c = isAsciiAlpha c || isAsciiNum c -asciiAlphaNum :: Parser Char+asciiAlphaNum :: CharParser Char asciiAlphaNum = satisfy isAsciiAlphaNum  countMinMax :: (Stream s m t) => Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]@@ -40,7 +43,7 @@         end <- countMinMax 0 (x - 1) p         return $ f : end -limitedInt :: Int -> String -> Parser Int+limitedInt :: Int -> String -> CharParser Int limitedInt x e = do     b <- read <$> countMinMax 1 (intDigits x) digit     if b > x@@ -49,6 +52,15 @@   where     intDigits = length . show -byte :: Parser Word+byte :: CharParser Word byte = fromIntegral <$> limitedInt 255 "Value to large" +parseIntegralSafe :: Integral a => CharParser a+parseIntegralSafe = fromIntegerSafe . read =<< some digit+  where+    fromIntegerSafe :: Integral a => Integer -> CharParser a+    fromIntegerSafe x =+        let res = fromInteger x+        in  if fromIntegral res == x+            then return res+            else fail ("Number is too large: " ++ show x)

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+ -- | Parsing network data  module Serokell.Util.Parse.Network@@ -14,14 +16,14 @@        , recipient        ) where -import           Control.Monad                      (liftM, void)-import           Data.Monoid                        ((<>))-import           Data.Word                          (Word16)-import           Serokell.Util.Parse.Common         (Parser, asciiAlphaNum, byte,-                                                     countMinMax, limitedInt)-import           Text.Parsec                        (choice, count, many1, oneOf, option,-                                                     try, (<?>), (<|>))-import           Text.ParserCombinators.Parsec.Char (alphaNum, char, hexDigit, string)+import           Control.Applicative        (some, (<|>))+import           Control.Monad              (liftM, void)+import           Data.Monoid                ((<>))+import           Data.Word                  (Word16)+import           Serokell.Util.Parse.Common (CharParser, asciiAlphaNum, byte, countMinMax,+                                             limitedInt)+import           Text.Parsec                (choice, count, oneOf, option, try, (<?>))+import           Text.Parsec.Char           (alphaNum, char, hexDigit, string)  data Host = IPv4Address { hostAddress :: String }           | IPv6Address { hostAddress :: String }@@ -31,10 +33,10 @@ concatSequence :: (Monad m) => [m [a]] -> m [a] concatSequence = liftM concat . sequence -port :: Parser Word16+port :: CharParser Word16 port = fromIntegral <$> limitedInt 65535 "Port number to large" -ipv4address :: Parser String+ipv4address :: CharParser String ipv4address = concatSequence [     byteStr, string ".",     byteStr, string ".",@@ -42,7 +44,7 @@   where     byteStr = show <$> byte -ipv6address :: Parser String+ipv6address :: CharParser String ipv6address = do     let ipv6variants = (try <$> skippedAtBegin)                         ++ [try full]@@ -85,18 +87,18 @@      full = concatSequence [concat <$> count 6 h4s, last2 True] -ipv6addressWithScope :: Parser String+ipv6addressWithScope :: CharParser String ipv6addressWithScope = concatSequence [ipv6address, option "" scope]   where-    scope = concatSequence [string "%", many1 asciiAlphaNum]+    scope = concatSequence [string "%", some asciiAlphaNum] -hostname :: Parser String-hostname = many1 $ alphaNum <|> oneOf ".-_"+hostname :: CharParser String+hostname = some $ alphaNum <|> oneOf ".-_" -host :: Parser String+host :: CharParser String host = hostAddress <$> host' -host' :: Parser Host+host' :: CharParser Host host' = (IPv6Address <$> try ipv6str)          <|> (IPv4Address <$> try ipv4address)          <|> (HostName <$> hostname)@@ -107,7 +109,7 @@         void $ char ']'         return ipv6 -connection' :: Parser (Host, Maybe Word16)+connection' :: CharParser (Host, Maybe Word16) connection' = do     addr <- host'     p <- maybePort@@ -115,12 +117,12 @@   where     maybePort = option Nothing $ char ':' >> Just <$> port -connection :: Parser (String, Maybe Word16)+connection :: CharParser (String, Maybe Word16) connection = (\(h, p) -> (hostAddress h, p)) <$> connection'  -- | 'Parser' for host with both hostname and port. -- Example: 54.122.0.255:9999-recipient :: Parser (String, Word16)+recipient :: CharParser (String, Word16) recipient = connection >>= \(h, mp) -> case mp of               Just p -> pure (h, p)               _      -> fail $ "No port specified for host " <> h

@@ -0,0 +1,21 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- | Functions for working with time+module Serokell.Util.Time+       ( mcs+       , ms+       , sec+       , minute+       , hour+       ) where++import           Data.Time.Units (Microsecond, fromMicroseconds)+import           Universum++-- | Converts a specified time to 'Microsecond'.+mcs, ms, sec, minute, hour :: Int -> Microsecond+mcs    = fromMicroseconds . fromIntegral+ms     = fromMicroseconds . fromIntegral . (*) 1000+sec    = fromMicroseconds . fromIntegral . (*) 1000000+minute = fromMicroseconds . fromIntegral . (*) 60000000+hour   = fromMicroseconds . fromIntegral . (*) 3600000000