git.iko.soy/streamly
on e25db62 help sign in
streamly/examples/WordClassifier.hs
67 lines 2.4 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.String as Streamly
20import qualified Streamly.FileSystem.Handle as FH
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.Memory.Array as A
25import qualified Streamly.Prelude as Streamly
26import System.Environment (getArgs)
27import System.IO (openFile, IOMode(..))
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 =
52 let
53 alter Nothing = fmap Just $ newIORef (1 :: Int)
54 alter (Just ref) = modifyIORef' ref (+ 1) >> return (Just ref)
55 in do
56 name <- fmap head getArgs
57 src <- openFile name ReadMode
58 Streamly.unfold FH.read src -- SerialT IO Word8
59 & Streamly.decodeChar8 -- SerialT IO Char
60 & Streamly.map toLower -- SerialT IO Char
61 & Streamly.foldWords FL.toList -- SerialT IO String
62 & Streamly.filter (all isAlpha)
63 & Streamly.foldlM' (flip (Map.alterF alter)) Map.empty
64 & fmap Map.toList
65 >>= mapM (\(w, ref) -> readIORef ref >>= \cnt -> return (w, cnt))
66 & fmap (List.take 25 . List.sortOn (Ord.Down . snd))
67 >>= traverse_ print