git.iko.soy/streamly
on a1e093a help sign in
streamly/examples/WordClassifier.hs
68 lines 2.5 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 =
53 let
54 alter Nothing = fmap Just $ newIORef (1 :: Int)
55 alter (Just ref) = modifyIORef' ref (+ 1) >> return (Just ref)
56 in do
57 name <- fmap head getArgs
58 src <- openFile name ReadMode
59 Streamly.unfold FH.read src -- SerialT IO Word8
60 & Streamly.decodeLatin1 -- SerialT IO Char
61 & Streamly.map toLower -- SerialT IO Char
62 & Streamly.words FL.toList -- SerialT IO String
63 & Streamly.filter (all isAlpha)
64 & Streamly.foldlM' (flip (Map.alterF alter)) Map.empty
65 & fmap Map.toList
66 >>= mapM (\(w, ref) -> readIORef ref >>= \cnt -> return (w, cnt))
67 & fmap (List.take 25 . List.sortOn (Ord.Down . snd))
68 >>= traverse_ print