buildbox 2.1.11.1 → 2.2.1.2
raw patch · 12 files changed
Files
- BuildBox/Build/Base.hs +9/−10
- BuildBox/Build/BuildError.hs +22/−17
- BuildBox/Build/Testable.hs +9/−8
- BuildBox/Command/Environment.hs +13/−15
- BuildBox/Command/Mail.hs +9/−10
- BuildBox/Data/Comparison.hs +12/−12
- BuildBox/Data/Detail.hs +12/−13
- BuildBox/Data/Physical.hs +31/−28
- BuildBox/Data/Range.hs +7/−6
- BuildBox/Data/Schedule.hs +16/−16
- BuildBox/Pretty.hs +138/−52
- buildbox.cabal +10/−11
BuildBox/Build/Base.hs view
@@ -8,8 +8,7 @@ import Control.Monad.State import System.IO import System.Directory-import Text.PrettyPrint.Leijen-import Prelude hiding ((<>))+import qualified Data.Text as T -- | The builder monad encapsulates and IO action that can fail with an error,@@ -40,7 +39,7 @@ = do result <- try $ evalStateT build s case result of Left (err :: BuildError)- -> do putStrLn $ renderIndent $ ppr err+ -> do putStrLn $ T.unpack $ ppr err return $ Nothing Right x@@ -55,7 +54,7 @@ Left (err :: BuildError) -> do putStrLn "\nBuild failed" putStr " due to "- putStrLn $ renderIndent $ ppr err+ putStrLn $ T.unpack $ ppr err return $ Nothing Right x@@ -106,20 +105,20 @@ -- Output ----------------------------------------------------------------------------------------- -- | Print some text to stdout.-out :: Pretty a => a -> Build ()-out str+out :: Text -> Build ()+out tx = io- $ do putStr $ renderIndent $ ppr str+ $ do putStr $ T.unpack tx hFlush stdout -- | Print some text to stdout followed by a newline.-outLn :: Pretty a => a -> Build ()-outLn str = io $ putStrLn $ renderIndent $ ppr str+outLn :: Text -> Build ()+outLn tx = io $ putStrLn $ T.unpack tx -- | Print a blank line to stdout outBlank :: Build ()-outBlank = out $ text "\n"+outBlank = out $ string "\n" -- | Print a @-----@ line to stdout
BuildBox/Build/BuildError.hs view
@@ -7,11 +7,10 @@ import BuildBox.Pretty import Control.Monad.Catch import Data.Typeable-import Text.PrettyPrint.Leijen hiding (Pretty) import System.Exit import BuildBox.Data.Log (Log) import qualified BuildBox.Data.Log as Log-import Prelude hiding ((<>))+import qualified Data.Text as T -- BuildError -------------------------------------------------------------------------------------@@ -43,44 +42,50 @@ instance Pretty BuildError where- pretty err+ ppr err = case err of ErrorOther str- -> text "Other error: " <> text str+ -> string "Other error: "+ % string str ErrorSystemCmdFailed{} -> vcat- $ [ text "System command failure."- , text " command: " <> (text $ buildErrorCmd err)- , text " exit code: " <> (text $ show $ buildErrorCode err)- , blank ]+ $ [ string "System command failure."+ , string " command: " % (string $ buildErrorCmd err)+ , string " exit code: " % (string $ show $ buildErrorCode err)+ , string "" ] ++ (if (not $ Log.null $ buildErrorStdout err)- then [ text "-- stdout (last 10 lines) ------------------------------------------------------"- , text $ Log.toString $ Log.lastLines 10 $ buildErrorStdout err]+ then [ string "-- stdout (last 10 lines) ------------------------------------------------------"+ , string $ Log.toString $ Log.lastLines 10 $ buildErrorStdout err] else []) ++ (if (not $ Log.null $ buildErrorStderr err)- then [ text "-- stderr (last 10 lines) ------------------------------------------------------"- , text $ Log.toString $ Log.lastLines 10 $ buildErrorStderr err ]+ then [ string "-- stderr (last 10 lines) ------------------------------------------------------"+ , string $ Log.toString $ Log.lastLines 10 $ buildErrorStderr err ] else []) ++ (if ( (not $ Log.null $ buildErrorStdout err) || (not $ Log.null $ buildErrorStderr err))- then [ text "--------------------------------------------------------------------------------" ]+ then [ string "--------------------------------------------------------------------------------" ] else []) ErrorIOError ioerr- -> text "IO error: " <> (text $ show ioerr)+ -> string "IO error: "+ % (string $ show ioerr) ErrorCheckFailed expected prop- -> text "Check failure: " <> (text $ show prop) <> (text " expected ") <> (text $ show expected)+ -> string "Check failure: "+ % (string $ show prop)+ % (string " expected ")+ % (string $ show expected) ErrorNeeds filePath- -> text "Build needs: " <> text filePath+ -> string "Build needs: "+ % string filePath instance Show BuildError where- show err = renderPlain $ ppr err+ show err = T.unpack $ ppr err
BuildBox/Build/Testable.hs view
@@ -9,8 +9,9 @@ , outCheckOk , outCheckFalseOk) where-import BuildBox.Build.Base +import BuildBox.Build.Base import BuildBox.Build.BuildError+import BuildBox.Pretty import Control.Monad.Catch @@ -37,24 +38,24 @@ if result then throwM $ ErrorCheckFailed False prop else return ()- + -- | Check some property while printing what we're doing.-outCheckOk - :: (Show prop, Testable prop) +outCheckOk+ :: (Show prop, Testable prop) => String -> prop -> Build () outCheckOk str prop- = do outLn str+ = do outLn (string str) check prop -- | Check some property while printing what we're doing.-outCheckFalseOk - :: (Show prop, Testable prop) +outCheckFalseOk+ :: (Show prop, Testable prop) => String -> prop -> Build () outCheckFalseOk str prop- = do outLn str+ = do outLn (string str) checkFalse prop
BuildBox/Command/Environment.hs view
@@ -22,8 +22,6 @@ import BuildBox.Command.System import BuildBox.Command.File import BuildBox.Pretty-import Text.PrettyPrint.Leijen-import Prelude hiding ((<>)) -- Environment ------------------------------------------------------------------------------------@@ -36,15 +34,15 @@ instance Pretty Environment where- pretty env+ ppr env = vcat [ ppr "Environment"- , nest 2 $ vcat+ , indents 2 [ ppr $ environmentPlatform env- , nest 2 $ ppr "Versions"- <+> vcat- ( map (\(name, ver) -> ppr name <+> ppr ver)- $ environmentVersions env)+ , indents 2+ $ ppr "Versions"+ : ( map (\(name, ver) -> ppr name %% ppr ver)+ $ environmentVersions env) ] ] @@ -84,15 +82,15 @@ instance Pretty Platform where- pretty plat+ ppr plat = vcat [ ppr "Platform"- , nest 2 $ vcat- [ ppr "host: " <> (ppr $ platformHostName plat)- , ppr "arch: " <> (ppr $ platformHostArch plat)- , ppr "processor: " <> (ppr $ platformHostProcessor plat)- , ppr "system: " <> (ppr $ platformHostOS plat)- <+> (ppr $ platformHostRelease plat) ]]+ , indents 2+ [ ppr "host: " % (ppr $ platformHostName plat)+ , ppr "arch: " % (ppr $ platformHostArch plat)+ , ppr "processor: " % (ppr $ platformHostProcessor plat)+ , ppr "system: " % (ppr $ platformHostOS plat)+ %% (ppr $ platformHostRelease plat) ]] -- | Get information about the host platform.
BuildBox/Command/Mail.hs view
@@ -18,8 +18,7 @@ import Data.Time.LocalTime import Data.Time.Format import Data.Time.Calendar-import Text.PrettyPrint.Leijen-import Prelude hiding ((<>))+import qualified Data.Text as T -- | An email message that we can send.@@ -90,16 +89,16 @@ -- | Render an email message as a string.-renderMail :: Mail -> Doc+renderMail :: Mail -> Text renderMail mail = vcat- [ ppr "From: " <> ppr (mailFrom mail)- , ppr "To: " <> ppr (mailTo mail)- , ppr "Subject: " <> ppr (mailSubject mail)- , ppr "Date: " <> (ppr $ formatTime defaultTimeLocale "%a, %e %b %Y %H:%M:%S %z"+ [ ppr "From: " % ppr (mailFrom mail)+ , ppr "To: " % ppr (mailTo mail)+ , ppr "Subject: " % ppr (mailSubject mail)+ , ppr "Date: " % (ppr $ formatTime defaultTimeLocale "%a, %e %b %Y %H:%M:%S %z" $ utcToZonedTime (mailTimeZone mail) (mailTime mail)) - , ppr "Message-Id: " <> ppr (mailMessageId mail)+ , ppr "Message-Id: " % ppr (mailMessageId mail) , ppr "" , ppr (mailBody mail) ] @@ -112,12 +111,12 @@ -> ssystemTee False (mailerPath mailer ++ " -t ") -- read recipients from the mail- (renderIndent $ renderMail mail)+ (T.unpack $ renderMail mail) MailerMSMTP{} -> ssystemTee False (mailerPath mailer ++ " -t " -- read recipients from the mail ++ (maybe "" (\port -> " --port=" ++ show port) $ mailerPort mailer))- (renderIndent $ renderMail mail)+ (T.unpack $ renderMail mail)
BuildBox/Data/Comparison.hs view
@@ -6,8 +6,7 @@ where import BuildBox.Pretty import Text.Printf-import Text.PrettyPrint.Leijen-import Prelude hiding ((<>))+import qualified Data.Text as T -- | The comparison of two values.@@ -24,19 +23,20 @@ deriving (Read, Show) + instance Pretty a => Pretty (Comparison a) where- pretty (Comparison _ recent ratio)- | abs ratio < 0.01- = text $ printf "%s (----)"- (renderPlain $ ppr recent)+ ppr (Comparison _ recent ratio)+ | abs ratio < 0.01+ = string $ printf "%s (----)"+ (T.unpack $ ppr recent) - | otherwise- = text $ printf "%s (%+4.0f)"- (renderPlain $ ppr recent)- (ratio * 100)+ | otherwise+ = string $ printf "%s (%+4.0f)"+ (T.unpack $ ppr recent)+ (ratio * 100) - pretty (ComparisonNew new)- = (padL 10 $ ppr new)+ ppr (ComparisonNew new)+ = (padL 10 $ ppr new) -- | Make a comparison from two values.
BuildBox/Data/Detail.hs view
@@ -7,7 +7,6 @@ , Sized (..)) where import BuildBox.Pretty-import Text.PrettyPrint.Leijen data Detail@@ -28,15 +27,15 @@ deriving (Eq, Ord, Show, Read, Enum) instance Pretty Timed where- pretty timed+ ppr timed = case timed of- TotalWall -> text "runtime (wall clock)"- TotalCpu -> text "runtime (cpu usage)"- TotalSys -> text "runtime (sys usage)"+ TotalWall -> string "runtime (wall clock)"+ TotalCpu -> string "runtime (cpu usage)"+ TotalSys -> string "runtime (sys usage)" - KernelWall -> text "kernel runtime (wall clock)"- KernelCpu -> text "kernel runtime (cpu usage)"- KernelSys -> text "kernel runtime (sys usage)"+ KernelWall -> string "kernel runtime (wall clock)"+ KernelCpu -> string "kernel runtime (cpu usage)"+ KernelSys -> string "kernel runtime (sys usage)" -- | Some resource used during execution.@@ -46,10 +45,10 @@ deriving (Eq, Ord, Show, Read, Enum) instance Pretty Used where- pretty used+ ppr used = case used of- HeapMax -> text "maximum heap usage"- HeapAlloc -> text "heap allocation"+ HeapMax -> string "maximum heap usage"+ HeapAlloc -> string "heap allocation" -- | Some static size of the benchmark that isn't affected during the run.@@ -58,8 +57,8 @@ deriving (Eq, Ord, Show, Read, Enum) instance Pretty Sized where- pretty sized+ ppr sized = case sized of- ExeSize -> text "executable size"+ ExeSize -> string "executable size"
BuildBox/Data/Physical.hs view
@@ -6,53 +6,56 @@ import BuildBox.Data.Dividable import BuildBox.Pretty import Data.Maybe-import Text.PrettyPrint.Leijen-import Prelude hiding ((<>)) -- | Seconds of time, pretty printed in engineering format.-data Seconds = Seconds Double- deriving (Read, Show, Ord, Eq)+data Seconds+ = Seconds Double+ deriving (Read, Show, Ord, Eq) + instance Real Seconds where- toRational (Seconds s1) = toRational s1+ toRational (Seconds s1) = toRational s1 + instance Dividable Seconds where- divide (Seconds s1) (Seconds s2) = Seconds (s1 / s2)+ divide (Seconds s1) (Seconds s2) = Seconds (s1 / s2) + instance Num Seconds where- (+) (Seconds f1) (Seconds f2) = Seconds (f1 + f2)- (-) (Seconds f1) (Seconds f2) = Seconds (f1 - f2)- (*) (Seconds f1) (Seconds f2) = Seconds (f1 * f2)- abs (Seconds f1) = Seconds (abs f1)- signum (Seconds f1) = Seconds (signum f1)- fromInteger i = Seconds (fromInteger i)+ (+) (Seconds f1) (Seconds f2) = Seconds (f1 + f2)+ (-) (Seconds f1) (Seconds f2) = Seconds (f1 - f2)+ (*) (Seconds f1) (Seconds f2) = Seconds (f1 * f2)+ abs (Seconds f1) = Seconds (abs f1)+ signum (Seconds f1) = Seconds (signum f1)+ fromInteger i = Seconds (fromInteger i) instance Pretty Seconds where- pretty (Seconds f)- = fromMaybe (text (show f))- $ pprEngDouble "s" f+ ppr (Seconds f)+ = fromMaybe (string (show f))+ $ pprEngDouble "s" f -- | Bytes of data, pretty printed in engineering format.-data Bytes = Bytes Integer- deriving (Read, Show, Ord, Eq)+data Bytes+ = Bytes Integer+ deriving (Read, Show, Ord, Eq) instance Real Bytes where- toRational (Bytes b1) = toRational b1+ toRational (Bytes b1) = toRational b1 instance Dividable Bytes where- divide (Bytes s1) (Bytes s2) = Bytes (s1 `div` s2)+ divide (Bytes s1) (Bytes s2) = Bytes (s1 `div` s2) instance Num Bytes where- (+) (Bytes f1) (Bytes f2) = Bytes (f1 + f2)- (-) (Bytes f1) (Bytes f2) = Bytes (f1 - f2)- (*) (Bytes f1) (Bytes f2) = Bytes (f1 * f2)- abs (Bytes f1) = Bytes (abs f1)- signum (Bytes f1) = Bytes (signum f1)- fromInteger i = Bytes (fromInteger i)+ (+) (Bytes f1) (Bytes f2) = Bytes (f1 + f2)+ (-) (Bytes f1) (Bytes f2) = Bytes (f1 - f2)+ (*) (Bytes f1) (Bytes f2) = Bytes (f1 * f2)+ abs (Bytes f1) = Bytes (abs f1)+ signum (Bytes f1) = Bytes (signum f1)+ fromInteger i = Bytes (fromInteger i) instance Pretty Bytes where- pretty (Bytes b)- = fromMaybe (text (show b))- $ pprEngInteger "B" b+ ppr (Bytes b)+ = fromMaybe (string (show b))+ $ pprEngInteger "B" b
BuildBox/Data/Range.hs view
@@ -6,9 +6,8 @@ where import BuildBox.Pretty import BuildBox.Data.Dividable-import Text.PrettyPrint.Leijen-import Prelude hiding ((<>)) + -- | A range extracted from many-valued data. data Range a = Range@@ -17,11 +16,13 @@ , rangeMax :: a } deriving (Read, Show) + instance Pretty a => Pretty (Range a) where- pretty (Range mi av mx)- = (ppr mi) <+> text "/"- <+> (ppr av) <+> text "/"- <+> (ppr mx)+ ppr (Range mi av mx)+ = ppr mi %% string "/"+ %% ppr av %% string "/"+ %% ppr mx+ instance Functor Range where fmap f (Range mi av mx)
BuildBox/Data/Schedule.hs view
@@ -3,7 +3,7 @@ -- | A schedule of commands that should be run at a certain time. module BuildBox.Data.Schedule- ( + ( -- * Time Periods second, minute, hour, day @@ -58,10 +58,10 @@ -- | Do it some time after we last started it. | Every NominalDiffTime- + -- | Do it some time after it last finished. | After NominalDiffTime- + -- | Do it each day at this time. The ''days'' are UTC days, not local ones. | Daily TimeOfDay deriving (Read, Show, Eq)@@ -96,12 +96,12 @@ -- | When the event was last started, if any. , eventLastStarted :: Maybe UTCTime- + -- | When the event last finished, if any. , eventLastEnded :: Maybe UTCTime } deriving (Read, Show, Eq)- + -- | Given the current time and a list of events, determine which one should be started now. -- If several events are avaliable then take the one with the earliest start time. earliestEventToStartAt :: UTCTime -> [Event] -> Maybe Event@@ -141,34 +141,34 @@ Always -> True Never -> False - Every diffTime + Every diffTime -> maybe True (\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime) (eventLastStarted event) - After diffTime + After diffTime -> maybe True (\lastTime -> (curTime `diffUTCTime` lastTime ) > diffTime) (eventLastEnded event)- + Daily timeOfDay -- If it's been less than a day since we last started it, then don't do it yet. | Just lastStarted <- eventLastStarted event , (curTime `diffUTCTime` lastStarted) < day -> False- + | otherwise -> let -- If we were going to run it today, this is when it would be. startTimeToday = curTime { utctDayTime = timeOfDayToTime timeOfDay }- + -- If it's after that time then quit fooling around.. in curTime > startTimeToday -- Schedule ------------------------------------------------------------------------------------------ | Map of event names to their details and build commands. +-- | Map of event names to their details and build commands. data Schedule cmd = Schedule (Map EventName (Event, cmd)) @@ -191,8 +191,8 @@ lookupEventOfSchedule :: EventName -> Schedule cmd -> Maybe Event lookupEventOfSchedule name (Schedule sched) = liftM fst $ Map.lookup name sched- - ++ -- | Given an event name, lookup the associated build command from a schedule. lookupCommandOfSchedule :: EventName -> Schedule cmd -> Maybe cmd lookupCommandOfSchedule name (Schedule sched)@@ -203,8 +203,8 @@ -- If the event not already there then return the original schedule. adjustEventOfSchedule :: Event -> Schedule cmd -> Schedule cmd adjustEventOfSchedule event (Schedule sched)- = Schedule - $ Map.adjust + = Schedule+ $ Map.adjust (\(_, build) -> (event, build))- (eventName event) + (eventName event) sched
BuildBox/Pretty.hs view
@@ -1,82 +1,167 @@ {-# LANGUAGE ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}++-- Don't warn about Data.Monoid import in GHC 8.2 -> 8.4 transition.+{-# OPTIONS_GHC -Wno-unused-imports #-}+ -- | Pretty printing utils. module BuildBox.Pretty ( Pretty(..)+ , Text+ , (%), (%%), empty+ , char, string, text+ , vcat, vsep+ , hcat, hsep+ , parens, braces, brackets, angles+ , indents , padRc, padR , padLc, padL- , blank , pprEngDouble- , pprEngInteger- , renderIndent- , renderPlain- , ppr)+ , pprEngInteger) where import Text.Printf-import Text.PrettyPrint.Leijen-import Data.Time import Control.Monad-import Prelude hiding ((<>))+import Data.Text (Text)+import Data.Time+import Data.Monoid+import Data.List+import qualified Data.Text as T --- Basic instances-instance Pretty UTCTime where- pretty = text . show+-- Pretty ---------------------------------------------------------------------+class Pretty a where+ ppr :: a -> Text -instance Pretty String where- pretty = text +-- Basic Combinators ----------------------------------------------------------+-- | An empty text string.+empty :: Text+empty = string " " -ppr :: Pretty a => a -> Doc-ppr = pretty +-- | Append two text strings.+(%) :: Text -> Text -> Text+(%) t1 t2 = t1 <> t2 --- | Render a thing as a string.-renderIndent :: Pretty a => a -> String-renderIndent x- = displayS (renderPretty 0.4 80 (pretty x)) "" +-- | Append two text strings separated by a space.+(%%) :: Text -> Text -> Text+(%%) t1 t2 = t1 <> string " " <> t2 --- | Render a thing with no indenting.-renderPlain :: Pretty a => a -> String-renderPlain x- = displayS (renderCompact (pretty x)) "" +-- | Convert a single Char to text.+char :: Char -> Text+char c = T.pack [c] ++-- | Convert a String to text.+string :: String -> Text+string s = T.pack s+++-- | Convert a Text to Text (id).+text :: Text -> Text+text t = t+++-- | Concatenate a list of text.+hcat :: [Text] -> Text+hcat = mconcat+++-- | Concatenate a list of text, with spaces in between.+hsep :: [Text] -> Text+hsep ts = mconcat $ intersperse (string " ") ts+++-- | Concatenate a list of text vertically.+vcat :: [Text] -> Text+vcat ts = mconcat $ intersperse (string "\n") ts+++-- | Concatenate a list of text vertically, with blank lines in between.+vsep :: [Text] -> Text+vsep ts = mconcat $ intersperse (string "\n\n") ts+++-- | Wrap a text thing in round parens.+parens :: Text -> Text+parens tx = string "(" % tx % string ")"+++-- | Wrap a text thing in round parens.+braces :: Text -> Text+braces tx = string "{" % tx % string "}"+++-- | Wrap a text thing in round parens.+brackets :: Text -> Text+brackets tx = string "[" % tx % string "]"+++-- | Wrap a text thing in round parens.+angles :: Text -> Text+angles tx = string "<" % tx % string ">"+++-- | Indent some text by the given number of characters.+indents :: Int -> [Text] -> Text+indents n ts+ = mconcat [ string (replicate n ' ') % t | t <- ts ]+++-- Basic Instances ------------------------------------------------------------+instance Pretty UTCTime where+ ppr = T.pack . show++instance Pretty Text where+ ppr = id++instance Pretty String where+ ppr = T.pack++instance Pretty Int where+ ppr = T.pack . show++instance Pretty Integer where+ ppr = T.pack . show++instance Pretty Char where+ ppr = T.pack . show++ -- | Right justify a doc, padding with a given character.-padRc :: Int -> Char -> Doc -> Doc-padRc n c str- = (text $ replicate (n - length (renderPlain str)) c) <> str+padRc :: Int -> Char -> Text -> Text+padRc n c tx+ = (string $ replicate (n - length (T.unpack tx)) c) <> tx -- | Right justify a string with spaces.-padR :: Int -> Doc -> Doc-padR n str = padRc n ' ' str+padR :: Int -> Text -> Text+padR n str+ = padRc n ' ' str -- | Left justify a string, padding with a given character.-padLc :: Int -> Char -> Doc -> Doc-padLc n c str- = str <> (text $ replicate (n - length (displayS (renderPretty 0.4 80 str) "")) c)+padLc :: Int -> Char -> Text -> Text+padLc n c tx+ = tx <> (string $ replicate (n - length (T.unpack tx)) c) -- | Left justify a string with spaces.-padL :: Int -> Doc -> Doc-padL n str = padLc n ' ' str---- | Blank text. This is different different from `empty` because it comes out a a--- newline when used in a `vcat`.-blank :: Doc-blank = pretty ""+padL :: Int -> Text -> Text+padL n str+ = padLc n ' ' str --- | Like `pprEngDouble` but don't display fractional part when the value is < 1000.--- Good for units where fractional values might not make sense (like bytes).-pprEngInteger :: String -> Integer -> Maybe Doc+-- Engineering Numbers --------------------------------------------------------+-- | Like `pprEngDouble` but don't display fractional part when the value+-- is < 1000. Good for units where fractional values might not make sense+-- (like bytes).+pprEngInteger :: String -> Integer -> Maybe Text pprEngInteger unit k- | k < 0 = liftM (text "-" <>) $ pprEngInteger unit (-k)+ | k < 0 = fmap (string "-" <>) $ pprEngInteger unit (-k) | k > 1000 = pprEngDouble unit (fromRational $ toRational k)- | otherwise = Just $ text $ printf "%5d%s " k unit+ | otherwise = Just $ string $ printf "%5d%s " k unit -- | Pretty print an engineering value, to 4 significant figures.@@ -90,9 +175,9 @@ -- liftM render $ pprEngDouble \"s\" 0.0000123 ==> Just \"12.30us\" -- @ ---pprEngDouble :: String -> Double -> Maybe Doc+pprEngDouble :: String -> Double -> Maybe Text pprEngDouble unit k- | k < 0 = liftM (text "-" <>) $ pprEngDouble unit (-k)+ | k < 0 = liftM (string "-" <>) $ pprEngDouble unit (-k) | k >= 1e+27 = Nothing | k >= 1e+24 = Just $ (k*1e-24) `with` ("Y" ++ unit) | k >= 1e+21 = Just $ (k*1e-21) `with` ("Z" ++ unit)@@ -112,9 +197,10 @@ | k >= 1e-21 = Just $ (k*1e+21) `with` ("z" ++ unit) | k >= 1e-24 = Just $ (k*1e+24) `with` ("y" ++ unit) | k >= 1e-27 = Nothing- | otherwise = Just $ text $ printf "%5.0f%s " k unit- where with (t :: Double) (u :: String)- | t >= 1e3 = text $ printf "%.0f%s" t u- | t >= 1e2 = text $ printf "%.1f%s" t u- | t >= 1e1 = text $ printf "%.2f%s" t u- | otherwise = text $ printf "%.3f%s" t u+ | otherwise = Just $ string $ printf "%5.0f%s " k unit+ where+ with (t :: Double) (u :: String)+ | t >= 1e3 = string $ printf "%.0f%s" t u+ | t >= 1e2 = string $ printf "%.1f%s" t u+ | t >= 1e1 = string $ printf "%.2f%s" t u+ | otherwise = string $ printf "%.3f%s" t u
buildbox.cabal view
@@ -1,5 +1,5 @@ Name: buildbox-Version: 2.1.11.1+Version: 2.2.1.2 License: BSD3 License-file: LICENSE Author: Ben Lippmeier@@ -21,19 +21,18 @@ Library Build-Depends:- base >= 4.4 && < 4.12,- containers >= 0.4 && < 0.6,- time >= 1.2 && < 1.9,- directory >= 1.1 && < 1.4,+ base >= 4.4 && < 4.13,+ containers >= 0.4 && < 0.7, bytestring >= 0.9 && < 0.11,- mtl >= 2.2 && < 2.3,+ exceptions >= 0.8 && < 0.11, old-locale >= 1.0 && < 1.1,- process >= 1.2 && < 1.7,+ directory >= 1.1 && < 1.4, temporary >= 1.2 && < 1.4,- exceptions >= 0.8 && < 0.11,- wl-pprint >= 1.1 && < 1.3,- stm >= 2.4 && < 2.5,- text >= 1.2 && < 1.3+ process >= 1.2 && < 1.7,+ time >= 1.2 && < 1.9,+ text >= 1.2 && < 1.3,+ mtl >= 2.2 && < 2.3,+ stm >= 2.4 && < 2.6 ghc-options: -Wall