git.iko.soy/Fraudik/haskell-web-wc
on main help sign in
Add PoC version
commitca5d7ebe800962ec7dc5baf4a5a857a91465b5ad authorBlinov Ilya <ulkhan.2014@mail.ru> dateTue 25 Mar 2025, 17:17 (2 years ago) parentcd254ec
5 files changed+233
README.md+16 app/Main.hs+50 package.yaml+57 src/WordCount.hs+44 stack.yaml+66
README.mdnew file+16
@@ -0,0 +1,16 @@
1+# haskell-wb-wc
2+
3+Проект студента Блинов Илья Игоревич: веб версия утилиты wc.
4+
5+## Описание проекта
6+
7+Пользователь может отправлять MultipartForm запросы с текстовым файлом и получать для него статистику по типу обычной для утилиты wc.
8+
9+## Состояние проекта
10+
11+[x] Первая версия, Proof of Concept. Просто работа с MultipartForm запросами, реализация wc из домашнего задания, тестирование через отправку этого README.
12+[x] Подготовлен тестовый файл: sample.txt в 1,12 ГБ. Статистики для него: 25018508 1209339403 1209339403
13+
14+## Анализ производительности
15+
16+1. Proof of Concept: Elapsed (wall clock) time (h:mm:ss or m:ss): 0:27.25, Maximum resident set size (kbytes): 1816
app/Main.hsnew file+50
@@ -0,0 +1,50 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeOperators #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+
5+module Main(main) where
6+
7+import Control.Concurrent
8+import Control.Exception
9+import Control.Monad.IO.Class
10+import Network.Socket (withSocketsDo)
11+import Network.HTTP.Client hiding (Proxy)
12+import Network.HTTP.Client.MultipartFormData
13+import Network.Wai.Handler.Warp
14+import Servant
15+import Servant.Multipart
16+
17+import WordCount (foldWith, foldCountElements, printSelecttedOutput)
18+
19+type API = MultipartForm Tmp (MultipartData Tmp) :> Post '[JSON] String
20+
21+noFileError :: ServerError
22+noFileError = err400 {errBody = "No file is given."}
23+
24+api :: Proxy API
25+api = Proxy
26+
27+upload :: Server API
28+upload multipartData = do
29+ case files multipartData of
30+ (file:_) -> do
31+ wcStats <- liftIO $ foldWith foldCountElements $ fdPayload file
32+ return $ printSelecttedOutput wcStats
33+ [] -> throwError noFileError
34+
35+startServer :: IO ()
36+startServer = run 8080 (serve api upload)
37+
38+main :: IO ()
39+main = withSocketsDo . bracket (forkIO startServer) killThread $ \_threadid -> do
40+ -- we fork the server in a separate thread and send a test
41+ -- request to it from the main thread.
42+ manager <- newManager defaultManagerSettings
43+ req <- parseRequest "http://localhost:8080/"
44+ resp <- flip httpLbs manager =<< formDataBody form req
45+ print resp
46+
47+ where form =
48+ [
49+ partFileSource "file" "./sample.txt"
50+ ]
package.yamlnew file+57
@@ -0,0 +1,57 @@
1+name: haskell-web-wc
2+version: 0.0.1.0
3+github: "githubuser/haskell-web-wc"
4+license: BSD-3-Clause
5+author: "Blinov Ilya"
6+maintainer: "iiblinov@edu.hse.ru"
7+copyright: "2025 Blinov Ilya"
8+
9+extra-source-files:
10+- README.md
11+
12+# Metadata used when publishing your package
13+# synopsis: Short description of your package
14+# category: Web
15+
16+# To avoid duplicated efforts in documentation and dealing with the
17+# complications of embedding Haddock markup inside cabal files, it is
18+# common to point users to the README.md file.
19+description: Please see the README on GitHub at <https://github.com/githubuser/haskell-web-wc-Fraudik#readme>
20+
21+dependencies:
22+- base >= 4.7 && < 5
23+- warp
24+- servant
25+- servant-server
26+- servant-client
27+- streamly
28+- streamly-core
29+- servant-multipart
30+- http-client
31+- network
32+
33+
34+ghc-options:
35+- -Wall
36+- -Wcompat
37+- -Widentities
38+- -Wincomplete-record-updates
39+- -Wincomplete-uni-patterns
40+- -Wmissing-export-lists
41+- -Wmissing-home-modules
42+- -Wpartial-fields
43+- -Wredundant-constraints
44+
45+library:
46+ source-dirs: src
47+
48+executables:
49+ haskell-basics-template-exe:
50+ main: Main.hs
51+ source-dirs: app
52+ ghc-options:
53+ - -threaded
54+ - -rtsopts
55+ - -with-rtsopts=-N
56+ dependencies:
57+ - haskell-web-wc
src/WordCount.hsnew file+44
@@ -0,0 +1,44 @@
1+module WordCount (foldWith, foldCountElements, printSelecttedOutput, WCOutputs(..)) where
2+
3+import Streamly.Data.Fold (Fold)
4+import Data.Bits
5+import qualified Streamly.Data.Stream as Stream
6+import Data.Word (Word8)
7+import qualified Streamly.Data.Fold as Fold
8+import qualified Streamly.FileSystem.File as File
9+import Data.Function ((&))
10+
11+foldWith :: Fold IO Word8 a -> String -> IO a
12+foldWith f file =
13+ File.read file
14+ & Stream.fold f
15+
16+data WCOutputs =
17+ WCOutputs {
18+ bytesCount :: !Int
19+ , charCount :: !Int
20+ , lineCount :: !Int
21+ }
22+ deriving (Show)
23+
24+instance Semigroup WCOutputs where
25+ (WCOutputs a b c) <> (WCOutputs a' b' c') = WCOutputs (a + a') (b + b') (c + c')
26+
27+instance Monoid WCOutputs where
28+ mempty = WCOutputs 0 0 0
29+
30+countElements :: Word8 -> WCOutputs
31+countElements c =
32+ WCOutputs {
33+ bytesCount = 1
34+ , charCount = if isContinuationByte then 0 else 1
35+ , lineCount = if c == 10 then 1 else 0
36+ }
37+ where
38+ isContinuationByte = (c .&. 0xC0) == 0x80
39+
40+foldCountElements :: Fold IO Word8 WCOutputs
41+foldCountElements = Fold.foldl' (\a b -> a <> countElements b) mempty
42+
43+printSelecttedOutput :: WCOutputs -> String
44+printSelecttedOutput output = show (lineCount output) ++ " " ++ show (charCount output) ++ " " ++ show (bytesCount output)
stack.yamlnew file+66
@@ -0,0 +1,66 @@
1+# This file was automatically generated by 'stack init'
2+#
3+# Some commonly used options have been documented as comments in this file.
4+# For advanced use and comprehensive documentation of the format, please see:
5+# https://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+# A snapshot resolver dictates the compiler version and the set of packages
9+# to be used for project dependencies. For example:
10+#
11+# resolver: lts-21.13
12+# resolver: nightly-2023-09-24
13+# resolver: ghc-9.6.2
14+#
15+# The location of a snapshot can be provided as a file or url. Stack assumes
16+# a snapshot provided as a file might change, whereas a url resource does not.
17+#
18+# resolver: ./custom-snapshot.yaml
19+# resolver: https://example.com/snapshots/2023-01-01.yaml
20+resolver: lts-21.25
21+
22+# User packages to be built.
23+# Various formats can be used as shown in the example below.
24+#
25+# packages:
26+# - some-directory
27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28+# subdirs:
29+# - auto-update
30+# - wai
31+packages:
32+- .
33+# Dependency packages to be pulled from upstream that are not in the resolver.
34+# These entries can reference officially published versions as well as
35+# forks / in-progress versions pinned to a git hash. For example:
36+#
37+# extra-deps:
38+# - acme-missiles-0.3
39+# - git: https://github.com/commercialhaskell/stack.git
40+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41+#
42+# extra-deps: []
43+
44+# Override default flag values for local packages and extra-deps
45+# flags: {}
46+
47+# Extra package databases containing global packages
48+# extra-package-dbs: []
49+
50+# Control whether we use the GHC we find on the path
51+# system-ghc: true
52+#
53+# Require a specific version of Stack, using version ranges
54+# require-stack-version: -any # Default
55+# require-stack-version: ">=2.13"
56+#
57+# Override the architecture used by Stack, especially useful on Windows
58+# arch: i386
59+# arch: x86_64
60+#
61+# Extra directories used by Stack for building
62+# extra-include-dirs: [/path/to/dir]
63+# extra-lib-dirs: [/path/to/dir]
64+#
65+# Allow a newer minor version of GHC than the snapshot specifies
66+# compiler-check: newer-minor