git.iko.soy/streamly
on fcf54e3 help sign in
streamly/examples/WordClassifier.hs
77 lines 2.7 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
3#if __GLASGOW_HASKELL__ >= 800
4{-# OPTIONS_GHC -Wno-orphans #-}
5#endif
6-- compile with:
7-- ghc -O2 -fspec-constr-recursive=10 -fmax-worker-args=16 word-classifier.hs
8--
9import qualified Data.Char as Char
10import Data.Foldable
11import Data.Function ((&))
12import Data.Functor.Identity (Identity(..))
13import qualified Data.HashMap.Strict as Map
14import Data.Hashable
15import Data.IORef
16import qualified Data.List as List
17import qualified Data.Ord as Ord
18import Foreign.Storable (Storable(..))
19import qualified Streamly.Data.Unicode.Stream as Streamly
20import qualified Streamly.Internal.Data.Unicode.Stream as Streamly
21import qualified Streamly.FileSystem.Handle as FH
22import qualified Streamly.Data.Fold as FL
23import qualified Streamly.Internal.Data.Fold as IFL
24import qualified Streamly.Internal.Data.Unfold as IUF
25import qualified Streamly.Memory.Array as A
26import qualified Streamly.Prelude as Streamly
27import System.Environment (getArgs)
28import System.IO (openFile, IOMode(..))
30instance (Enum a, Storable a) => Hashable (A.Array a) where
31 hash arr = runIdentity $ IUF.fold A.read IFL.rollingHash arr
32 hashWithSalt salt arr = runIdentity $
33 IUF.fold A.read (IFL.rollingHashWithSalt salt) arr
35{-# INLINE toLower #-}
36toLower :: Char -> Char
37toLower c
38 | uc >= 0x61 && uc <= 0x7a = c
39 | otherwise = Char.toLower c
40 where
41 uc = fromIntegral (Char.ord c) :: Word
43{-# INLINE isAlpha #-}
44isAlpha :: Char -> Bool
45isAlpha c
46 | uc >= 0x61 && uc <= 0x7a = True
47 | otherwise = Char.isAlpha c
48 where
49 uc = fromIntegral (Char.ord c) :: Word
51main :: IO ()
52main = do
53 name <- fmap head getArgs
54 src <- openFile name ReadMode
56 -- Write the stream to a hashmap consisting of word counts
57 mp <-
58 let
59 alter Nothing = fmap Just $ newIORef (1 :: Int)
60 alter (Just ref) = modifyIORef' ref (+ 1) >> return (Just ref)
61 in Streamly.unfold FH.read src -- SerialT IO Word8
62 & Streamly.decodeLatin1 -- SerialT IO Char
63 & Streamly.map toLower -- SerialT IO Char
64 & Streamly.words FL.toList -- SerialT IO String
65 & Streamly.filter (all isAlpha) -- SerialT IO String
66 & Streamly.foldlM' (flip (Map.alterF alter)) Map.empty -- IO (Map String (IORef Int))
68 -- Print the top hashmap entries
69 counts <-
70 let readRef (w, ref) = do
71 cnt <- readIORef ref
72 return (w, cnt)
73 in Map.toList mp
74 & mapM readRef
76 traverse_ print $ List.sortOn (Ord.Down . snd) counts
77 & List.take 25