├── .gitignore ├── .stylish-haskell.yaml ├── LICENSE ├── README.md ├── Setup.hs ├── haskell-script-examples.cabal └── src ├── cat.hs ├── curl.hs ├── dataimporter.hs ├── echo.hs ├── head.hs ├── redditcrawler.hs └── tee.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .hpc 10 | .hsenv 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | *.prof 14 | *.aux 15 | *.hp 16 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # stylish-haskell configuration file 2 | # ================================== 3 | 4 | # The stylish-haskell tool is mainly configured by specifying steps. These steps 5 | # are a list, so they have an order, and one specific step may appear more than 6 | # once (if needed). Each file is processed by these steps in the given order. 7 | steps: 8 | # Convert some ASCII sequences to their Unicode equivalents. This is disabled 9 | # by default. 10 | # - unicode_syntax: 11 | # # In order to make this work, we also need to insert the UnicodeSyntax 12 | # # language pragma. If this flag is set to true, we insert it when it's 13 | # # not already present. You may want to disable it if you configure 14 | # # language extensions using some other method than pragmas. Default: 15 | # # true. 16 | # add_language_pragma: true 17 | 18 | # Import cleanup 19 | - imports: 20 | # There are different ways we can align names and lists. 21 | # 22 | # - global: Align the import names and import list throughout the entire 23 | # file. 24 | # 25 | # - file: Like global, but don't add padding when there are no qualified 26 | # imports in the file. 27 | # 28 | # - group: Only align the imports per group (a group is formed by adjacent 29 | # import lines). 30 | # 31 | # - none: Do not perform any alignment. 32 | # 33 | # Default: global. 34 | align: file 35 | 36 | # Language pragmas 37 | - language_pragmas: 38 | # We can generate different styles of language pragma lists. 39 | # 40 | # - vertical: Vertical-spaced language pragmas, one per line. 41 | # 42 | # - compact: A more compact style. 43 | # 44 | # - compact_line: Similar to compact, but wrap each line with 45 | # `{-#LANGUAGE #-}'. 46 | # 47 | # Default: vertical. 48 | style: vertical 49 | 50 | # stylish-haskell can detect redundancy of some language pragmas. If this 51 | # is set to true, it will remove those redundant pragmas. Default: true. 52 | remove_redundant: true 53 | 54 | # Align the types in record declarations 55 | - records: {} 56 | 57 | # Replace tabs by spaces. This is disabled by default. 58 | # - tabs: 59 | # # Number of spaces to use for each tab. Default: 8, as specified by the 60 | # # Haskell report. 61 | # spaces: 8 62 | 63 | # Remove trailing whitespace 64 | - trailing_whitespace: {} 65 | 66 | # A common setting is the number of columns (parts of) code will be wrapped 67 | # to. Different steps take this into account. Default: 80. 68 | columns: 80 69 | 70 | # Sometimes, language extensions are specified in a cabal file or from the 71 | # command line instead of using language pragmas in the file. stylish-haskell 72 | # needs to be aware of these, so it can parse the file correctly. 73 | # 74 | # No language extensions are enabled by default. 75 | # language_extensions: 76 | # - TemplateHaskell 77 | # - QuasiQuotes 78 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Christopher Mckay 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell scripting examples # 2 | 3 | After you've gone and done that haskell beginners course and learned to think 4 | functionally you go to work with giant ideas of writing perfect functional code 5 | and building a better world. Then the suit from accounting turns up and needs a 6 | script to put a csv in a database and they need it right now, so you betray your 7 | bright new ideas and reach for ruby/perl/python/bash/go to do it fast because 8 | you know how to do such things in that language fast. 9 | 10 | In this talk we'll be doing a code review of some simple haskell scripts that do 11 | common scripty tasks like taking input, reading things, printing things, calling 12 | webservices, reading csvs, and querying databases. Armed with these examples you 13 | should be prepared to introduce haskell to your workplace via dodgy scripts. 14 | 15 | # Reading order # 16 | 1. [echo.hs](src/echo.hs) 17 | - basic cli args 18 | - basic printing 19 | 2. [cat.hs](src/cat.hs) 20 | - reading a file 21 | 3. [head.hs](src/head.hs) 22 | - complex cli args 23 | 4. [tee.hs](src/tee.hs) 24 | - IO handles 25 | - writing files 26 | 5. [curl.hs](src/curl.hs) 27 | - making http requests 28 | 6. [redditcrawler.hs](src/redditcrawler.hs) 29 | - reading json webservices 30 | - writing csvs 31 | 7. [dataimporter.hs](src/dataimporter.hs) 32 | - reading csvs 33 | - running db queries 34 | 35 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /haskell-script-examples.cabal: -------------------------------------------------------------------------------- 1 | -- Initial haskell-script-examples.cabal generated by cabal init. For 2 | -- further documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: haskell-script-examples 5 | version: 0.1.0.0 6 | synopsis: Example haskell scripts 7 | -- description: 8 | license: MIT 9 | license-file: LICENSE 10 | author: Christopher Mckay 11 | maintainer: chris at error dot cm 12 | -- copyright: 13 | -- category: 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | executable echo 19 | main-is: echo.hs 20 | -- other-modules: 21 | -- other-extensions: 22 | build-depends: base >=4.8 && <4.9 23 | hs-source-dirs: src 24 | default-language: Haskell2010 25 | 26 | executable cat 27 | main-is: cat.hs 28 | -- other-modules: 29 | -- other-extensions: 30 | build-depends: base >=4.8 && <4.9 31 | hs-source-dirs: src 32 | default-language: Haskell2010 33 | 34 | executable head 35 | main-is: head.hs 36 | -- other-modules: 37 | -- other-extensions: 38 | build-depends: base >=4.8 && <4.9 39 | , optparse-applicative == 0.11.* 40 | hs-source-dirs: src 41 | default-language: Haskell2010 42 | 43 | executable tee 44 | main-is: tee.hs 45 | -- other-modules: 46 | -- other-extensions: 47 | build-depends: base >=4.8 && <4.9 48 | , optparse-applicative == 0.11.* 49 | hs-source-dirs: src 50 | default-language: Haskell2010 51 | 52 | executable curl 53 | main-is: curl.hs 54 | -- other-modules: 55 | -- other-extensions: 56 | build-depends: base >=4.8 && <4.9 57 | , optparse-applicative == 0.11.* 58 | , wreq == 0.4.* 59 | , lens == 4.* 60 | , text == 1.2.* 61 | hs-source-dirs: src 62 | default-language: Haskell2010 63 | 64 | executable redditcrawler 65 | main-is: redditcrawler.hs 66 | -- other-modules: 67 | -- other-extensions: 68 | build-depends: base >=4.8 && <4.9 69 | , optparse-applicative == 0.11.* 70 | , wreq == 0.4.* 71 | , lens == 4.* 72 | , bytestring == 0.10.* 73 | , aeson == 0.9.* 74 | , text == 1.2.* 75 | , cassava == 0.4.* 76 | hs-source-dirs: src 77 | default-language: Haskell2010 78 | 79 | executable dataimporter 80 | main-is: dataimporter.hs 81 | -- other-modules: 82 | -- other-extensions: 83 | build-depends: base >=4.8 && <4.9 84 | , optparse-applicative == 0.11.* 85 | , cassava == 0.4.* 86 | , bytestring == 0.10.* 87 | , text == 1.2.* 88 | , vector == 0.10.* 89 | , postgresql-simple == 0.4.* 90 | hs-source-dirs: src 91 | default-language: Haskell2010 -------------------------------------------------------------------------------- /src/cat.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Foldable (forM_) 4 | import System.Environment (getArgs) 5 | 6 | -- cat 7 | main :: IO() 8 | main = do 9 | -- Get a list of args 10 | args <- getArgs 11 | -- read the named files 12 | fileContents <- mapM readFile args 13 | -- print the files contents 14 | forM_ fileContents putStrLn 15 | -------------------------------------------------------------------------------- /src/curl.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Lens ((^.)) 4 | import Data.Foldable (forM_) 5 | import Data.Text.Lazy.Encoding (decodeUtf8) 6 | import qualified Data.Text.Lazy.IO as TIO (putStrLn) 7 | import qualified Network.Wreq as W 8 | import qualified Network.Wreq.Session as WS 9 | import Options.Applicative (Parser, ParserInfo, argument, 10 | execParser, fullDesc, header, help, 11 | helper, info, many, metavar, progDesc, 12 | str, (<*>), (<>)) 13 | 14 | -- curl 15 | main :: IO () 16 | main = do 17 | -- run the options parser over the cli arguments 18 | opts <- execParser optsParserInfo 19 | -- start up a wreq session 20 | responses <- WS.withSession $ \sess -> 21 | -- make a get request for each url 22 | traverse (WS.get sess) (urls opts) 23 | -- extract the bodies from each request 24 | let bodies = map (\r -> decodeUtf8 $ r ^. W.responseBody) responses 25 | -- print the bodies 26 | forM_ bodies TIO.putStrLn 27 | 28 | -- structure to hold cli arguments 29 | data Options = Options 30 | { urls :: [String] 31 | } 32 | 33 | -- Parser for cli arguments 34 | optsParser :: Parser Options 35 | optsParser = Options 36 | <$> many ( 37 | argument str 38 | ( metavar "URLS" 39 | <> help "Urls to request" 40 | ) 41 | ) 42 | 43 | -- Adding program help text to the parser 44 | optsParserInfo :: ParserInfo Options 45 | optsParserInfo = info (helper <*> optsParser) 46 | ( fullDesc 47 | <> progDesc "A bad clone of curl" 48 | <> header "curl - a bad clone of the real curl" 49 | ) 50 | -------------------------------------------------------------------------------- /src/dataimporter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | module Main where 4 | 5 | import qualified Data.ByteString.Lazy as BSL 6 | import qualified Data.Csv as Csv 7 | import Data.Int (Int64) 8 | import Data.Text (Text) 9 | import qualified Data.Text as T 10 | import Data.Vector (Vector) 11 | import qualified Database.PostgreSQL.Simple as Psql 12 | import GHC.Generics (Generic) 13 | import Options.Applicative (Parser, ParserInfo, argument, auto, 14 | execParser, fullDesc, header, help, 15 | helper, info, long, metavar, 16 | option, progDesc, str, strOption, 17 | (<*>), (<>)) 18 | import System.Exit (exitFailure, exitSuccess) 19 | import System.IO (hFlush, hSetEcho, stdin, stdout) 20 | 21 | -- structure to hold cli arguments 22 | data Options = Options 23 | { inputFilename :: String 24 | , dbHost :: String 25 | , dbPort :: Int 26 | , dbName :: String 27 | , dbUser :: String 28 | } 29 | 30 | -- Parser for cli arguments 31 | optsParser :: Parser Options 32 | optsParser = Options 33 | <$> argument str 34 | ( metavar "FILE" 35 | <> help "input file" 36 | ) 37 | <*> strOption 38 | ( long "dbhost" 39 | <> metavar "HOSTNAME" 40 | <> help "The hostname of the database" 41 | ) 42 | <*> option auto 43 | ( long "dbport" 44 | <> metavar "NUMBER" 45 | <> help "The port of the database" 46 | ) 47 | <*> strOption 48 | ( long "dbname" 49 | <> metavar "NAME" 50 | <> help "The name of the database" 51 | ) 52 | <*> strOption 53 | ( long "dbuser" 54 | <> metavar "USERNAME" 55 | <> help "The user of the database" 56 | ) 57 | 58 | -- Adding program help text to the parser 59 | optsParserInfo :: ParserInfo Options 60 | optsParserInfo = info (helper <*> optsParser) 61 | ( fullDesc 62 | <> progDesc "A csv importer" 63 | <> header "dataimporter - a csv importer" 64 | ) 65 | 66 | -- data importer 67 | main :: IO () 68 | main = do 69 | -- run the options parser over the cli arguments 70 | opts <- execParser optsParserInfo 71 | -- read in the users password 72 | dbPass <- getPassword 73 | -- read the input files contents 74 | fileContents <- BSL.readFile $ inputFilename opts 75 | -- parse the file contents 76 | let csvContents = decodeCsv fileContents 77 | -- deal with the csv failing to parse 78 | case csvContents of Left e -> do 79 | -- if it failed, exit like a dirty script 80 | putStrLn e 81 | exitFailure 82 | Right (_, saleRecords) -> do 83 | -- connect to the database 84 | conn <- makeConnection opts dbPass 85 | -- insert the sale records into the db 86 | _ <- insertSaleRecords conn saleRecords 87 | exitSuccess 88 | 89 | 90 | -- capture the password with a blind input 91 | getPassword :: IO String 92 | getPassword = do 93 | -- output some prompt text 94 | putStr "password: " 95 | -- flush stdout to make sure the prompt appears 96 | -- normally only flushes on new lines or buffer being filled 97 | hFlush stdout 98 | -- turn off stdin echoing 99 | hSetEcho stdin False 100 | -- capture 1 line of input, the password 101 | dbPass <- getLine 102 | -- turn stdin echoing back on 103 | hSetEcho stdin True 104 | -- print a new line to give the user some feedback 105 | putStrLn "" 106 | return dbPass 107 | 108 | -- data type representing our csv rows 109 | data SaleRecord = SaleRecord 110 | { item :: Text 111 | , quantity :: Int 112 | , price :: Double 113 | } deriving (Generic) 114 | 115 | -- FromNamedRecord lets cassava read a row matching the column titles to 116 | -- record element names 117 | instance Csv.FromNamedRecord SaleRecord 118 | 119 | -- decode the csv files contents 120 | decodeCsv :: BSL.ByteString -> Either String (Csv.Header, Vector SaleRecord) 121 | -- decodeByName uses the column headers and FromNamedRecord instance to create 122 | -- the SaleRecords 123 | decodeCsv fileContents = Csv.decodeByName fileContents 124 | 125 | -- creates a ConnectInfo from our options and then connects to the db with it 126 | makeConnection :: Options -> String -> IO Psql.Connection 127 | makeConnection opts pass = Psql.connect $ Psql.ConnectInfo 128 | (dbHost opts) 129 | (fromIntegral $ dbPort opts) 130 | (dbUser opts) 131 | pass 132 | (dbName opts) 133 | 134 | insertSaleRecords :: Psql.Connection -> Vector SaleRecord -> IO (Vector Int64) 135 | insertSaleRecords conn srs = do 136 | -- run inside of a transaction 137 | rets <- Psql.withTransaction conn $ 138 | -- runs an insert statement for each SaleRecord 139 | mapM (insertSaleRecord conn) srs 140 | return rets 141 | 142 | insertSaleRecord :: Psql.Connection -> SaleRecord -> IO Int64 143 | insertSaleRecord conn sr = 144 | -- execute a raw sql statement with a list of parameters 145 | Psql.execute conn "insert into sales (item, quantity, price) values (?, ?, ?)" 146 | [ item sr 147 | , T.pack . show $ quantity sr 148 | , T.pack . show $ price sr 149 | ] 150 | -------------------------------------------------------------------------------- /src/echo.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.List (intercalate) 4 | import System.Environment (getArgs) 5 | 6 | -- echo 7 | main :: IO() 8 | main = do 9 | -- Get list of args 10 | args <- getArgs 11 | -- do something with the args 12 | let output = intercalate " " args 13 | -- print some output 14 | putStrLn output 15 | -------------------------------------------------------------------------------- /src/head.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Foldable (forM_) 4 | import Options.Applicative (Parser, ParserInfo, argument, auto, execParser, 5 | fullDesc, header, help, helper, info, long, metavar, 6 | option, progDesc, short, str, value, (<$>), (<>)) 7 | 8 | -- head 9 | main :: IO() 10 | main = do 11 | -- run the parser over the cli arguments 12 | opts <- execParser optsParserInfo 13 | -- read the file 14 | fileContents <- readFile $ filename opts 15 | -- split the contents of the file into lines 16 | let fileLines = lines fileContents 17 | -- take the number of lines specified in the options 18 | let headLines = take (lineCount opts) fileLines 19 | -- print the desired lines 20 | forM_ headLines putStrLn 21 | 22 | -- Structure to hold cli arguments 23 | data Options = Options 24 | { filename :: String 25 | , lineCount :: Int 26 | } 27 | 28 | -- Parser for the cli arguments 29 | optsParser :: Parser Options 30 | optsParser = Options 31 | <$> argument str 32 | ( metavar "FILENAME" 33 | <> help "Input filename" 34 | ) 35 | <*> option auto 36 | ( short 'n' 37 | <> long "numlines" 38 | <> metavar "NUM" 39 | <> help "Number of lines to read" 40 | <> value 10 41 | ) 42 | 43 | -- Adding program help text to the parser 44 | optsParserInfo :: ParserInfo Options 45 | optsParserInfo = info (helper <*> optsParser) 46 | ( fullDesc 47 | <> progDesc "A bad clone of head" 48 | <> header "head - a bad clone of the real head" 49 | ) 50 | -------------------------------------------------------------------------------- /src/redditcrawler.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Main where 5 | 6 | import Control.Lens ((^.)) 7 | import Control.Monad (mzero) 8 | import Data.Aeson (FromJSON, Object, parseJSON, (.:)) 9 | import qualified Data.Aeson as Aeson 10 | import qualified Data.ByteString.Lazy as BSL 11 | import qualified Data.Csv as Csv 12 | import Data.Text (Text) 13 | import GHC.Generics (Generic) 14 | import qualified Network.Wreq as W 15 | import qualified Network.Wreq.Session as WS 16 | import Options.Applicative (Parser, ParserInfo, argument, execParser, 17 | fullDesc, header, help, helper, info, 18 | metavar, progDesc, str, (<*>), (<>)) 19 | 20 | -- reddit crawler 21 | main :: IO () 22 | main = do 23 | -- run the options parser over the cli arguments 24 | opts <- execParser optsParserInfo 25 | -- make the call to reddit 26 | r <- WS.withSession getRedditList 27 | -- access the data from reddit 28 | let redditListing = r ^. W.responseBody 29 | -- get the top 10 listings from the data from reddit 30 | let top10 = map rlidatas . take 10 . Main.children $ datas redditListing 31 | -- encode the top 10 listings into a csv format 32 | let csvContents = Csv.encodeDefaultOrderedByName top10 33 | -- write the csv formatted data to our output file 34 | BSL.writeFile (outputFilename opts) csvContents 35 | 36 | -- Structures matching the json response from reddit 37 | data RedditListing = RedditListing 38 | { kind :: Text 39 | , datas :: RedditListingData 40 | } deriving (Show) 41 | 42 | -- instance for Aeson to decode JSON into this data structure 43 | instance FromJSON RedditListing where 44 | parseJSON (Aeson.Object v) = 45 | RedditListing <$> v .: "kind" 46 | <*> v .: "data" 47 | parseJSON _ = mzero 48 | 49 | data RedditListingData = RedditListingData 50 | { modhash :: Text 51 | , children :: [RedditListingItem] 52 | , after :: Text 53 | , before :: Maybe Text 54 | } deriving (Show, Generic) 55 | 56 | instance FromJSON RedditListingData 57 | 58 | data RedditListingItem = RedditListingItem 59 | { rlikind :: Text 60 | , rlidatas :: RedditListingItemData 61 | } deriving (Show) 62 | 63 | instance FromJSON RedditListingItem where 64 | parseJSON (Aeson.Object v) = 65 | RedditListingItem <$> v .: "kind" 66 | <*> v .: "data" 67 | parseJSON _ = mzero 68 | 69 | data RedditListingItemData = RedditListingItemData 70 | { title :: Text 71 | , subreddit :: Text 72 | , url :: Text 73 | , permalink:: Text 74 | } deriving (Show, Generic) 75 | 76 | instance FromJSON RedditListingItemData 77 | 78 | -- Instances for turning RedditListingItemData data type into csv rows 79 | -- ToNamedRecord figures out header names from record element names 80 | instance Csv.ToNamedRecord RedditListingItemData 81 | -- DefaultOrdered uses the order of elements in the record for the csv 82 | -- column ordering 83 | instance Csv.DefaultOrdered RedditListingItemData 84 | 85 | -- Make a request of reddit decoding the body to a RedditListing 86 | getRedditList :: WS.Session -> IO (W.Response RedditListing) 87 | getRedditList sess = do 88 | r <- WS.get sess "https://reddit.com/hot.json" 89 | W.asJSON r 90 | 91 | -- structure to hold cli arguments 92 | data Options = Options 93 | { outputFilename :: String 94 | } 95 | 96 | -- Parser for cli arguments 97 | optsParser :: Parser Options 98 | optsParser = Options 99 | <$> argument str 100 | ( metavar "FILENAME" 101 | <> help "File to output to" 102 | ) 103 | 104 | -- Adding program help text to the parser 105 | optsParserInfo :: ParserInfo Options 106 | optsParserInfo = info (helper <*> optsParser) 107 | ( fullDesc 108 | <> progDesc "The worst reddit client" 109 | <> header "redditcrawler - a bad reddit client" 110 | ) 111 | -------------------------------------------------------------------------------- /src/tee.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Monad (liftM) 4 | import Data.Foldable (forM_) 5 | import Options.Applicative (Parser, ParserInfo, argument, execParser, fullDesc, 6 | header, help, helper, info, long, metavar, progDesc, 7 | short, some, str, switch, (<*>), (<>)) 8 | import System.IO (Handle, IOMode (AppendMode), IOMode (WriteMode), 9 | hClose, hPutStrLn, openFile, stdout) 10 | 11 | -- tee 12 | main :: IO () 13 | main = do 14 | -- run the parser over the cli argumentts 15 | opts <- execParser optsParserInfo 16 | -- Pick file mode based on option 17 | let fileMode = if append opts then AppendMode else WriteMode 18 | -- Open all the mentioned output files 19 | outputFileHandles <- mapM (`openFile` fileMode) $ filenames opts 20 | -- start reading lines from std in 21 | stdInLines <- liftM lines getContents 22 | -- for each line, run hsPutStrLn for stdout and all output files 23 | forM_ stdInLines $ hsPutStrLn (stdout : outputFileHandles) 24 | -- close all the open output files so they flush 25 | mapM_ hClose outputFileHandles 26 | 27 | -- print a line to all file handles 28 | hsPutStrLn :: [Handle] -> String -> IO () 29 | hsPutStrLn handles line = forM_ handles . flip hPutStrLn $ line 30 | 31 | -- structure to hold cli arguments 32 | data Options = Options 33 | { filenames :: [String] 34 | , append :: Bool 35 | } deriving (Show) 36 | 37 | -- Parser for cli arguments 38 | optsParser :: Parser Options 39 | optsParser = Options 40 | <$> some ( 41 | argument str 42 | ( metavar "FILENAMES" 43 | <> help "Output files")) 44 | <*> switch 45 | ( long "append" 46 | <> short 'a' 47 | <> help "Append to output file rather than overwrite") 48 | 49 | -- Adding program help text to the parser 50 | optsParserInfo :: ParserInfo Options 51 | optsParserInfo = info (helper <*> optsParser) 52 | ( fullDesc 53 | <> progDesc "A bad clone of tee" 54 | <> header "tee - a bad clone of the real tee") 55 | --------------------------------------------------------------------------------