git.iko.soy/streamly
on bcf8ef4 help sign in
streamly/examples/WordClassifier.hs
66 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 Internal
23import qualified Streamly.Memory.Array as A
24import qualified Streamly.Prelude as Streamly
25import System.Environment (getArgs)
26import System.IO (openFile, IOMode(..))
28instance (Enum a, Storable a) => Hashable (A.Array a) where
29 hash arr = runIdentity $ Streamly.runFold Internal.rollingHash (A.read arr)
30 hashWithSalt salt arr = runIdentity $
31 Streamly.runFold (Internal.rollingHashWithSalt salt) (A.read arr)
33{-# INLINE toLower #-}
34toLower :: Char -> Char
35toLower c
36 | uc >= 0x61 && uc <= 0x7a = c
37 | otherwise = Char.toLower c
38 where
39 uc = fromIntegral (Char.ord c) :: Word
41{-# INLINE isAlpha #-}
42isAlpha :: Char -> Bool
43isAlpha c
44 | uc >= 0x61 && uc <= 0x7a = True
45 | otherwise = Char.isAlpha c
46 where
47 uc = fromIntegral (Char.ord c) :: Word
49main :: IO ()
50main =
51 let
52 alter Nothing = fmap Just $ newIORef (1 :: Int)
53 alter (Just ref) = modifyIORef' ref (+ 1) >> return (Just ref)
54 in do
55 name <- fmap head getArgs
56 src <- openFile name ReadMode
57 FH.read src -- SerialT IO Word8
58 & Streamly.decodeChar8 -- SerialT IO Char
59 & Streamly.map toLower -- SerialT IO Char
60 & Streamly.foldWords FL.toList -- SerialT IO String
61 & Streamly.filter (all isAlpha)
62 & Streamly.foldlM' (flip (Map.alterF alter)) Map.empty
63 & fmap Map.toList
64 >>= mapM (\(w, ref) -> readIORef ref >>= \cnt -> return (w, cnt))
65 & fmap (List.take 25 . List.sortOn (Ord.Down . snd))
66 >>= traverse_ print