packages feed

chatty 0.2.0.0 → 0.2.0.1

raw patch · 10 files changed

+77/−19 lines, 10 files

Files

System/Chatty/Commands.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +-- | Provides in-haskell implementations for some standard functions module System.Chatty.Commands where  import Text.Chatty.Printer@@ -14,37 +15,46 @@ import System.Directory import System.Posix.Files +-- | Like 'cat' on the command line. Accepts a list of filenames. Simple pass-through, if none are provided. cat :: (MonadScanner m, MonadPrinter m, MonadIO m,Functor m,MonadFinalizer m) => [String] -> m () cat [] = mscanL >>= mprint cat [f] = cat [] .<. f cat (f:fs) = cat [f] >> cat fs +-- | Like 'cat', but reverses the line order. tac :: (MonadFinalizer m,MonadScanner m, MonadPrinter m, MonadIO m,Functor m) => [String] -> m () tac [] = mscanL >>= (mprint . unlines . reverse . lines) tac fs = cat fs .|. tac [] +-- | Pass-through, simultanously writing all input to a given file. tee :: (MonadScanner m, MonadPrinter m, MonadIO m, Functor m) => String -> m () tee f = do   s <- mscanL   mprint s .>. f   mprint s +-- | Prints the given string, after expanding it. echo :: (MonadPrinter m,MonadExpand m) => String => m () echo = mprintLn <=< expand +-- | Mode for 'wc'. data WcMode = CountChars | CountLines | CountWords +-- | Count characters, lines or words of the input. wc :: (MonadScanner m, MonadPrinter m, MonadIO m, Functor m) => WcMode -> m () wc CountChars = mscanL >>= (mprint . show . length) >> mprint "\n" wc CountLines = mscanL >>= (mprint . show . length . lines) >> mprint "\n" wc CountWords = mscanL >>= (mprint . show . length . words) >> mprint "\n" +-- | Change to given directory. cd :: MonadIO m => String -> m () cd = liftIO . setCurrentDirectory +-- | Print current working directory. pwd :: (MonadIO m,MonadPrinter m) => m () pwd = liftIO getCurrentDirectory >>= mprintLn +-- | List directory contents of the given directories (current one, if empty list). ls :: (MonadIO m,MonadPrinter m) => [String] -> m () ls [] = liftIO (getDirectoryContents ".") >>= (mprint . unlines) ls [p] = do@@ -54,9 +64,11 @@   when (isRegularFile fs) $     mprintLn p ls (p:ps) = ls [p] >> ls ps-  ++-- | Filters only the first n lines of the input. head :: (MonadScanner m,MonadPrinter m,MonadIO m,Functor m) => Int -> m () head n = mscanL >>= (mprint . unlines . take n . lines) +-- | FIlters only the last n lines of the input. tail :: (MonadScanner m,MonadPrinter m,MonadIO m,Functor m) => Int -> m () tail n = mscanL >>= (mprint . unlines . reverse . take n . reverse . lines)
System/Chatty/Misc.hs view
@@ -1,18 +1,26 @@+-- | Provides typeclasses for clocks and randomizer environments module System.Chatty.Misc where  import Data.Time.Clock+import Data.Time.Calendar import System.Random +-- | Typeclass for all monads that know the time class (Functor m,Monad m) => MonadClock m where+  -- | Get UTC Time   mutctime :: m UTCTime-  mgetstamp :: m DiffTime-  mgetstamp = fmap utctDayTime mutctime+  -- | Get timestamp, guaranteed to grow+  mgetstamp :: m NominalDiffTime+  mgetstamp = fmap (diffUTCTime (UTCTime (fromGregorian 1970 1 1) (secondsToDiffTime 0))) mutctime  instance MonadClock IO where   mutctime = getCurrentTime +-- | Typeclass for all monads that may provide random numbers class Monad m => MonadRandom m where+  -- | Get a single random number   mrandom :: Random r => m r+  -- | Get a single random number in the given range   mrandomR :: Random r => (r,r) -> m r  instance MonadRandom IO where
System/Chatty/Spawn/Builtins.hs view
@@ -1,8 +1,10 @@+-- | Provides builtins for some common commands. module System.Chatty.Spawn.Builtins (withBuiltins) where  import System.Chatty.Spawn import System.Chatty.Spawn.Overlay +-- | Use builtins if possible. withBuiltins :: (Functor m, MonadSpawn m) => SpawnOverlayT m a -> m a withBuiltins m = fmap fst $ runSpawnOverlayT m builtins
System/Chatty/Spawn/Overlay.hs view
@@ -1,3 +1,4 @@+-- | Provides a MonadSpawn overlay that may catch specific spawn calls and handle them itself. module System.Chatty.Spawn.Overlay where  import System.Chatty.Spawn@@ -5,6 +6,7 @@ import Control.Monad.IO.Class import System.IO +-- | MonadSpawn overlay. Carries a map of own command implementations that are called instead of the actual ones. newtype SpawnOverlayT m a = SpawnOverlay { runSpawnOverlayT :: [(String,[String] -> String -> m (Int,String))] -> m (a,[(String,[String] -> String -> m (Int,String))]) }  instance Monad m => Monad (SpawnOverlayT m) where
Text/Chatty/Expansion.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE ExistentialQuantification, RankNTypes, Rank2Types #-} +-- | Provides generic string expansion and a variable expander module Text.Chatty.Expansion where  import Data.List@@ -11,7 +12,11 @@ import System.Posix.Env (getEnv, setEnv) --import System.SetEnv -data EnvVar = NotSet | Literal String | forall a.Show a => Scalar a | Array [EnvVar]+-- | Some environment variable+data EnvVar = NotSet                       -- ^ Not set.+            | Literal String               -- ^ An embeddable string.+            | forall a.Show a => Scalar a  -- ^ Something we can show.+            | Array [EnvVar]               -- ^ Array of that  instance Show EnvVar where   show (Scalar s) = show s@@ -19,6 +24,7 @@   show (Array ps) = unwords $ map show ps   show NotSet = "" +-- | Environment storage and variable expander. newtype ExpanderT m a = Expander {     runExpanderT :: [(String,EnvVar)] -> m (a,[(String,EnvVar)])   }@@ -36,21 +42,27 @@ instance Monad m => Functor (ExpanderT m) where   fmap f a = Expander $ \vs -> do (a',vs') <- runExpanderT a vs; return (f a',vs') +-- | Run this function inside a blank environment. localEnvironment :: Functor m => ExpanderT m a -> m a localEnvironment m = fmap fst $ runExpanderT m [] +-- | Run this function in a locally modifiable, but not exported environment forkEnvironment :: (Functor m,Monad m,MonadIO m) => ExpanderT m a -> m a forkEnvironment m = do   es <- liftIO getEnvironment   fmap fst $ runExpanderT m $ fmap (second Literal) es +-- | Export this local environment. exportAll :: (Monad m,MonadIO m) => ExpanderT m () exportAll = Expander $ \vs -> do   liftIO $ forM_ vs $ \(k,v) -> setEnv k (show v) True   return ((),vs) +-- | Typeclass for all environment storages. class Monad ee => ExpanderEnv ee where+  -- | Get environment variable   mgetv :: String -> ee EnvVar+  -- | Put environment variable   mputv :: String -> EnvVar -> ee ()  instance Monad m => ExpanderEnv (ExpanderT m) where@@ -64,7 +76,9 @@   mgetv = fmap (\v -> case v of Nothing -> NotSet; Just v' -> Literal v') . getEnv   mputv k v = setEnv k (show v) True +-- | Typeclass for all string-expanding monads. class Monad e => MonadExpand e where+  -- | Expand the given string.   expand :: String -> e String  instance MonadExpand IO where@@ -73,6 +87,7 @@ instance Monad m => MonadExpand (ExpanderT m) where   expand = expandVars +-- | Expand $variables. expandVars :: (Monad m,Functor m,ExpanderEnv m) => String -> m String expandVars [] = return [] expandVars ('$':ss) =@@ -84,5 +99,6 @@     return (v++r) expandVars (s:ss) = do ss' <- expandVars ss; return (s:ss') +-- | Is alphanumeric? isAnum = (`elem` (['a'..'z']++['A'..'Z']++"_"++['0'..'9']))
Text/Chatty/Extended/ANSI.hs view
@@ -1,3 +1,4 @@+-- | Provides an ExtendedPrinter that handles colours using standardized ANSI codes. module Text.Chatty.Extended.ANSI where  import qualified System.Console.ANSI as A@@ -6,6 +7,7 @@ import Text.Chatty.Printer import Text.Chatty.Extended.Printer +-- | An ExtendedPrinter that uses ANSI colour codes. newtype AnsiPrinterT m a = AnsiPrinter { runAnsiPrinterT :: Colour -> m a }  instance Monad m => Monad (AnsiPrinterT m) where@@ -30,9 +32,11 @@   estart c = AnsiPrinter $ \c1 -> mprint $ A.setSGRCode [A.SetColor A.Foreground (mkColourInt c) (mkColourCode c)]   efin = AnsiPrinter $ \c1 -> mprint $ A.setSGRCode [A.SetColor A.Foreground (mkColourInt c1) (mkColourCode c1)] +-- | Convert Chatty's colour intensity to ansi-terminal's one mkColourInt (Dull _) = A.Dull mkColourInt (Vivid _) = A.Vivid +-- | Convert Chatty's colour tone to ansi-terminal's one mkColourCode (Dull c) = mkColourCode (Vivid c) mkColourCode (Vivid c) = case c of   Green -> A.Green
Text/Chatty/Extended/HTML.hs view
@@ -1,3 +1,4 @@+-- | Provides an 'ExtendedPrinter' that handles colours using HTML output. module Text.Chatty.Extended.HTML where  import Text.Chatty.Printer@@ -5,6 +6,7 @@ import Control.Monad.Trans.Class import Control.Monad.IO.Class +-- | An 'ExtendedPrinter' for HTML output. newtype HtmlPrinterT m a = HtmlPrinter { runHtmlPrinterT :: m a }  instance Monad m => Monad (HtmlPrinterT m) where@@ -29,6 +31,7 @@   estart c =  lift $ mprint $ concat ["<span style=\"color: #", hexColour c, ";\">"]   efin = lift $ mprint "</span>" +-- | Convert the given character to its HTML representation. maskHtml :: Char -> String maskHtml '&' = "&amp;" maskHtml '<' = "&lt;"@@ -36,6 +39,7 @@ maskHtml ' ' = "&nbsp;" maskHtml c = [c] +-- | Convert the given colour to its CSS representation. hexColour (Dull Green) = "004400" hexColour (Vivid Green) = "00FF00" hexColour (Dull Red) = "440000"
Text/Chatty/Extended/Printer.hs view
@@ -1,17 +1,26 @@+-- | Provides an extended printer class that supports colours. module Text.Chatty.Extended.Printer where  import Text.Chatty.Printer +-- | Colour tone. data Tone = Green | Red | Yellow | Blue | Black | White | Cyan | Magenta+-- | Colour brightness data Colour = Dull Tone | Vivid Tone +-- | Typeclass for all printers that support colourized output. class MonadPrinter m => ExtendedPrinter m where+  -- | Run the function with the given colour.   ebracket :: Colour -> m a -> m a   ebracket c m = do estart c; a <- m; efin; return a+  -- | Print the string in the given colour.   eprint :: Colour -> String -> m ()   eprint c = ebracket c . mprint+  -- | Print the string in the given colour and terminate the line.   eprintLn :: Colour -> String -> m ()   eprintLn c s = eprint c s >> mprintLn ""+  -- | Start using the specified colour.   estart :: Colour -> m ()+  -- | Reset colour.   efin :: m ()
Text/Chatty/Printer.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-} +-- | Provides a typeclass for all monads that may print text. module Text.Chatty.Printer where  import Control.Arrow@@ -27,7 +28,7 @@ instance Monad m => MonadPrinter (StateT String m) where   mprint s = modify (++s) --- | DeafT discards all output (much like >/dev/null in the shell)+-- | DeafT discards all output (much like >\/dev\/null in the shell) newtype DeafT m a = Deaf { runDeafT :: m a }  instance Monad m => Monad (DeafT m) where@@ -47,9 +48,9 @@   mprint _ = return ()  -- Definition of OutRedirT + instances--- | OutRedirT redirects all output to a given handle (much like >filename in the shell)+-- | Redirects all output to a given handle (much like >filename in the shell) newtype OutRedirT m a = OutRedir { runOutRedirT' :: Handle -> m (a,Handle) }--- | OutRedirT on a blank IO monad+-- | 'OutRedirT' on a blank 'IO' monad type OutRedir = OutRedirT IO  instance Monad m => Monad (OutRedirT m) where@@ -69,15 +70,15 @@ instance Monad m => Functor (OutRedirT m) where   fmap f a = OutRedir $ \h -> do (a',h') <- runOutRedirT' a h; return (f a',h') --- | Run OutRedirT with a handle+-- | Run 'OutRedirT' with a 'Handle' runOutRedirT :: Functor m => OutRedirT m a -> Handle -> m a runOutRedirT m h = fmap fst $ runOutRedirT' m h --- | Run OutRedir with a handle+-- | Run 'OutRedir' with a 'Handle' runOutRedir :: OutRedir a -> Handle -> IO a runOutRedir = runOutRedirT --- | Run OutRedirT with a filename+-- | Run 'OutRedirT' with a 'FilePath' runOutRedirFT :: (Functor m,MonadIO m) => OutRedirT m a -> FilePath -> IOMode -> m a runOutRedirFT m fp md   | md `elem` [AppendMode,WriteMode] = do@@ -87,14 +88,14 @@     return a   | otherwise = error "runOutRedirFT does only accept AppendMode or WriteMode." --- | Run OutRedir with a filename+-- | Run 'OutRedir' with a 'FilePath' runOutRedirF :: OutRedir a -> FilePath -> IOMode -> IO a runOutRedirF = runOutRedirFT  -- Definition of RecorderT + instances--- | RecorderT catches all output (much like VAR=$(...) in the shell)+-- | Catches all output (much like VAR=$(...) in the shell) newtype RecorderT m a = Recorder { runRecorderT' :: [String] -> m (a,[String]) }--- | RecorderT on identity+-- | 'RecorderT' on the 'Identity' type Recorder = RecorderT Identity  instance Monad m => Monad (RecorderT m) where@@ -114,11 +115,11 @@   liftIO = lift . liftIO  -- Helper methods for RecorderT--- | The recorder state. Use this together with replay, replayM or replay_+-- | The recorder state. Use this together with 'replay', 'replayM' or 'replay_'. newtype Replayable = Replayable [String] instance Show Replayable where show r = show ((\(Replayable x) -> length x) r) ++ ":" ++ show (replay r) --- | Replay a recorder state inside a monad.+-- | Replay a recorder state inside a 'Monad'. replayM :: Monad m => m Replayable -> m String replayM r = do (Replayable r') <- r; return (concat $ reverse r') @@ -130,15 +131,15 @@ replay_ :: Monad m => RecorderT m String replay_ = Recorder $ \s -> return (concat $ reverse s,s) --- | Run Recorder and also return its state.+-- | Run 'Recorder' and also return its state. runRecorder :: Recorder a -> (a,Replayable) runRecorder = second Replayable . runIdentity . flip runRecorderT' [] --- | Run RecorderT and also return its state.+-- | Run 'RecorderT' and also return its state. runRecorderT :: (Functor m,Monad m) => RecorderT m a -> m (a,Replayable) runRecorderT = fmap (second Replayable) . flip runRecorderT' [] --- | Line-terminating alternative to mprint+-- | Line-terminating alternative to 'mprint' mprintLn :: MonadPrinter m => String -> m () mprintLn = mprint . (++"\n")
chatty.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.0.0+version:             0.2.0.1  -- A short (one-line) description of the package. synopsis:            Some monad transformers and typeclasses to simplify I/O on a transformer stack.