packages feed

buildbox 2.1.11.1 → 2.2.1.1

raw patch · 12 files changed

+286/−196 lines, 12 filesdep −wl-pprintPVP ok

version bump matches the API change (PVP)

Dependencies removed: wl-pprint

API changes (from Hackage documentation)

- BuildBox.Command.Environment: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Command.Environment.Environment
- BuildBox.Command.Environment: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Command.Environment.Platform
- BuildBox.Data.Comparison: instance Text.PrettyPrint.Leijen.Pretty a => Text.PrettyPrint.Leijen.Pretty (BuildBox.Data.Comparison.Comparison a)
- BuildBox.Data.Detail: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Data.Detail.Sized
- BuildBox.Data.Detail: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Data.Detail.Timed
- BuildBox.Data.Detail: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Data.Detail.Used
- BuildBox.Data.Physical: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Data.Physical.Bytes
- BuildBox.Data.Physical: instance Text.PrettyPrint.Leijen.Pretty BuildBox.Data.Physical.Seconds
- BuildBox.Data.Range: instance Text.PrettyPrint.Leijen.Pretty a => Text.PrettyPrint.Leijen.Pretty (BuildBox.Data.Range.Range a)
- BuildBox.Pretty: blank :: Doc
- BuildBox.Pretty: instance Text.PrettyPrint.Leijen.Pretty Data.Time.Clock.Internal.UTCTime.UTCTime
- BuildBox.Pretty: instance Text.PrettyPrint.Leijen.Pretty GHC.Base.String
- BuildBox.Pretty: pretty :: Pretty a => a -> Doc
- BuildBox.Pretty: prettyList :: Pretty a => [a] -> Doc
- BuildBox.Pretty: renderIndent :: Pretty a => a -> String
- BuildBox.Pretty: renderPlain :: Pretty a => a -> String
+ BuildBox.Command.Environment: instance BuildBox.Pretty.Pretty BuildBox.Command.Environment.Environment
+ BuildBox.Command.Environment: instance BuildBox.Pretty.Pretty BuildBox.Command.Environment.Platform
+ BuildBox.Data.Comparison: instance BuildBox.Pretty.Pretty a => BuildBox.Pretty.Pretty (BuildBox.Data.Comparison.Comparison a)
+ BuildBox.Data.Detail: instance BuildBox.Pretty.Pretty BuildBox.Data.Detail.Sized
+ BuildBox.Data.Detail: instance BuildBox.Pretty.Pretty BuildBox.Data.Detail.Timed
+ BuildBox.Data.Detail: instance BuildBox.Pretty.Pretty BuildBox.Data.Detail.Used
+ BuildBox.Data.Physical: instance BuildBox.Pretty.Pretty BuildBox.Data.Physical.Bytes
+ BuildBox.Data.Physical: instance BuildBox.Pretty.Pretty BuildBox.Data.Physical.Seconds
+ BuildBox.Data.Range: instance BuildBox.Pretty.Pretty a => BuildBox.Pretty.Pretty (BuildBox.Data.Range.Range a)
+ BuildBox.Pretty: (%%) :: Text -> Text -> Text
+ BuildBox.Pretty: (%) :: Text -> Text -> Text
+ BuildBox.Pretty: angles :: Text -> Text
+ BuildBox.Pretty: braces :: Text -> Text
+ BuildBox.Pretty: brackets :: Text -> Text
+ BuildBox.Pretty: char :: Char -> Text
+ BuildBox.Pretty: data Text :: *
+ BuildBox.Pretty: empty :: Text
+ BuildBox.Pretty: hcat :: [Text] -> Text
+ BuildBox.Pretty: hsep :: [Text] -> Text
+ BuildBox.Pretty: indents :: Int -> [Text] -> Text
+ BuildBox.Pretty: instance BuildBox.Pretty.Pretty Data.Text.Internal.Text
+ BuildBox.Pretty: instance BuildBox.Pretty.Pretty Data.Time.Clock.Internal.UTCTime.UTCTime
+ BuildBox.Pretty: instance BuildBox.Pretty.Pretty GHC.Base.String
+ BuildBox.Pretty: instance BuildBox.Pretty.Pretty GHC.Integer.Type.Integer
+ BuildBox.Pretty: instance BuildBox.Pretty.Pretty GHC.Types.Char
+ BuildBox.Pretty: instance BuildBox.Pretty.Pretty GHC.Types.Int
+ BuildBox.Pretty: parens :: Text -> Text
+ BuildBox.Pretty: string :: String -> Text
+ BuildBox.Pretty: text :: Text -> Text
+ BuildBox.Pretty: vcat :: [Text] -> Text
+ BuildBox.Pretty: vsep :: [Text] -> Text
- BuildBox: out :: Pretty a => a -> Build ()
+ BuildBox: out :: Text -> Build ()
- BuildBox: outLn :: Pretty a => a -> Build ()
+ BuildBox: outLn :: Text -> Build ()
- BuildBox.Build: out :: Pretty a => a -> Build ()
+ BuildBox.Build: out :: Text -> Build ()
- BuildBox.Build: outLn :: Pretty a => a -> Build ()
+ BuildBox.Build: outLn :: Text -> Build ()
- BuildBox.Command.Mail: renderMail :: Mail -> Doc
+ BuildBox.Command.Mail: renderMail :: Mail -> Text
- BuildBox.Pretty: padL :: Int -> Doc -> Doc
+ BuildBox.Pretty: padL :: Int -> Text -> Text
- BuildBox.Pretty: padLc :: Int -> Char -> Doc -> Doc
+ BuildBox.Pretty: padLc :: Int -> Char -> Text -> Text
- BuildBox.Pretty: padR :: Int -> Doc -> Doc
+ BuildBox.Pretty: padR :: Int -> Text -> Text
- BuildBox.Pretty: padRc :: Int -> Char -> Doc -> Doc
+ BuildBox.Pretty: padRc :: Int -> Char -> Text -> Text
- BuildBox.Pretty: ppr :: Pretty a => a -> Doc
+ BuildBox.Pretty: ppr :: Pretty a => a -> Text
- BuildBox.Pretty: pprEngDouble :: String -> Double -> Maybe Doc
+ BuildBox.Pretty: pprEngDouble :: String -> Double -> Maybe Text
- BuildBox.Pretty: pprEngInteger :: String -> Integer -> Maybe Doc
+ BuildBox.Pretty: pprEngInteger :: String -> Integer -> Maybe Text

Files

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.1 License:             BSD3 License-file:        LICENSE Author:              Ben Lippmeier@@ -23,17 +23,16 @@   Build-Depends:         base           >= 4.4 && < 4.12,         containers     >= 0.4 && < 0.6,-        time           >= 1.2 && < 1.9,-        directory      >= 1.1 && < 1.4,         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.5    ghc-options:         -Wall