git.iko.soy/streamly
on fa75413 help sign in
streamly/examples/WordClassifier.hs
75 lines 2.6 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 S
20import qualified Streamly.Internal.Data.Unicode.Stream as S
21import qualified Streamly.Data.Fold as FL
22import qualified Streamly.Internal.Data.Fold as IFL
23import qualified Streamly.Internal.Data.Unfold as IUF
24import qualified Streamly.Internal.FileSystem.File as File
25import qualified Streamly.Memory.Array as A
26import qualified Streamly.Prelude as S
27import System.Environment (getArgs)
29instance (Enum a, Storable a) => Hashable (A.Array a) where
30 hash arr = runIdentity $ IUF.fold A.read IFL.rollingHash arr
31 hashWithSalt salt arr = runIdentity $
32 IUF.fold A.read (IFL.rollingHashWithSalt salt) arr
34{-# INLINE toLower #-}
35toLower :: Char -> Char
36toLower c
37 | uc >= 0x61 && uc <= 0x7a = c
38 | otherwise = Char.toLower c
39 where
40 uc = fromIntegral (Char.ord c) :: Word
42{-# INLINE isAlpha #-}
43isAlpha :: Char -> Bool
44isAlpha c
45 | uc >= 0x61 && uc <= 0x7a = True
46 | otherwise = Char.isAlpha c
47 where
48 uc = fromIntegral (Char.ord c) :: Word
50main :: IO ()
51main = do
52 inFile <- fmap head getArgs
54 -- Write the stream to a hashmap consisting of word counts
55 mp <-
56 let
57 alter Nothing = fmap Just $ newIORef (1 :: Int)
58 alter (Just ref) = modifyIORef' ref (+ 1) >> return (Just ref)
59 in File.toBytes inFile -- SerialT IO Word8
60 & S.decodeLatin1 -- SerialT IO Char
61 & S.map toLower -- SerialT IO Char
62 & S.words FL.toList -- SerialT IO String
63 & S.filter (all isAlpha) -- SerialT IO String
64 & S.foldlM' (flip (Map.alterF alter)) Map.empty -- IO (Map String (IORef Int))
66 -- Print the top hashmap entries
67 counts <-
68 let readRef (w, ref) = do
69 cnt <- readIORef ref
70 return (w, cnt)
71 in Map.toList mp
72 & mapM readRef
74 traverse_ print $ List.sortOn (Ord.Down . snd) counts
75 & List.take 25