hydrogen-prelude 0.17 → 0.20
raw patch · 5 files changed
Files
- CHANGELOG.md +12/−0
- Setup.hs +2/−0
- hydrogen-prelude.cabal +32/−28
- src/Hydrogen/Prelude.hs +180/−83
- src/Hydrogen/Prelude/System.hs +19/−19
CHANGELOG.md view
@@ -92,3 +92,15 @@ ## v0.17 + Removed instance `MonadPlus m => Default (m a)`.++## v0.18++ Removed dependency on `nicify`++## v0.19++ Removed `Apply` and `Applicator` again++ Lowered dependencies to work with GHC 7.6 and base 4.6 too++## v0.20++ Support for GHC 7.4, 7.6, and 7.8++ Instances for `Serializable` but also for `Binary`+
Setup.hs view
@@ -1,2 +1,4 @@ import Distribution.Simple+ main = defaultMain+
hydrogen-prelude.cabal view
@@ -1,5 +1,5 @@ name: hydrogen-prelude-version: 0.17+version: 0.20 homepage: http://scravy.de/hydrogen-prelude/ synopsis: Hydrogen Prelude license: MIT@@ -12,33 +12,43 @@ cabal-version: >=1.14 source-repository head- type: git- location: https://github.com/scravy/hydrogen-prelude+ type: git+ location: https://github.com/scravy/hydrogen-prelude +flag explicitText+ library exposed-modules: Hydrogen.Prelude , Hydrogen.Prelude.IO , Hydrogen.Prelude.Network , Hydrogen.Prelude.System- build-depends: base >=4.6 && <5- , array ==0.5.*- , cereal ==0.4.*- , containers ==0.5.*- , directory ==1.2.*- , filepath ==1.3.*- , hashable ==1.2.*- , hydrogen-multimap ==0.1- , hydrogen-version >=1.3- , network >=2.4.2.2- , nicify- , process ==1.2.*- , random ==1.0.*- , regex-base ==0.93.*- , regex-tdfa ==1.2.*- , strict ==0.3.*- , time ==1.4.*- , transformers ==0.3.*- , uuid ==1.3.*+ build-depends: base >=4.5 && <5+ , array >=0.4+ , binary >=0.5.1+ , bytestring >=0.9.2.1+ , cereal >=0.4.1.1+ , containers >=0.4.2.1+ , directory >=1.1+ , filepath >=1.3+ , hashable >=1.1+ , hydrogen-multimap >=0.3+ , hydrogen-version >=1.4+ , network >=2.3+ , process >=1.1.0.1+ , random >=1.0.1.1+ , regex-base >=0.93.1+ , regex-tdfa >=1.2+ , strict >=0.3+ , text >=0.11.2+ , time >=1.4+ , transformers >=0.3+ , uuid >=1.3+ if impl(ghc <= 7.6)+ build-depends: ghc-prim+ , text <1.2.0.4+ if impl(ghc >= 7.6)+ build-depends: binary >=0.7+ hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010@@ -48,19 +58,13 @@ , DeriveFunctor , DeriveGeneric , DeriveTraversable- , EmptyCase , FlexibleInstances , FlexibleContexts , GADTs- , LambdaCase , MultiParamTypeClasses- , MultiWayIf- , NegativeLiterals , NoImplicitPrelude , PackageImports- , RankNTypes , RecordWildCards , ScopedTypeVariables , StandaloneDeriving- , TupleSections , TypeFamilies
src/Hydrogen/Prelude.hs view
@@ -24,7 +24,6 @@ , module Data.Maybe , module Data.Ord , module Data.Ratio- , module Data.Serialize , module Data.String , module Data.Time , module Data.Time.Calendar.OrdinalDate@@ -51,7 +50,6 @@ , (<$$$$$>) , uuidFromString , randomUUID- , nicify , safeHead , safeHeadAndTail , safeHeadAndTail2@@ -61,6 +59,18 @@ , uncurry5 , map , UUID+ , ByteString+ , LazyByteString+ , Serialize+ , encode+ , encodeLazy+ , decode+ , decodeLazy+ , Binary+ , binaryEncode+ , binaryDecode+ , binaryEncodeFile+ , binaryDecodeFile , Generic , List , Map@@ -72,8 +82,6 @@ , Has (..) , Container (..) , Default (..)- , Apply (..)- , Applicator , __ ) where @@ -99,6 +107,10 @@ , sequence , sequence_ , sum+#if MIN_VERSION_base(4,6,0)+#else+ , catch+#endif ) import "base" Control.Applicative@@ -116,8 +128,12 @@ import "array" Data.Array hiding ((!)) import qualified "array" Data.Array as Array +import "binary" Data.Binary (Binary)+import qualified "binary" Data.Binary as Binary import "base" Data.Bits hiding (bitSize) import "base" Data.Bool+import "bytestring" Data.ByteString (ByteString)+import qualified "bytestring" Data.ByteString.Lazy as LazyByteString import "base" Data.Char import "base" Data.Complex import "base" Data.Dynamic@@ -158,7 +174,8 @@ import "base" Data.Maybe import "base" Data.Ord import "base" Data.Ratio-import "cereal" Data.Serialize+import "cereal" Data.Serialize (Serialize)+import qualified "cereal" Data.Serialize as Serialize import "base" Data.String import "time" Data.Time import "time" Data.Time.Calendar.OrdinalDate@@ -167,13 +184,16 @@ import "base" Data.Typeable import "base" Data.Word +#if MIN_VERSION_base(4,6,0) import "base" GHC.Generics (Generic)+#else+import "ghc-prim" GHC.Generics (Generic)+#endif import "base" Numeric import "base" Text.Printf import "regex-tdfa" Text.Regex.TDFA-import "nicify" Text.Nicify (nicify) import "containers" Data.Map (Map) import qualified "containers" Data.Map as Map@@ -191,6 +211,17 @@ import qualified "uuid" Data.UUID.V4 +-----------------------------------------------------------------------+-- Lazy type aliases+-----------------------------------------------------------------------++type LazyByteString = LazyByteString.ByteString+++-----------------------------------------------------------------------+-- Generic instances+-----------------------------------------------------------------------+ deriving instance Eq ZonedTime deriving instance Generic Day deriving instance Generic LocalTime@@ -199,39 +230,129 @@ deriving instance Generic UniversalTime deriving instance Generic ZonedTime ++-----------------------------------------------------------------------+-- Serialize & Binary instances+-----------------------------------------------------------------------+ instance Serialize Day-instance Serialize LocalTime-instance Serialize TimeOfDay+instance Binary Day+ instance Serialize TimeZone+instance Binary TimeZone+ instance Serialize UniversalTime+instance Binary UniversalTime+ instance Serialize Version+instance Binary Version++#if MIN_VERSION_base(4,7,0)+instance Serialize LocalTime+instance Binary LocalTime++instance Serialize TimeOfDay+instance Binary TimeOfDay+ instance Serialize ZonedTime+instance Binary ZonedTime instance Serialize (Fixed E12) where- put (MkFixed int) = put int+ put (MkFixed int) = Serialize.put int - get = MkFixed <$> get+ get = MkFixed <$> Serialize.get +instance Binary (Fixed E12) where+ put (MkFixed int) = Binary.put int++ get = MkFixed <$> Binary.get+#endif+ instance Serialize UUID where - put uuid = do- let p = putWord32be- (w1, w2, w3, w4) = Data.UUID.toWords uuid- p w1 >> p w2 >> p w3 >> p w4+ put uuid = p w1 >> p w2 >> p w3 >> p w4+ where+ p = Serialize.putWord32be+ (w1, w2, w3, w4) = Data.UUID.toWords uuid - get = let g = getWord32be in liftM4 Data.UUID.fromWords g g g g- + get = liftM4 Data.UUID.fromWords g g g g+ where+ g = Serialize.getWord32be++-- instance Binary UUID is already provided by UUID package+++-----------------------------------------------------------------------+-- Data.Serialize+-----------------------------------------------------------------------++encode :: Serialize a => a -> ByteString+-- ^ Encode a value using binary serialization to a strict ByteString.+encode = Serialize.encode++encodeLazy :: Serialize a => a -> LazyByteString+-- ^ Encode a value using binary serialization to a lazy ByteString.+encodeLazy = Serialize.encodeLazy++decode :: Serialize a => ByteString -> Either String a+-- ^ Decode a value from a strict ByteString, reconstructing the+-- original structure.+decode = Serialize.decode++decodeLazy :: Serialize a => LazyByteString -> Either String a+-- ^ Decode a value from a lazy ByteString, reconstructing the+-- original structure.+decodeLazy = Serialize.decodeLazy+++-----------------------------------------------------------------------+-- Data.Binary+-----------------------------------------------------------------------++binaryEncode :: Binary a => a -> LazyByteString+-- ^ Encode a value using binary serialisation to a lazy ByteString.+binaryEncode = Binary.encode++binaryDecode :: Binary a => LazyByteString -> a+-- ^ Decode a value from a lazy ByteString, reconstructing the+-- original structure.+binaryDecode = Binary.decode++binaryEncodeFile :: Binary a => FilePath -> a -> IO ()+-- ^ Lazily serialise a value to a file.+binaryEncodeFile = Binary.encodeFile++binaryDecodeFile :: Binary a => FilePath -> IO a+-- ^ Decode a value from a file. In case of errors, error will be+-- called with the error message.+binaryDecodeFile = Binary.decodeFile+++-----------------------------------------------------------------------+-- ShowBox+-----------------------------------------------------------------------+ data ShowBox where ShowBox :: forall a. (Show a) => a -> ShowBox instance Show ShowBox where show (ShowBox a) = show a ++-----------------------------------------------------------------------+-- Composition of boolean functions+-----------------------------------------------------------------------+ (.|), (.&), (.^) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool) f .| g = \x -> f x || g x f .& g = \x -> f x && g x f .^ g = \x -> f x /= g x ++-----------------------------------------------------------------------+-- Nice shorthands & operators+-----------------------------------------------------------------------+ (|>) :: a -> (a -> b) -> b -- ^ @flip ('$')@ (|>) = flip ($)@@ -240,6 +361,11 @@ -- ^ A shorthand for 'undefined'. __ = error "Hydrogen.Prelude.undefined" ++-----------------------------------------------------------------------+-- UUID functions+-----------------------------------------------------------------------+ uuidFromString :: String -> Maybe UUID uuidFromString = Data.UUID.fromString @@ -247,26 +373,36 @@ -- ^ Produces a random V4 UUID (alias for 'Data.UUID.V4.nextRandom'). randomUUID = Data.UUID.V4.nextRandom ++-----------------------------------------------------------------------+-- Safe functions+-----------------------------------------------------------------------+ safeHead :: a -- ^ The default value for the case of the empty list. -> [a] -- ^ The list. -> a -- ^ Returns the head of the list or the default value.-safeHead default_ = \case+safeHead default_ = \z -> case z of x : _ -> x _ -> default_ safeHeadAndTail :: a -> [a] -> (a, [a])-safeHeadAndTail default_ = \case+safeHeadAndTail default_ = \z -> case z of x : xs -> (x, xs) _ -> (default_, []) safeHeadAndTail2 :: a -> a -> [a] -> (a, a, [a])-safeHeadAndTail2 d1 d2 = \case+safeHeadAndTail2 d1 d2 = \z -> case z of x : y : xs -> (x, y, xs) x : xs -> (x, d2, xs) xs -> (d1, d2, xs) ++-----------------------------------------------------------------------+-- firstJust+-----------------------------------------------------------------------+ firstJust :: [a -> Maybe b] -> a -> Maybe b -- ^ Applies a bunch of functions on a given value, -- returns the first result that is not Nothing@@ -276,6 +412,11 @@ x -> x firstJust [] _ = Nothing ++-----------------------------------------------------------------------+-- More generic maps+-----------------------------------------------------------------------+ map :: Functor f => (a -> b) -> f a -> f b -- ^ map as it should be: 'fmap'. map = fmap@@ -338,8 +479,17 @@ tmap = fmap +-----------------------------------------------------------------------+-- Verbose `List' type+-----------------------------------------------------------------------+ type List a = [a] ++-----------------------------------------------------------------------+-- Has+-----------------------------------------------------------------------+ class Has a where type HasKey a@@ -379,6 +529,10 @@ (!) = flip MultiMap.lookup +-----------------------------------------------------------------------+-- Container+-----------------------------------------------------------------------+ class Container a where type Contained a@@ -417,6 +571,10 @@ (?) = flip MultiMap.member +-----------------------------------------------------------------------+-- Default+-----------------------------------------------------------------------+ class Default a where def :: a@@ -436,71 +594,10 @@ instance Default [a] where def = [] instance Default (Maybe a) where def = Nothing -type family Applicator a b where - Applicator (a, b, c, d, e) z = (a -> b -> c -> d -> e -> z)- Applicator (a, b, c, d) z = (a -> b -> c -> d -> z)- Applicator (a, b, c) z = (a -> b -> c -> z)- Applicator (a, b) z = (a -> b -> z)-- Applicator (f (a, b, c, d, e)) (f z) = (a -> b -> c -> d -> e -> z)- Applicator (f (a, b, c, d)) (f z) = (a -> b -> c -> d -> z)- Applicator (f (a, b, c)) (f z) = (a -> b -> c -> z)- Applicator (f (a, b)) (f z) = (a -> b -> z)- Applicator (f a) (f z) = (a -> z)-- Applicator x z = (x -> z)---class Apply x z where-- (*$*) :: Applicator x z -> x -> z--instance (Applicator a z ~ (a -> z)) => Apply a z where-- (*$*) = ($)--instance Apply (a, b) z where-- (*$*) = uncurry--instance Apply (a, b, c) z where-- (*$*) = uncurry3--instance Apply (a, b, c, d) z where-- (*$*) = uncurry4--instance Apply (a, b, c, d, e) z where-- (*$*) = uncurry5--instance (Functor f, Applicator (f a) (f z) ~ (a -> z))- => Apply (f a) (f z) where-- (*$*) = fmap . ($)--instance (Functor f, Applicator (f (a, b)) (f z) ~ (a -> b -> z))- => Apply (f (a, b)) (f z) where-- (*$*) = fmap . uncurry--instance (Functor f, Applicator (f (a, b, c)) (f z) ~ (a -> b -> c -> z))- => Apply (f (a, b, c)) (f z) where-- (*$*) = fmap . uncurry3--instance (Functor f, Applicator (f (a, b, c, d)) (f z) ~ (a -> b -> c -> d -> z))- => Apply (f (a, b, c, d)) (f z) where-- (*$*) = fmap . uncurry4--instance (Functor f, Applicator (f (a, b, c, d, e)) (f z) ~ (a -> b -> c -> d -> e -> z))- => Apply (f (a, b, c, d, e)) (f z) where-- (*$*) = fmap . uncurry5-+-----------------------------------------------------------------------+-- Apply / curry operators+----------------------------------------------------------------------- infixr 0 $$ infixr 0 $$$
src/Hydrogen/Prelude/System.hs view
@@ -49,25 +49,25 @@ where find :: Set FilePath -> c -> FilePath -> IO (Set FilePath, [(FilePath, c)])- find visited context dir = do+ find visited context dir = canonicalizePath dir >>= find'+ where+ find' thisDirectory+ | Set.member thisDirectory visited = return (Set.empty, [])+ | otherwise = do - thisDirectory <- canonicalizePath dir- if | Set.member thisDirectory visited -> return (Set.empty, [])- | otherwise -> do+ allFiles <- map (dir </>) <$> getDirectoryContents dir+ theFiles <- filterFiles allFiles+ theDirs <- filterM isDir allFiles+ context' <- updater context dir theFiles - allFiles <- map (dir </>) <$> getDirectoryContents dir- theFiles <- filterFiles allFiles- theDirs <- filterM isDir allFiles- context' <- updater context dir theFiles+ let visited' = Set.insert thisDirectory visited+ f (visited, files) dir = do+ (visited', files') <- find visited context' dir+ return (visited', files' : files) - let visited' = Set.insert thisDirectory visited- f (visited, files) dir = do- (visited', files') <- find visited context' dir- return (visited', files' : files)+ (visited'', files') <- foldM f (visited', []) theDirs - (visited'', files') <- foldM f (visited', []) theDirs- - return (visited'', concat (zip theFiles (repeat context') : files'))+ return (visited'', concat (zip theFiles (repeat context') : files')) filterFiles = filterM (\x -> liftM2 (&&) (doesFileExist x) (predicate x)) isDir x = liftM2 (&&) (doesDirectoryExist x) (return (head (takeFileName x) /= '.'))@@ -77,10 +77,10 @@ escapeFileName s = case s of ('/' : xs) -> '_' : escapeFileName xs- (x : xs) ->- if | isSafeChar x -> x : escapeFileName xs- | ord x <= 255 -> '$' : printf "%02X" (ord x) ++ escapeFileName xs- | otherwise -> "$$" ++ printf "%04X" (ord x) ++ escapeFileName xs+ (x : xs)+ | isSafeChar x -> x : escapeFileName xs+ | ord x <= 255 -> '$' : printf "%02X" (ord x) ++ escapeFileName xs+ | otherwise -> "$$" ++ printf "%04X" (ord x) ++ escapeFileName xs [] -> [] where isSafeChar x = isAscii x && isAlphaNum x || x `elem` ".-"