abstract

Ben will talk about building unix command line tools in Haskell. He will talk about some of the standards and traditions that commandline tools should follow, and a handful of Haskell libraries that help make that happen - including command line option parsing, pretty colours, and interacting nicely with other tools in a build chain.

Commandline Tools in Haskell

Ben Clifford

benc@hawaga.org.uk


module Main where

main :: IO ()
main = putStrLn "hello"
$ main
hello

The unix philosophy

Someone (Doug McIlroy / Peter H. Salus?):

  • Write programs that do one thing and do it well.
  • Write programs to work together.
  • Write programs to handle text streams, because that is a universal interface.

* I'm going to talk about libraries to do this things, and a little bit
of the unix philosophy that goes with each concept as we go along.

Handling text streams


module Main where

main :: IO ()
main = do
  t <- getContents
  putStr t
  putStr t
  putStrLn $ "There were "
          ++ (show . length) t
          ++ " characters"
$ duplicate
hello
hello
world
world
CTRl-D
hello
world
There were 12 characters

stderr (I)

$ duplicate > out.txt
hello
world
CTRL-D

stderr (2)


module Main where

import System.IO (hPutStrLn, stderr)

main :: IO ()
main = do
  t <- getContents
  putStr t
  putStr t
  hPutStrLn stderr $ "There were "
                  ++ (show . length) t
                  ++ " characters"
$ duplicate > out.txt
hello
world
CTRL-D
There were 12 characters

Streaming laziness


module Main where

main :: IO ()
main = do
  t <- getContents
  putStr t
  putStr t
  putStrLn $ "There were "
          ++ (show . length) t
          ++ " characters"
$ duplicate
hello
hello
world
world
CTRl-D
hello
world
There were 12 characters

Exit codes


data ExitCode
  = ExitSuccess
  | ExitFailure Int

exitWith :: ExitCode -> IO a

Exit codes (bad)


module Main where

import System.IO (hPutStrLn, stderr)

main :: IO ()
main = do
  t <- getContents
  if length t == 0
  then hPutStrLn stderr "ERROR: no lines provided"
  else process t

process _ = pure ()
ERROR: no lines provided
$ echo $?
0   # success!

Exit codes (good)


module Main where

import System.IO (hPutStrLn, stderr)

main :: IO ()
main = do
  t <- getContents
  if length t == 0
  then error "ERROR: no lines provided"
  else process t

process _ = pure ()
exitbad-exe: ERROR: no lines provided
CallStack (from HasCallStack):
  error, called at app/Main.hs:9:8 in main:Main
$ echo $?
1

Exit codes (good, 2)


module Main where

import System.IO (hPutStrLn, stderr)
import System.Exit (exitWith, ExitCode (ExitFailure))

main :: IO ()
main = do
  t <- getContents
  if length t == 0
  then do hPutStrLn stderr "ERROR: no lines provided"
          exitWith (ExitFailure 3)
  else process t

process _ = pure ()
ERROR: no lines provided
$ echo $?
3

The environment

TERM=xterm
HOME=/home/benc
XDG_RUNTIME_DIR=/run/user/1000
LOGNAME=benc

Reading the environment


import System.Environment
getEnvironment :: IO [(String, String)]
getEnv :: String -> IO String 

Running other processes


data CreateProcess = CreateProcess {
  cmdspec      :: CmdSpec,      cwd     :: Maybe FilePath,
  env          :: Maybe [(String,String)],
  std_in       :: StdStream,
  std_out      :: StdStream,    std_err :: StdStream,
  close_fds    :: Bool,
  create_group :: Bool,         delegate_ctlc:: Bool,
  detach_console :: Bool,       create_new_console :: Bool,
  new_session :: Bool,
  child_group :: Maybe GroupID, child_user :: Maybe UserID,
  use_process_jobs :: Bool      } deriving (Show, Eq)

createProcess :: CreateProcess -> IO (Maybe Handle,
                 Maybe Handle, Maybe Handle, ProcessHandle)

module Main where

import System.Process
import System.IO (hPutStrLn, stderr)

main :: IO ()
main = do
  let filename = "/tmp/somefile"
  hPutStrLn stderr "Launching editor"
  callProcess "nano" [filename]
  t <- readFile filename
  hPutStrLn stderr ("Editor returned, with contents: " ++ t)

demo?


module Main where

import System.Process
import System.IO (hPutStrLn, stderr)

main = do
  let a = 5
  let b = 3
  let input = show a ++ " + " ++ show b ++ "\n"
  output <- readProcess "bc" [] input
  let r = read output 
  putStrLn $ "Result is " ++ show r
  if a + b == r then putStrLn "correct" else error "wrong"
$ adder
Result is 8
correct

Console colours

$ ls
ChangeLog.md  README.md  app             package.yaml  stack.yaml
LICENSE       Setup.hs   optparse.cabal  src           test


/home/benc/app/Main.hs:31:22: error:
    Variable not in scope: isPrefixOf :: String -> [Char] -> Bool
   |
31 |   return $ filter (p `isPrefixOf`) ["1", "8", "256"]
   |                      ^^^^^^^^^^^^

module Main where
import System.Console.ANSI -- from ansi-terminal package
import System.IO (stdout)
import Control.Monad (when)

main = do
  c <- hSupportsANSI stdout
  when c $ setSGR [Reset, SetColor Foreground Dull Yellow]
  putStr "hello "
  when c $ setSGR [Reset, SetColor Background Dull Cyan,
                          SetColor Foreground Dull Black]
  putStr "world"
  when c $ setSGR [Reset]
  putStrLn "."
$ ansi
hello world.
$ ansi
hello world.
$ ansi | less
hello world.
$ bad-ansi | less
ESC[0;33mhello ESC[0;46;30mworldESC[0m.

Command Line Options

$ ls
ChangeLog.md  README.md  app             package.yaml  stack.yaml
LICENSE       Setup.hs   optparse.cabal  src           test

$ ls --sort=size --format=long
total 40
drwxr-xr-x 2 benc benc 4096 May 29 07:04 app
drwxr-xr-x 2 benc benc 4096 May 29 07:04 src
drwxr-xr-x 2 benc benc 4096 May 29 07:04 test
-rw-r--r-- 1 benc benc 2134 May 29 07:04 stack.yaml
-rw-r--r-- 1 benc benc 1529 May 29 07:04 LICENSE
-rw-r--r-- 1 benc benc 1500 May 29 07:04 optparse.cabal
-rw-r--r-- 1 benc benc 1177 May 29 07:04 package.yaml
-rw-r--r-- 1 benc benc   48 May 29 07:04 ChangeLog.md
-rw-r--r-- 1 benc benc   46 May 29 07:04 Setup.hs
-rw-r--r-- 1 benc benc   11 May 29 07:04 README.md

import System.Environment

getArgs :: IO [String]
["--sort=size", "--format=long"]

optparse-applicative: defintion


module Main where
import Options.Applicative

data Config = Config { verbose :: Bool }

configOpts :: Parser Config
configOpts = Config <$> switch (long "verbose" <> short 'v')

main = do config <- execParser (info configOpts mempty)
       runWith config

runWith :: Config -> IO ()
runWith c = putStrLn $ if verbose c then "Verbose output"
                                    else "ssssh"

optparse-applicative: use

$ prog
ssssh

$ prog -v
Verbose output

$ prog --verbose
Verbose output

$ prog --debug
Invalid option `--debug'

Usage: prog [-v|--verbose]

optparse-applicative: help


data Config = Config { verbose :: Bool, count :: Int }

configOpts :: Parser Config
configOpts = Config 
 <$> switch ( long "verbose" <> short 'v'
           <> help "Enable verbose output")
 <*> option auto ( long "count" <> help "How many?"
                <> metavar "PIES")

main = do
  config <- execParser (info (configOpts <**> helper)
                             (header "Opts example"))
  runWith config

optparse-applicative: help usage

$ prog --help
Opts example

Usage: prog [-v|--verbose] --count PIES

Available options:
  -v,--verbose             Enable verbose output
  --count PIES             How many?
  -h,--help                Show this help text

tab completion

$ ls
ChangeLog.md  README.md  app             package.yaml  stack.yaml
LICENSE       Setup.hs   optparse.cabal  src           test
$ cat opt<TAB>parse.cabal
$ git log -r <TAB><TAB>
HEAD     master   
$ git log -r mas<TAB>ster

$ source <(prog --bash-completion-script `which prog`)

$ prog <TAB><TAB>-
--count    --help     --verbose  -h         -v         
$ prog --ver<TAB>bose

Custom tab completion


data Config = Config { verbose :: Bool, count :: Int }

configOpts :: Parser Config
configOpts = Config
 <$> switch ( long "verbose" <> short 'v'
           <> help "Enable verbose output")
 <*> option auto ( long "count" <> help "How many?"
                                <> metavar "PIES"
                                <> completer myCompleter)

myCompleter :: Completer
myCompleter = mkCompleter $ \p -> do
  hPutStr stderr "[IN COMPLETER]"
  return $ filter (p `isPrefixOf`) ["1", "8", "256"]

Summary

  • Text streams: stdin, stdout, stderr
  • Exit codes: reporting success or failure
  • The environment
  • Running other processes
  • Console colours and ANSI fun
  • Command Line Options