serokell-util 0.8.0 → 0.9.0
raw patch · 29 files changed
+258/−413 lines, 29 filesdep +microlensdep +microlens-mtldep +processdep −containersdep −directorydep −filepathdep ~extradep ~o-clock
Dependencies added: microlens, microlens-mtl, process, th-lift-instances
Dependencies removed: containers, directory, filepath, lens, log-warper, monad-control, optparse-applicative, safecopy, semigroups, stm, yaml
Dependency ranges changed: extra, o-clock
Files
- serokell-util.cabal +10/−23
- src/Serokell/Aeson/Options.hs +0/−62
- src/Serokell/Arbitrary.hs +6/−9
- src/Serokell/Data/Variant/Class.hs +0/−1
- src/Serokell/Data/Variant/Serialization.hs +2/−3
- src/Serokell/Data/Variant/Variant.hs +1/−3
- src/Serokell/Util.hs +1/−1
- src/Serokell/Util/Base.hs +0/−18
- src/Serokell/Util/Base16.hs +2/−1
- src/Serokell/Util/Base64.hs +3/−20
- src/Serokell/Util/Bench.hs +0/−4
- src/Serokell/Util/Common.hs +1/−1
- src/Serokell/Util/I18N.hs +0/−72
- src/Serokell/Util/Lens.hs +13/−38
- src/Serokell/Util/OptParse.hs +0/−33
- src/Serokell/Util/Parse/Base64.hs +0/−1
- src/Serokell/Util/Parse/Common.hs +1/−2
- src/Serokell/Util/Parse/Network.hs +2/−3
- src/Serokell/Util/Text.hs +17/−26
- src/Serokell/Util/Verify.hs +1/−1
- src/Serokell/Util/Version.hs +45/−0
- test/Test.hs +4/−2
- test/Test/Serokell/Data/Memory/UnitsSpec.hs +8/−6
- test/Test/Serokell/Data/Variant/VariantSpec.hs +21/−23
- test/Test/Serokell/Util/ByteStringSpec.hs +21/−21
- test/Test/Serokell/Util/CommonSpec.hs +18/−18
- test/Test/Serokell/Util/GroupSpec.hs +66/−0
- test/Test/Serokell/Util/TextSpec.hs +15/−19
- test/Test/Serokell/Util/VerifySpec.hs +0/−2
serokell-util.cabal view
@@ -1,5 +1,5 @@ name: serokell-util-version: 0.8.0+version: 0.9.0 synopsis: General-purpose functions by Serokell homepage: https://github.com/serokell/serokell-util license: MIT@@ -20,13 +20,11 @@ library hs-source-dirs: src exposed-modules: Serokell.Arbitrary- Serokell.Aeson.Options Serokell.Data.Memory.Units Serokell.Data.Variant Serokell.Util Serokell.Util.ANSI- Serokell.Util.Base Serokell.Util.Base16 Serokell.Util.Base64 Serokell.Util.Bench@@ -34,14 +32,13 @@ Serokell.Util.Concurrent Serokell.Util.Exceptions Serokell.Util.Group- Serokell.Util.I18N Serokell.Util.Lens- Serokell.Util.OptParse Serokell.Util.Parse Serokell.Util.StaticAssert Serokell.Util.Text Serokell.Util.Trace Serokell.Util.Verify+ Serokell.Util.Version other-modules: Serokell.Data.Variant.Class Serokell.Data.Variant.Helpers@@ -58,38 +55,29 @@ , base64-bytestring , bytestring , clock- , containers >= 0.5.10 , deepseq- , directory , exceptions- , extra- , filepath , fmt , formatting >= 6.2.0 && < 6.3 , hashable >= 1.2.4.0- , lens- , log-warper ^>= 1.8.9- , monad-control+ , microlens+ , microlens-mtl , mtl- , optparse-applicative+ , o-clock ^>= 0.1.1 , parsec+ , process , QuickCheck >= 2.8.1 , quickcheck-instances , scientific- , semigroups- , stm >= 2.4.4 , template-haskell , text , text-format+ , th-lift-instances , transformers , universum ^>= 1.1.0 , unordered-containers >= 0.2.7.0 , vector- , yaml - if impl(ghc >= 8.2.2)- build-depends: o-clock ^>= 0.1- ghc-options: -Wall -fno-warn-orphans default-language: Haskell2010@@ -106,6 +94,7 @@ Test.Serokell.Data.Variant.VariantSpec Test.Serokell.Util.CommonSpec Test.Serokell.Util.ByteStringSpec+ Test.Serokell.Util.GroupSpec Test.Serokell.Util.TextSpec Test.Serokell.Util.VerifySpec Spec@@ -114,15 +103,12 @@ build-tool-depends: hspec-discover:hspec-discover build-depends: aeson >= 1.0 && < 1.4 , base >=4.8- , bytestring+ , extra >= 1.6 , hspec >= 2.1.10 , QuickCheck >= 2.8.1 , quickcheck-instances- , safecopy >= 0.9.0.1 , scientific , serokell-util- , text- , text-format , universum ^>= 1.1.0 , unordered-containers >= 0.2.7.0 , vector@@ -132,4 +118,5 @@ default-extensions: OverloadedStrings , RecordWildCards , DeriveDataTypeable+ , NoImplicitPrelude , GeneralizedNewtypeDeriving
− src/Serokell/Aeson/Options.hs
@@ -1,62 +0,0 @@--- | Options used to derive FromJSON/ToJSON instance. These options--- generally comply to our style regarding names. Of course sometimes--- they don't fit one's needs, so treat them as just sensible--- defaults.--module Serokell.Aeson.Options- ( defaultOptions- , leaveTagOptions- , defaultOptionsPS- ) where--import Universum--import Data.Char (isLower, isPunctuation, isUpper, toLower)-import Data.List (findIndex)--import qualified Data.Aeson.TH as A--headToLower :: String -> String-headToLower [] = error "Can not use headToLower on empty String"-headToLower (x:xs) = toLower x : xs--stripFieldPrefix :: String -> String-stripFieldPrefix = dropWhile (not . isUpper)--dropPunctuation :: String -> String-dropPunctuation = filter (not . isPunctuation)--stripConstructorPrefix :: String -> String-stripConstructorPrefix t =- maybe t (flip drop t . decrementSafe) $ findIndex isLower t- where- decrementSafe 0 = 0- decrementSafe i = i - 1---- | These options do the following transformations:--- 1. Names of field--- records are assumed to be camelCased, `camel` part is removed,--- `Cased` part is converted to `cased`. So `camelCased` becomes--- `cased`. Also all punctuation symbols are dropped before doing it.--- 2. Constructors are assumed to start with some capitalized prefix--- (which finished right before the last capital letter). This prefix--- is dropped and then the first letter is lowercased.-defaultOptions :: A.Options-defaultOptions =- A.defaultOptions- { A.fieldLabelModifier = headToLower . stripFieldPrefix . dropPunctuation- , A.constructorTagModifier = headToLower . stripConstructorPrefix- , A.sumEncoding = A.ObjectWithSingleField- }---- | These options are the same as `defaultOptions`, but they don't--- modify constructor tags.-leaveTagOptions :: A.Options-leaveTagOptions = defaultOptions { A.constructorTagModifier = identity }---- | Options used for communication with PureScript by default.-defaultOptionsPS :: A.Options-defaultOptionsPS =- A.defaultOptions- { A.constructorTagModifier = headToLower . stripConstructorPrefix- }
src/Serokell/Arbitrary.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-} -- | Arbitrary instances for Serokell datatypes module Serokell.Arbitrary@@ -10,7 +8,6 @@ import Universum -import Data.ByteString as BS hiding (zip) import Data.Vector (fromList) import Test.QuickCheck (Arbitrary (..), Gen, choose, frequency, genericShrink, oneof, sized) import Test.QuickCheck.Instances ()@@ -26,7 +23,7 @@ ------------------------------------------------------------------------------------------ instance Arbitrary S.JsonByteString where- arbitrary = S.JsonByteString <$> (arbitrary :: Gen BS.ByteString)+ arbitrary = S.JsonByteString <$> (arbitrary :: Gen ByteString) newtype VariantNoBytes = NoBytes { getVariant :: Variant@@ -41,7 +38,7 @@ shrink = genericShrink instance Arbitrary VariantNoBytes where- arbitrary = NoBytes <$> (sized $ \n -> genVariant (n*50 + 1))+ arbitrary = NoBytes <$> sized (\n -> genVariant (n*50 + 1)) shrink = genericShrink instance Arbitrary Variant where@@ -56,7 +53,7 @@ -- constructor unless given a true boolean flag. genVariant :: Int -> Gen Variant genVariant 1 = genFlatVariant-genVariant n = do+genVariant n = frequency -- No reason for “3”, it just works well. [ (3, genFlatVariant)@@ -67,7 +64,7 @@ ] genFlatVariant :: Gen Variant-genFlatVariant = oneof $+genFlatVariant = oneof [ pure VarNone , VarBool <$> arbitrary , VarInt <$> arbitrary@@ -100,7 +97,7 @@ ------------------------------------------------------------------------------------------ instance Arbitrary V.VerificationRes where- arbitrary = oneof $+ arbitrary = oneof [ pure V.VerSuccess , V.VerFailure <$> arbitrary ]
src/Serokell/Data/Variant/Class.hs view
@@ -8,7 +8,6 @@ import Universum -import Control.Monad.Catch (MonadThrow) import Formatting (build, sformat, (%)) import Serokell.Data.Variant.Variant (Variant (..))
src/Serokell/Data/Variant/Serialization.hs view
@@ -13,7 +13,6 @@ import Serokell.Data.Variant.Variant (VarMap, Variant (..)) import Serokell.Util.Base64 (JsonByteString (JsonByteString))-import Serokell.Util.Text (show') import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HM@@ -33,7 +32,7 @@ -- result type depends on sign (negative ⇒ Int, otherwise UInt). varMapToObject :: VarMap -> Aeson.Object-varMapToObject = HM.fromList . map (bimap show' Aeson.toJSON) . HM.toList+varMapToObject = HM.fromList . map (bimap pretty Aeson.toJSON) . toPairs instance Aeson.ToJSON Variant where toJSON VarNone = Aeson.Null@@ -72,5 +71,5 @@ mapM (\(key,val) -> (VarString key, ) <$> Aeson.parseJSON val) .- HM.toList $+ toPairs $ v
src/Serokell/Data/Variant/Variant.hs view
@@ -12,13 +12,11 @@ import Universum -import Control.DeepSeq (NFData) import Data.Text.Buildable (Buildable (build)) import GHC.Exts (IsList (..)) import Serokell.Util.Text (listBuilderJSONIndent, mapBuilder) -import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V import qualified Serokell.Util.Base16 as B16 @@ -48,7 +46,7 @@ build (VarBytes v) = build . B16.encode $ v build (VarString v) = build v build (VarList v) = listBuilderJSONIndent 2 v- build (VarMap v) = mapBuilder . HM.toList $ v+ build (VarMap v) = mapBuilder . toPairs $ v instance Hashable (Vector Variant) where hashWithSalt salt = V.foldr' (flip hashWithSalt) (hashWithSalt salt ())
src/Serokell/Util.hs view
@@ -12,8 +12,8 @@ import Serokell.Util.Exceptions as Exports import Serokell.Util.Group as Exports import Serokell.Util.Lens as Exports-import Serokell.Util.OptParse as Exports import Serokell.Util.StaticAssert as Exports import Serokell.Util.Text as Exports import Serokell.Util.Trace as Exports import Serokell.Util.Verify as Exports+import Serokell.Util.Version as Exports
− src/Serokell/Util/Base.hs
@@ -1,18 +0,0 @@--- | Util for MonadBaseControl--{-# LANGUAGE FlexibleContexts #-}--module Serokell.Util.Base- ( inCurrentContext- ) where--import Universum--import Control.Monad (void)-import Control.Monad.Trans.Control (MonadBaseControl (..))---- | Remembers monadic context of an action and transforms it to `IO`.--- Note that any changes in context would be lost.-inCurrentContext :: (MonadBaseControl IO m, MonadIO n) => m () -> m (n ())-inCurrentContext action =- liftBaseWith $ \runInIO -> return . liftIO . void $ runInIO action
src/Serokell/Util/Base16.hs view
@@ -15,10 +15,11 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.Text.Encoding as TE+import qualified Fmt as Fmt -- | Apply base16 encoding to strict ByteString. encode :: BS.ByteString -> Text-encode = TE.decodeUtf8 . B16.encode+encode = Fmt.fmt . Fmt.hexF -- | Decode base16-encoded ByteString. decode :: Text -> Either Text BS.ByteString
src/Serokell/Util/Base64.hs view
@@ -8,7 +8,6 @@ , formatBase64 , base64F , JsonByteString (..)- , JsonByteStringDeprecated (..) ) where import Universum hiding (fail)@@ -22,10 +21,10 @@ import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64.URL as B64url-+import qualified Fmt as Fmt -- | Apply base64 encoding to strict ByteString. encode :: ByteString -> Text-encode = decodeUtf8 . B64.encode+encode = Fmt.fmt . Fmt.base64F -- | Decode base64-encoded ByteString. decode :: Text -> Either Text ByteString@@ -33,7 +32,7 @@ -- | Apply base64url encoding to strict ByteString. encodeUrl :: ByteString -> Text-encodeUrl = decodeUtf8 . B64url.encode+encodeUrl = Fmt.fmt . Fmt.base64UrlF -- | Decode base64url-encoded ByteString. decodeUrl :: Text -> Either Text ByteString@@ -71,19 +70,3 @@ jsonBSParser :: MonadFail m => Text -> m JsonByteString jsonBSParser = either (fail . toString) (pure . JsonByteString) . decode--------------------------------------------------------------------------------- Deprecated-------------------------------------------------------------------------------newtype JsonByteStringDeprecated = JsonByteStringDeprecated- { getJsonByteStringDeprecated :: ByteString- }--instance ToJSON JsonByteStringDeprecated where- toJSON = toJSON . encodeUrl . getJsonByteStringDeprecated--instance FromJSON JsonByteStringDeprecated where- parseJSON =- parseJSON >=>- either (fail . toString) (pure . JsonByteStringDeprecated) . decodeUrl
src/Serokell/Util/Bench.hs view
@@ -5,9 +5,6 @@ -- | Benchmark related utils. module Serokell.Util.Bench-#if ( __GLASGOW_HASKELL__ < 802 )- ( ) where-#else ( getWallTime , getCpuTime , ElapsedTime (..)@@ -72,4 +69,3 @@ perSecond n time = fromRational $ toRational n / (fromIntegral (max 1 $ toNanoSecs time) * 1.0e9)-#endif
src/Serokell/Util/Common.hs view
@@ -12,7 +12,7 @@ import Universum -import Data.List (genericDrop, genericIndex, genericLength, genericTake, sort)+import Data.List (genericIndex) import GHC.Exts (build) -- | Enumerate function is analogous to python's enumerate. It
− src/Serokell/Util/I18N.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}--module Serokell.Util.I18N- ( Translations- , fromYaml- , replaceTranslations- , YamlMapKey- , ToReplaceToken(..)- ) where--import Universum--import Data.Yaml (decodeEither)-import Formatting (build, sformat, (%))-import GHC.Generics (Generic, Rep)-import Serokell.Aeson.Options (defaultOptions)--import qualified Data.Aeson as AT-import qualified Data.Map.Strict as M-import qualified Data.Text as T---- It's better to get rid of aeson-extra depricated things here, but--- aeson-1.0.0.0 structure of FromJSONKey requires fromJSONKeyList--- which is unobvious to implement.-class (Eq a, Ord a, AT.FromJSONKey a, AT.FromJSON a) => YamlMapKey a--#if MIN_VERSION_aeson(1,0,0)-instance (Eq a,- Ord a,- Generic a,- AT.GFromJSON AT.Zero (Rep a),- AT.FromJSONKey a,- AT.FromJSON a) =>-#else-instance (Eq a, Ord a, Generic a, AT.GFromJSON (Rep a)) =>-#endif- YamlMapKey a--type Translations lang token = M.Map lang (M.Map token Text)--fromYaml :: (YamlMapKey lang, YamlMapKey token)- => ByteString- -> Translations lang token-fromYaml yamlStr =- either- (error . sformat ("Error during translation YAML parsing " % build))- identity $- decodeEither yamlStr--class (Ord a, Eq a) => ToReplaceToken a where- toReplaceToken :: a -> Text--#if MIN_VERSION_aeson(1,0,0)-instance (Ord a, Eq a, Generic a, AT.GToJSON AT.Zero (Rep a)) => ToReplaceToken a where- toReplaceToken = (\(AT.String s) -> s) . AT.genericToJSON defaultOptions-#else-instance (Ord a, Eq a, Generic a, AT.GToJSON (Rep a)) => ToReplaceToken a where- toReplaceToken = (\(AT.String s) -> s) . AT.genericToJSON defaultOptions-#endif--replaceTranslations- :: (ToReplaceToken token, Ord lang)- => Translations lang token -> lang -> Text -> Maybe Text-replaceTranslations translations lang text =- M.foldrWithKey- (\token ->- T.replace $ "{{" `T.append` toReplaceToken token `T.append` "}}")- text <$>- lang `M.lookup` translations
src/Serokell/Util/Lens.hs view
@@ -5,20 +5,19 @@ module Serokell.Util.Lens ( (%%=) , (%?=)- , WrappedM (..)- , _UnwrappedM , zoom' , magnify'- , listL ) where import Universum +import Control.Monad.Identity (Identity) import Control.Monad.Trans.Except (ExceptT, mapExceptT)-import GHC.Exts (IsList (..))-import System.Wlog (LoggerName, LoggerNameBox (..))+import Lens.Micro.Mtl ((.=)) -import qualified Control.Lens as L+import Lens.Micro as L+import Lens.Micro.Mtl as LM+import Lens.Micro.Mtl.Internal as LMI -- I don't know how to call these operators @@ -26,9 +25,9 @@ infix 4 %%= (%%=) :: L.Lens' s a -> State a b -> State s b (%%=) l ma = do- attr <- L.view l <$> get+ attr <- LM.view l <$> get let (res,newAttr) = runState ma attr- l L..= newAttr+ l .= newAttr return res -- | Like %%= but with possiblity of failure@@ -36,26 +35,6 @@ (%?=) :: L.Lens' s a -> ExceptT t (State a) b -> ExceptT t (State s) b (%?=) l = mapExceptT (l %%=) --- | Similar to `Wrapped`, but for `Monad`s.-class Monad m => WrappedM m where- type UnwrappedM m :: * -> *-- _WrappedM :: L.Iso' (m a) (UnwrappedM m a)- _WrappedM = L.iso packM unpackM-- packM :: m a -> UnwrappedM m a- packM = L.view _WrappedM-- unpackM :: UnwrappedM m a -> m a- unpackM = L.view _UnwrappedM--_UnwrappedM :: WrappedM m => L.Iso' (UnwrappedM m a) (m a)-_UnwrappedM = L.from _WrappedM--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@@ -63,25 +42,21 @@ -- 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+ => L.LensLike' (LMI.Zoomed (State s) a) s t+ -> StateT t Identity a -> m a-zoom' l = state . runState . L.zoom l+zoom' l = state . runState . LM.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+ => L.LensLike' (LMI.Magnified (Reader s) a) s t+ -> ReaderT t Identity a -> m a-magnify' l = reader . runReader . L.magnify l+magnify' l = reader . runReader . LM.magnify l -- | This isomorphism can be used to convert to or from an instance of 'IsList'. -- -- Note that this function is quite general but doesn't allow to switch -- container - in most cases such behavious eliminates need in specifing -- container type manually.-listL- :: (IsList (t a), IsList (t b))- => L.Iso (t a) (t b) [Item (t a)] [Item (t b)]-listL = L.iso GHC.Exts.toList fromList
− src/Serokell/Util/OptParse.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}---- | Some useful helper for optparse-applicative library--module Serokell.Util.OptParse- ( fromStr- , strArgument- , strOption- , fromParsec- ) where--import Universum--import Data.String (IsString (fromString))-import Options.Applicative (ArgumentFields, Mod, OptionFields, Parser, ReadM, argument,- eitherReader, option, str)-import Text.Parsec (Parsec, parse)---- | Reader which uses IsString instance for parsing-fromStr :: IsString s => ReadM s-fromStr = fromString <$> str---- | Parse argument using IsString instance-strArgument :: IsString s => Mod ArgumentFields s -> Parser s-strArgument = argument fromStr---- | Parse option using IsString instance-strOption :: IsString s => Mod OptionFields s -> Parser s-strOption = option fromStr--fromParsec :: Parsec Text () a -> ReadM a-fromParsec parser =- eitherReader $ first show . parse parser "<CLI options>" . toText
src/Serokell/Util/Parse/Base64.hs view
@@ -9,7 +9,6 @@ import Universum hiding (fail) -import Control.Applicative (many, some, (<|>)) import Control.Monad (fail) import Text.Parsec.Char (char)
src/Serokell/Util/Parse/Common.hs view
@@ -16,7 +16,6 @@ import Universum hiding (fail) -import Control.Applicative (some) import Control.Monad (fail) import Prelude (read) import Text.Parsec (ParsecT, Stream, option, satisfy)@@ -28,7 +27,7 @@ isAsciiAlpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') isAsciiNum :: Char -> Bool-isAsciiNum c = (c >= '0' && c <= '9')+isAsciiNum c = c >= '0' && c <= '9' isAsciiAlphaNum :: Char -> Bool isAsciiAlphaNum c = isAsciiAlpha c || isAsciiNum c
src/Serokell/Util/Parse/Network.hs view
@@ -18,8 +18,7 @@ import Universum hiding (fail, try) -import Control.Applicative (some, (<|>))-import Control.Monad (fail, liftM, void)+import Control.Monad (fail) import Text.Parsec (choice, count, oneOf, option, try, (<?>)) import Text.Parsec.Char (alphaNum, char, hexDigit, string) @@ -31,7 +30,7 @@ deriving(Show, Eq, Ord) concatSequence :: (Monad m) => [m [a]] -> m [a]-concatSequence = liftM concat . sequence+concatSequence = fmap concat . sequence port :: CharParser Word16 port = fromIntegral <$> limitedInt 65535 "Port number to large"
src/Serokell/Util/Text.hs view
@@ -7,9 +7,7 @@ module Serokell.Util.Text ( -- * @formatting@ utilities- show- , show'- , FPFormat (..)+ FPFormat (..) , showFloat , showFloat' , showFixedPretty'@@ -51,30 +49,24 @@ , readUnsignedDecimal ) where -import qualified Universum as U+import Prelude -import qualified Data.Text as T-import Data.Text.Buildable (Buildable (build))-import qualified Data.Text.Format as F-import Data.Text.Format.Params (Params)-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Lazy.Builder.Int as B-import Data.Text.Lazy.Builder.RealFloat (FPFormat (Exponent, Fixed, Generic))-import qualified Data.Text.Lazy.Builder.RealFloat as B-import qualified Data.Text.Read as T-import Formatting (Format, fixed, later, sformat)-import GHC.Exts (IsList (..))-import Prelude hiding (show, showList)-import Serokell.Util.Common (chunksOf)+import Data.Text.Buildable (Buildable (build))+import Data.Text.Format.Params (Params)+import Data.Text.Lazy.Builder.RealFloat (FPFormat (Exponent, Fixed, Generic))+import Formatting (Format, fixed, later, sformat)+import GHC.Exts (IsList (..)) -show :: Buildable a- => a -> LT.Text-show = B.toLazyText . build+import Serokell.Util.Common (chunksOf) -show' :: Buildable a- => a -> T.Text-show' = LT.toStrict . show+import qualified Data.Text as T+import qualified Data.Text.Format as F+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Text.Lazy.Builder.Int as B+import qualified Data.Text.Lazy.Builder.RealFloat as B+import qualified Data.Text.Read as T+import qualified Universum as U -- | Render a floating point number using normal notation, with the -- given number of decimal places. This function also truncates@@ -169,8 +161,7 @@ :: (Foldable t, Buildable a) => Word -> t a -> B.Builder listBuilderJSONIndent _ as | null as = "[]"-listBuilderJSONIndent indent as- | otherwise =+listBuilderJSONIndent indent as = listBuilder ("[\n" `LT.append` spaces) delimiter ("\n]" :: B.Builder)
src/Serokell/Util/Verify.hs view
@@ -101,5 +101,5 @@ verResToMonadError :: MonadError e m => (NonEmpty Text -> e) -> VerificationRes -> m ()-verResToMonadError _ VerSuccess = pure ()+verResToMonadError _ VerSuccess = pass verResToMonadError f (VerFailure errors) = throwError $ f errors
+ src/Serokell/Util/Version.hs view
@@ -0,0 +1,45 @@+module Serokell.Util.Version+ ( -- * Git revision+ retrieveGitRev+ ) where++import Universum++import Instances.TH.Lift ()+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..))+import System.Process (readProcessWithExitCode)++import qualified Data.Text as Text+import qualified Language.Haskell.TH as TH+import qualified Language.Haskell.TH.Syntax as TH++{- | Gets the git revision.+For example, you can use it configuring CLI options:++@+versionOption = infoOption+ ("Git revision: " <> toString $(retrieveGitRev))+ (long "version" <> help "Show version")+@++You'll need @-XTemplateHaskell@.++Also note, that in order to see the latest git revision for the latest commit+you should force recompilation of the file which contains @$(retrieveGitRev)@.+-}+retrieveGitRev :: TH.Q TH.Exp+retrieveGitRev = do+ cti <- TH.runIO $ Text.strip . fromString <$> retrieveGit+ TH.lift cti+ where+ retrieveGit :: IO String+ retrieveGit = whenNothingM (lookupEnv "GITREV") retrieveFromGitExecutable++ retrieveFromGitExecutable :: IO String+ retrieveFromGitExecutable = do+ (exitCode, output, _) <-+ readProcessWithExitCode "git" ["rev-parse", "--verify", "HEAD"] ""+ pure $ case exitCode of+ ExitSuccess -> output+ _ -> fail "Couldn't retrieve 'git' revision"
test/Test.hs view
@@ -1,5 +1,7 @@-import Spec (spec)-import Test.Hspec (hspec)+import Universum++import Spec (spec)+import Test.Hspec (hspec) main :: IO () main = hspec spec
test/Test/Serokell/Data/Memory/UnitsSpec.hs view
@@ -1,20 +1,22 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-} module Test.Serokell.Data.Memory.UnitsSpec ( spec ) where -import Test.Hspec (Spec, describe)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck ((===))+import Universum -import Serokell.Arbitrary ()+import Test.Hspec (Spec, describe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck ((===))++import Serokell.Arbitrary ()+ import qualified Serokell.Data.Memory.Units as S spec :: Spec-spec = describe "Unit conversion" $ do+spec = describe "Unit conversion" $ describe "Identity Properties" $ do prop "Byte" $ \(a :: S.Byte) -> a === bytesMid a
test/Test/Serokell/Data/Variant/VariantSpec.hs view
@@ -5,38 +5,39 @@ ( spec ) where -import qualified Data.Aeson as A (decode, encode)-import qualified Data.HashMap.Lazy as HM (elems, fromList, keys)-import Data.Scientific (floatingOrInteger, fromFloatDigits)-import Data.Text (unpack)-import qualified Data.Vector as V (map)-import Test.Hspec (Spec, describe)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck ((===))+import Universum -import Serokell.Arbitrary (VariantNoBytes (..), VariantOnlyBytes (..))+import Data.Scientific (floatingOrInteger, fromFloatDigits)+import Test.Hspec (Spec, describe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck ((===))++import Serokell.Arbitrary (VariantNoBytes (..), VariantOnlyBytes (..))++import qualified Data.Aeson as A (decode, encode)+import qualified Data.HashMap.Lazy as HM (fromList)+import qualified Data.Vector as V (map) import qualified Serokell.Data.Variant as S-import qualified Serokell.Util.Base64 as S-import Serokell.Util.Text (show')+import qualified Serokell.Util.Base64 as S spec :: Spec-spec = describe "Variant" $ do- describe "Identity Properties" $ do+spec = describe "Variant" $+ describe "Identity Properties" $ describe "JSON" $ do prop "Variant (No VarBytes)" $- \(getVariant -> a) -> (jsonFixer a) === jsonMid a+ \(getVariant -> a) -> jsonFixer a === jsonMid a prop "Variant (Only VarBytes)" $- \(getVarBytes -> a) -> a === (bytesFun $ jsonMid a)+ \(getVarBytes -> a) -> a === bytesFun (jsonMid a) jsonFixer :: S.Variant -> S.Variant-jsonFixer (S.VarMap m) = let ks = map toStr $ HM.keys m- vs = map jsonFixer $ HM.elems m+jsonFixer (S.VarMap m) = let ks = map toStr $ keys m+ vs = map jsonFixer $ elems m m' = HM.fromList $ zip ks vs in S.VarMap m' jsonFixer (S.VarList l) = S.VarList $ V.map jsonFixer l jsonFixer v@(S.VarInt i) = if i < 0 then v- else (S.VarUInt $ fromIntegral i)+ else S.VarUInt $ fromIntegral i jsonFixer (S.VarFloat f) = case floatingOrInteger $ fromFloatDigits f of Left float -> S.VarFloat float@@ -45,10 +46,7 @@ jsonFixer v = v toStr :: S.Variant -> S.Variant-toStr var = stringVar var- where- stringVar :: S.Variant -> S.Variant- stringVar = S.VarString . show'+toStr = S.VarString . pretty jsonMid :: S.Variant -> S.Variant jsonMid = maybe err id . A.decode . A.encode@@ -58,5 +56,5 @@ bytesFun :: S.Variant -> S.Variant bytesFun (S.VarString s) = S.VarBytes right where- right = either (error . unpack) id $ S.decode s+ right = either error id $ S.decode s bytesFun _ = error "[bytesFun:] called with Variant that was not VarBytes"
test/Test/Serokell/Util/ByteStringSpec.hs view
@@ -1,41 +1,41 @@ {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-} module Test.Serokell.Util.ByteStringSpec ( spec ) where -import Data.Aeson (decode, encode)-import qualified Data.ByteString as BS-import Data.Maybe (fromJust)-import Test.Hspec (Spec, describe)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck ((===))-import Test.QuickCheck.Instances ()+import Universum -import Serokell.Arbitrary ()-import qualified Serokell.Util.Base16 as C16-import qualified Serokell.Util.Base64 as C64+import Data.Aeson (decode, encode)+import Test.Hspec (Spec, describe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck ((===))+import Test.QuickCheck.Instances () +import Serokell.Arbitrary ()++import qualified Serokell.Util.Base16 as C16+import qualified Serokell.Util.Base64 as C64+import qualified Universum.Unsafe as Unsafe (fromJust)+ spec :: Spec spec =- describe "Serialization" $ do+ describe "Serialization" $ describe "Indentity Properties" $ do prop "Base16" $- \(a :: BS.ByteString) -> a === base16Mid a+ \(a :: ByteString) -> a === base16Mid a prop "Base64" $- \(a :: BS.ByteString) -> a === base64Mid a+ \(a :: ByteString) -> a === base64Mid a prop "JSON Base64" $ \(a :: C64.JsonByteString) -> a === base64JSONMid a base16Mid,- base64Mid :: BS.ByteString -> BS.ByteString-base16Mid = fromRight . C16.decode . C16.encode-base64Mid = fromRight . C64.decode . C64.encode+ base64Mid :: ByteString -> ByteString+base16Mid = fromRightBS . C16.decode . C16.encode+base64Mid = fromRightBS . C64.decode . C64.encode base64JSONMid :: C64.JsonByteString -> C64.JsonByteString-base64JSONMid = fromJust . decode . encode+base64JSONMid = Unsafe.fromJust . decode . encode -fromRight :: Either a BS.ByteString -> BS.ByteString-fromRight (Left _) = error "failed decoding to ByteString"-fromRight (Right b) = b+fromRightBS :: Either a ByteString -> ByteString+fromRightBS = fromRight (error "failed decoding to ByteString")
test/Test/Serokell/Util/CommonSpec.hs view
@@ -5,18 +5,18 @@ ( spec ) where -import Data.Foldable (toList)-import Data.List (genericIndex, genericLength,- intersect)-import Data.Vector (Vector)-import Test.Hspec (Spec, describe)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Arbitrary (..), Gen,- NonEmptyList (..), oneof)-import Test.QuickCheck.Instances ()+import Universum hiding (show, toList) -import qualified Serokell.Util.Common as C+import Data.Foldable (toList)+import Data.List (genericIndex, intersect)+import Prelude (show)+import Test.Hspec (Spec, describe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary (..), Gen, NonEmptyList (..), oneof)+import Test.QuickCheck.Instances () +import qualified Serokell.Util.Common as C+ spec :: Spec spec = describe "Common" $ do@@ -43,7 +43,7 @@ type Value = Int data SomeTraversable =- forall t. (Traversable t, Show (t Value), Arbitrary (t Value)) =>+ forall t. (Container (t Value), Traversable t, Show (t Value), Arbitrary (t Value)) => SomeTraversable (t Value) instance Show SomeTraversable where@@ -65,19 +65,19 @@ indexModuloCorrectIndex :: NonEmptyList Int -> Int -> Bool-indexModuloCorrectIndex (getNonEmpty -> list) ind =- let len = genericLength list- atModuloIndex = list `genericIndex` (ind `mod` len)- in atModuloIndex == C.indexModulo list ind+indexModuloCorrectIndex (getNonEmpty -> lst) ind =+ let len = genericLength lst+ atModuloIndex = lst `genericIndex` (ind `mod` len)+ in atModuloIndex == C.indexModulo lst ind indexedSublistWhenNegative :: (Int, Int) -> [Int] -> Bool-indexedSublistWhenNegative (lo, hi) list+indexedSublistWhenNegative (lo, hi) lst | hi <= lo = indexList lo hi == [] | hi <= 0 = indexList lo hi == [] | len -1 < lo = indexList lo hi == [] | otherwise = testIndexes lo hi == indexList lo hi where- len = length list- indexList l h = map fst $ C.indexedSubList (l, h) list+ len = length lst+ indexList l h = map fst $ C.indexedSubList (l, h) lst testIndexes l h = intersect [l .. h - 1] [0 .. len - 1]
+ test/Test/Serokell/Util/GroupSpec.hs view
@@ -0,0 +1,66 @@+module Test.Serokell.Util.GroupSpec+ ( spec+ ) where++import Universum++import Data.List.Extra (nubOn)+import Test.Hspec (Spec, describe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck.Instances ()++import Serokell.Util.Group++spec :: Spec+spec =+ describe "Group" $ do+ describe "'groupBy' doesn't throw elements away" $ do+ prop "with id" groupByIdProp+ prop "with even" groupByEvenProp+ prop "with mod" groupByModProp+ prop "with fst" groupByFstProp+ describe "'groupMapBy' behaves like 'nubOn'" $ do+ prop "with id" groupMapByIdProp+ prop "with even" groupMapByEvenProp+ prop "with mod" groupMapByModProp+ prop "with fst" groupMapByFstProp+++----------------------------------------------------------------------------+-- GroupBy+----------------------------------------------------------------------------++-- | Check that 'groupBy' doesn't throw elements away+groupByProp :: (Ord a, Eq b, Hashable b) => (a -> b) -> NonEmpty a -> Bool+groupByProp f l = foldMap toList (elems (groupBy f l)) ~=~ toList l++groupByIdProp, groupByEvenProp, groupByModProp :: NonEmpty Int -> Bool+groupByIdProp = groupByProp id+groupByEvenProp = groupByProp even+groupByModProp = groupByProp (`mod` 100)++groupByFstProp :: NonEmpty (Int, Int) -> Bool+groupByFstProp = groupByProp fst++----------------------------------------------------------------------------+-- GroupMapBy+----------------------------------------------------------------------------++-- | Checks that 'groupMapBy' behaves like 'nubOn'.+groupMapByProp :: (Ord a, Eq b, Hashable b) => (a -> b) -> [a] -> Bool+groupMapByProp f l = elems (groupMapBy f l) ~=~ nubOn f l++groupMapByIdProp, groupMapByEvenProp, groupMapByModProp :: [Int] -> Bool+groupMapByIdProp = groupMapByProp id+groupMapByEvenProp = groupMapByProp even+groupMapByModProp = groupMapByProp (`mod` 100)++groupMapByFstProp :: [(Int, Int)] -> Bool+groupMapByFstProp = groupMapByProp fst++----------------------------------------------------------------------------++-- | Sorts lists before comparing them.+infix 4 ~=~+(~=~) :: (Ord a) => [a] -> [a] -> Bool+l1 ~=~ l2 = sort l1 == sort l2
test/Test/Serokell/Util/TextSpec.hs view
@@ -1,38 +1,34 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-} module Test.Serokell.Util.TextSpec ( spec ) where -import Data.Int (Int64)-import Data.Text.Buildable (Buildable)-import Data.Word (Word64)+import Universum -import Test.Hspec (Spec, describe)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck ((===))-import Test.QuickCheck.Instances ()+import Test.Hspec (Spec, describe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck ((===))+import Test.QuickCheck.Instances () -import qualified Serokell.Util.Text as S+import qualified Serokell.Util.Text as S spec :: Spec spec =- describe "Text Show/Read" $ do- describe "Indentity Properties" $ do+ describe "Text Show/Read" $+ describe "Indentity Properties" $ describe "readDecimal" $ do prop "Int" $- \(a :: Int) -> (Right a) === showReadIntegral a+ \(a :: Int) -> Right a === showReadIntegral a prop "Integer" $- \(a :: Integer) -> (Right a) === showReadIntegral a+ \(a :: Integer) -> Right a === showReadIntegral a prop "Word" $- \(a :: Word) -> (Right a) === showReadIntegral a+ \(a :: Word) -> Right a === showReadIntegral a prop "Int64" $- \(a :: Int64) -> (Right a) === showReadIntegral a+ \(a :: Int64) -> Right a === showReadIntegral a prop "Word64" $- \(a :: Word64) -> (Right a) === showReadIntegral a+ \(a :: Word64) -> Right a === showReadIntegral a -showReadIntegral- :: (Buildable a, Integral a) => a -> Either String a-showReadIntegral = S.readDecimal . S.show'+showReadIntegral :: (Buildable a, Integral a) => a -> Either String a+showReadIntegral = S.readDecimal . pretty
test/Test/Serokell/Util/VerifySpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-}- module Test.Serokell.Util.VerifySpec ( spec ) where