Add parallelism

This commit is contained in:
Mats Rauhala 2019-10-16 13:26:34 +03:00
parent 46a8394b4e
commit 263f4e281a
2 changed files with 5 additions and 1 deletions

View File

@ -18,6 +18,7 @@ build-type: Simple
extra-source-files: CHANGELOG.md extra-source-files: CHANGELOG.md
executable koodihaaste executable koodihaaste
ghc-options: -threaded -O2 -rtsopts
main-is: Main.hs main-is: Main.hs
other-modules: Data.Language other-modules: Data.Language
, Data.NGram , Data.NGram
@ -45,5 +46,6 @@ executable koodihaaste
, lucid , lucid
, warp , warp
, yaml , yaml
, parallel
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010

View File

@ -32,6 +32,7 @@ import Servant.API
import Servant.API.Generic import Servant.API.Generic
import Servant.HTML.Lucid import Servant.HTML.Lucid
import Servant.Server.Generic import Servant.Server.Generic
import Control.Parallel.Strategies
import Data.Caesar import Data.Caesar
import Data.Language import Data.Language
@ -78,7 +79,8 @@ handler =
_index = do _index = do
languageModel <- asks getModel languageModel <- asks getModel
sentences <- map message . bullshits <$> getBullshits sentences <- map message . bullshits <$> getBullshits
let (bullshit, noBullshit) = partitionEithers (map (findBest languageModel) sentences) let (bullshit, noBullshit) = partitionEithers best
best = map (findBest languageModel) sentences `using` parBuffer 10 rdeepseq
return $ Index noBullshit bullshit return $ Index noBullshit bullshit
} }
where where