Download code

Jump to: navigation, search

Back to Word_count_(Haskell)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

wc.hs

 1 {- The authors of this work have released all rights to it and placed it
 2 in the public domain under the Creative Commons CC0 1.0 waiver
 3 (http://creativecommons.org/publicdomain/zero/1.0/).
 4 
 5 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 6 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 7 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 8 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 9 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
10 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
11 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
12 
13 Retrieved from: http://en.literateprograms.org/Word_count_(Haskell)?oldid=19227
14 -}
15 
16 module Main where
17 
18 import System.Environment
19 import System.Console.GetOpt
20 import Control.Monad
21 import Data.List
22 
23 type WordCount = (Int, Int, Int)
24  
25 data Opts = Opts { showLines, showWords, showChars :: Bool }
26 options :: [OptDescr (Opts -> Opts)]
27 options =
28  [ Option ['l'] ["lines"] 
29     (NoArg (\o -> o {showLines = True})) "show line count"   
30  , Option ['w'] ["words"] 
31     (NoArg (\o -> o {showWords = True})) "show word count"       
32  , Option ['c'] ["chars"] 
33     (NoArg (\o -> o {showChars = True})) "show character count"
34  ]
35 
36 wc :: Opts -> [FilePath] -> IO ()
37 wc opts []     = wc opts ["-"]
38 wc opts ["-"]  = do
39     text <- getContents
40     let count = getCount text
41     printCountLine opts "" count
42 wc opts [file] = do
43     count <- countFile file
44     printCountLine opts file count
45 wc opts files  = do
46     totalcount <- foldM (countAndPrintFile opts) (0,0,0) files
47     printCountLine opts "total" totalcount
48 
49 countAndPrintFile :: Opts -> WordCount -> FilePath -> IO WordCount
50 countAndPrintFile opts total@(tls,tws,tcs) file = do
51     count@(ls,ws,cs) <- countFile file
52     printCountLine opts file count
53     return (tls+ls,tws+ws,tcs+cs)
54 
55 countFile :: FilePath -> IO WordCount
56 countFile file = do
57     text <- readFile file
58     return $ getCount text
59 
60 getCount :: String -> WordCount
61 getCount = foldl' (\(c, w, l) x -> (c+length x+1, w+length (words x), l+1))
62                   (0, 0, 0)
63                   . lines
64 
65 printCountLine :: Opts -> FilePath -> WordCount -> IO ()
66 printCountLine opts f (ls,ws,cs) =
67     putStrLn ("\t" ++ (if showLines opts then (show ls) ++ "\t" else "")
68                    ++ (if showWords opts then (show ws) ++ "\t" else "")
69                    ++ (if showChars opts then (show cs) ++ "\t" else "")
70                    ++ f)
71 
72 
73 parseOpts :: [String] -> IO ([Opts -> Opts], [String])
74 parseOpts args = 
75     case getOpt RequireOrder options args of
76         (opts,files,[]) -> return (opts,files)
77         (_,_,errs)      -> fail (concat errs ++ usageInfo header options)
78     where 
79         header = "Usage: wc [OPTION...] [files...]"             
80    
81 processOpts :: [Opts -> Opts] -> Opts
82 processOpts []   = allOpts True
83 processOpts opts = foldl (flip ($)) (allOpts False) opts
84 
85 allOpts :: Bool -> Opts
86 allOpts b =  Opts { showLines = b, 
87                     showWords = b, 
88                     showChars = b }      
89 
90 main :: IO ()        
91 main = do
92     args <- getArgs
93     (optList, files) <- parseOpts args
94     let opts = processOpts optList
95     wc opts files


hijacker
hijacker
hijacker
hijacker