data-extra 1.0.0 → 2.0.0

raw patch · 10 files changed

+271/−3 lines, 10 filesdep +mtldep +old-localedep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl, old-locale, text, time

API changes (from Hackage documentation)

Files

• data-extra.cabal +15/−3
• src/Data/Bool/Extra.hs +7/−0
• src/Data/Either/Extra.hs +10/−0
• src/Data/Extra.hs +33/−0
• src/Data/List/Extra.hs +35/−0
• src/Data/Maybe/Extra.hs +5/−0
• src/Data/Number/Extra.hs +7/−0
• src/Data/String/Extra.hs +27/−0
• src/Data/Text/Extra.hs +55/−0
• src/Data/Time/Extra.hs +77/−0

@@ -1,5 +1,5 @@ name:                data-extra-version:             1.0.0+version:             2.0.0 synopsis:            Extra utilities for working on Data.* types. description:         Extra utilities for working on Data.* types. license:             BSD3@@ -12,7 +12,19 @@ cabal-version:       >=1.8  library-  exposed-modules:   Data.Either.Extra, Data.Maybe.Extra+  exposed-modules:   Data.Extra,+                     Data.Either.Extra,+                     Data.Maybe.Extra,+                     Data.Bool.Extra,+                     Data.List.Extra,+                     Data.String.Extra,+                     Data.Text.Extra,+                     Data.Number.Extra,+                     Data.Time.Extra   hs-source-dirs:    src/-  build-depends:     base > 4 && <5+  build-depends:     base > 4 && <5,+                     text,+                     old-locale,+                     time,+                     mtl   ghc-options:       -Wall

@@ -0,0 +1,7 @@+-- | Extra functions for dealing with Bool.++module Data.Bool.Extra (bool) where++-- | An if/else condition on the given value.+bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b+bool true false p v = if p v then true v else false v

@@ -33,3 +33,13 @@ fromRight :: b -> Either a b -> b fromRight _ (Right x) = x fromRight x _ = x++-- | When a value is Right, do something with it, monadically.+whenRight :: Monad m => Either a b -> (b -> m c) -> m ()+whenRight (Right x) m = m x >> return ()+whenRight _         _ = return ()++-- | When a value is Left, do something with it, monadically.+whenLeft :: Monad m => Either a b -> (a -> m c) -> m ()+whenLeft (Left x) m = m x >> return ()+whenLeft _         _ = return ()

@@ -0,0 +1,33 @@+-- | Extra Data.* functions.++module Data.Extra+       (module Data.Either+       ,module Data.Either.Extra+       ,module Data.Maybe+       ,module Data.Maybe.Extra+       ,module Data.List+       ,module Data.List.Extra+       ,module Data.Bool+       ,module Data.Bool.Extra+       ,module Data.String+       ,module Data.String.Extra+       ,module Data.Text.Extra+       ,module Data.Time+       ,module Data.Time.Extra+       ,module Data.Number.Extra)+       where++import Data.Either+import Data.Either.Extra+import Data.Maybe+import Data.Maybe.Extra+import Data.List+import Data.List.Extra+import Data.Bool+import Data.Bool.Extra+import Data.String+import Data.String.Extra+import Data.Text.Extra+import Data.Time+import Data.Time.Extra+import Data.Number.Extra

@@ -0,0 +1,35 @@+-- | Extra functions for dealing with lists.++module Data.List.Extra where++import Data.Bool.Extra+import Data.List+import Data.Maybe++-- | When a list is non-null, pass it to a function, otherwise use the+-- default.+list :: b -> ([a] -> b) -> [a] -> b+list nil cons = bool cons (const nil) null++-- | Get the union of the given lists.+unionOf :: (Eq a) => [[a]] -> [a]+unionOf = foldr union []++-- | Opposite of map.+for :: [a] -> (a -> b) -> [b]+for = flip map++-- | Maybe get the last element in the list.+lastToMaybe :: [a] -> Maybe a+lastToMaybe [x]    = Just x+lastToMaybe (_:xs) = lastToMaybe xs+lastToMaybe []     = Nothing++-- | Return the first item of a list or something else.+firstOr :: a -> [a] -> a+firstOr n = fromMaybe n . listToMaybe++-- | Get the maximum of a list or return zero.+maxList :: (Num t, Ord t) => [t] -> t+maxList [] = 0+maxList xs = maximum xs

@@ -8,3 +8,8 @@ whenMaybe :: Monad m => Bool -> m a -> m (Maybe a) whenMaybe False _ = return Nothing whenMaybe True m = liftM Just m++-- | When a value is Just, do something with it, monadically.+whenJust :: Monad m => Maybe a -> (a -> m c) -> m ()+whenJust (Just a) m = m a >> return ()+whenJust _         _ = return ()

@@ -0,0 +1,7 @@+-- | Extra functions for numbers.++module Data.Number.Extra where++-- | Shorter-hand for fromIntegral.+int :: (Integral a, Num b) => a -> b+int = fromIntegral

@@ -0,0 +1,27 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Extra functions and classes for dealing with Strings.++module Data.String.Extra where++import Data.Char++-- | Lower case a string.+lower :: String -> String+lower = map toLower++-- | Upper case a string.+upper :: String -> String+upper = map toUpper++-- | Trim a string.+trim :: [Char] -> [Char]+trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace++-- | A class for converting to strings.+class ToString a where+  toString :: a -> String++instance ToString String where+  toString = id

@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Extra functions and classes for dealing with Text.++module Data.Text.Extra where++import           Data.Number.Extra+import           Data.Text+import qualified Data.Text.Lazy as L++-- | A class for converting to Text.+class ToText a where+  toText :: a -> Text+  toLazyText :: a -> L.Text++instance ToText Text where+  toText = id+  toLazyText = L.fromStrict++instance ToText String where+  toText = pack+  toLazyText = L.pack++class FromText a where+  fromText :: Text -> Maybe a+  fromLazyText :: L.Text -> Maybe a++instance FromText String where+  fromText = Just . unpack+  fromLazyText = Just . L.unpack++-- | Big 'em up.+bigUp :: (Integral a) => a -> Text+bigUp = go . int where+  go :: Integer -> Text+  go n | n < 3              = "a couple"+       | n < 5              = "several"+       | n < 10             = "many"+       | n < 80             = "dozens"+       | n < 100            = "nearly a hundred"+       | n < 200            = "some hundred"+       | n < 1000           = "hundreds"+       | n < 10000          = "thousands"+       | n < 100000         = "tens of thousands"+       | n < 200000         = "a hundred thousand"+       | n < 500000         = "hundreds of thousands"+       | n < 500000         = "half a million"+       | n < 600000         = "over half a million"+       | n < 1000000        = "nearly a million"+       | n < 2000000        = "over a million"+       | n < (10^ (9::Int)) = "millions"+       | n < 10^ (12::Int)  = "billions"+       | otherwise          = "trillions"

@@ -0,0 +1,77 @@+{-# LANGUAGE BangPatterns #-}++-- | Extra date functions.++module Data.Time.Extra where++import Control.Monad.Trans+import Data.List+import Data.Text (Text,pack)+import Data.Time+import System.Locale+import Text.Printf++-- | Get the current year.+getYear :: FormatTime t => t -> Integer+getYear = read . formatTime defaultTimeLocale "%Y"++-- | Get the current month.+getMonth :: FormatTime t => t -> Integer+getMonth = read . formatTime defaultTimeLocale "%m"++-- | Get the current day.+getDay :: FormatTime t => t -> Integer+getDay = read . formatTime defaultTimeLocale "%d"++-- | Display a time span as one time relative to another.+relative :: UTCTime -- ^ The later time span.+         -> UTCTime -- ^ The earlier time span.+         -> Bool    -- ^ Display 'in/ago'?+         -> Text    -- ^ Example: '3 seconds ago', 'in three days'.+relative t1 t2 fix = pack $ maybe "unknown" format $ find (\(s,_,_) -> abs span'>=s) $ reverse ranges where+  minute = 60; hour = minute * 60; day = hour * 24;+  week = day * 7; month = day * 30; year = month * 12+  format range =+    (if fix && span'>0 then "in " else "")+    ++ case range of+        (_,str,0) -> str+        (_,str,base) -> printf str (abs $ round (span' / base) :: Integer)+    ++ (if fix && span'<0 then " ago" else "")+  span' = t1 `diffUTCTime` t2+  ranges = [(0,"%d seconds",1)+           ,(minute,"a minute",0)+           ,(minute*2,"% minutes",minute)+           ,(minute*30,"half an hour",0)+           ,(minute*31,"%d minutes",minute)+           ,(hour,"an hour",0)+           ,(hour*2,"%d hours",hour)+           ,(hour*3,"a few hours",0)+           ,(hour*4,"%d hours",hour)+           ,(day,"a day",0)+           ,(day*2,"%d days",day)+           ,(week,"a week",0)+           ,(week*2,"%d weeks",week)+           ,(month,"a month",0)+           ,(month*2,"%d months",month)+           ,(year,"a year",0)+           ,(year*2,"%d years",year)+           ]++-- | Run a stop-watch at the start and end of a computation.+stopwatch :: MonadIO m => m a -> m (a,NominalDiffTime)+stopwatch computation = do+  start <- liftIO $ getCurrentTime+  !a <- computation+  end <- liftIO $ getCurrentTime+  return (a,end `diffUTCTime` start)++bench :: MonadIO m => Integer -> m a -> m (a,NominalDiffTime)+bench i computation = go i Nothing where+  go n Nothing = do+    (a,time) <- stopwatch computation+    go (n-1) (Just (a,time))+  go 0 (Just x) = do+    return x+  go n (Just (_,avgTime)) = do+    (a,timeNew) <- stopwatch computation+    go (n-1) (Just (a,(timeNew + avgTime) / 2))