Fix unnecesary additions of NoImplicitPrelude

guide.cabal

@@ -54,6 +54,8 @@ library
     JS
     View
     SafeCopy
+  other-modules:
+    Imports
   build-depends:       Spock
                      , Spock-lucid == 0.3.*
                      , acid-state == 0.14.*
@@ -129,6 +131,7 @@ library
                      , DeriveFunctor
                      , DeriveTraversable
                      , DeriveGeneric
+                     , NoImplicitPrelude
 
 test-suite tests
   main-is:             Main.hs

lib/Cache.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
 module Cache
 (
   CacheKey(..),
@@ -10,17 +8,11 @@ module Cache
 where
 
 
-import BasePrelude hiding (Category)
--- Lenses
-import Lens.Micro.Platform hiding ((&))
--- Monads and monad transformers
-import Control.Monad.IO.Class
--- ByteString
-import qualified Data.ByteString.Lazy as BSL
+import Imports
+
 -- Concurrent map
 import qualified STMContainers.Map as STMMap
 import qualified Focus
-import Data.Hashable
 -- Lucid
 import Lucid.Base
 
@@ -31,7 +23,7 @@ import Utils
 
 -- Left = someone started rendering but haven't finished yet
 -- Right = result of the render
-type Cache = STMMap.Map CacheKey (Either Unique BSL.ByteString)
+type Cache = STMMap.Map CacheKey (Either Unique LByteString)
 
 cache :: Cache
 {-# NOINLINE cache #-}

lib/Config.hs

@@ -1,6 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
 
 module Config
 (
@@ -12,17 +10,14 @@ module Config
 where
 
 
-import BasePrelude
--- Text
-import Data.Text.All (Text)
+import Imports hiding ((.=))
+
 -- JSON
 import Data.Aeson               as Aeson
 import Data.Aeson.Encode.Pretty as Aeson hiding (Config)
 -- ByteString
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
--- Files
-import System.Directory
 -- Default
 import Data.Default
 

lib/Guide.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 module Guide
 (
@@ -13,21 +12,15 @@ module Guide
 where
 
 
-import BasePrelude hiding (Category)
+import Imports
+
 -- Monads and monad transformers
-import Control.Monad.State
-import Control.Monad.Reader
 import Control.Monad.Morph
--- Lenses
-import Lens.Micro.Platform hiding ((&))
 -- Containers
 import qualified Data.Map as M
 -- Text
-import Data.Text.All (Text)
 import qualified Data.Text.All as T
 import qualified Data.Text.Lazy.All as TL
--- Paths
-import System.FilePath ((</>))
 -- Network
 import Data.IP (IP)
 -- Web
@@ -54,8 +47,6 @@ import qualified System.Metrics.Gauge     as EKG.Gauge
 import Data.Acid as Acid
 -- Time
 import Data.Time
--- Deepseq
-import Control.DeepSeq
 -- IO
 import System.IO
 import qualified SlaveThread as Slave
@@ -760,21 +751,24 @@ createCheckpoint' db = liftIO $ do
     createArchive db
     createCheckpoint db
 
+----------------------------------------------------------------------------
+-- The entry point
+----------------------------------------------------------------------------
+
+-- | Start the site.
 main :: IO ()
 main = do
   config <- readConfig
   mainWith config
 
+-- | Start the site with a specific 'Config'.
 mainWith :: Config -> IO ()
 mainWith config = do
   -- Emptying the cache is needed because during development (i.e. in REPL)
   -- 'main' can be started many times and if the cache isn't cleared changes
   -- won't be visible
   emptyCache
-  Slave.fork $ FSNotify.withManager $ \mgr -> do
-    FSNotify.watchTree mgr "templates/" (const True) $ \_ -> do
-      emptyCache
-    forever $ threadDelay 1000000
+  startTemplateWatcher
   let emptyState = GlobalState {
         _categories = [],
         _categoriesDeleted = [],
@@ -828,14 +822,7 @@ mainWith config = do
       cfg <- defaultSpockCfg () PCNoDatabase serverState
       return cfg {
         spc_maxRequestSize = Just (1024*1024) }
-    when (_prerender config) $ do
-      putStr "Prerendering pages to be cached... "
-      globalState <- liftIO $ Acid.query db GetGlobalState
-      for_ (globalState^.categories) $ \cat -> do
-        putStr "|"
-        evaluate . force =<<
-          renderBST (hoist (flip runReaderT config) (renderCategoryPage cat))
-      putStrLn " done"
+    when (_prerender config) $ prerenderPages config db
     runSpock 8080 $ spock spockConfig $ do
       middleware (EKG.metrics waiMetrics)
       middleware (staticPolicy (addBase "static"))
@@ -935,4 +922,30 @@ adminHook = do
 
 -- TODO: a function to find all links to Hackage that have version in them
 
--- TODO: page titles in Google have “artyom.me” in them, that's bad
+-- | During development you need to see the changes whenever you change
+-- anything. This function starts a thread that watches for changes in
+-- templates and clears the cache whenever a change occurs, so that you
+-- wouldn't see cached pages.
+startTemplateWatcher :: IO ()
+startTemplateWatcher = void $ do
+  Slave.fork $ FSNotify.withManager $ \mgr -> do
+    FSNotify.watchTree mgr "templates/" (const True) $ \_ -> do
+      emptyCache
+    forever $ threadDelay 1000000
+
+-- | Render all pages and put them into the cache, so that (unlucky) users
+-- wouldn't see delays after a restart of the site.
+--
+-- Well, actually instead unlucky users would see an error after a restart of
+-- the site until prerendering completes, which is probably worse.
+--
+-- TODO: make prerendering asynchronous.
+prerenderPages :: Config -> DB -> IO ()
+prerenderPages config db = do
+  putStr "Prerendering pages to be cached... "
+  globalState <- Acid.query db GetGlobalState
+  for_ (globalState^.categories) $ \cat -> do
+    putStr "|"
+    evaluate . force =<<
+      renderBST (hoist (flip runReaderT config) (renderCategoryPage cat))
+  putStrLn " done"

lib/Imports.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+
+-- | Imports used in the whole codebase.
+module Imports
+(
+  module X,
+  LByteString
+)
+where
+
+
+import BasePrelude as X hiding (Category, GeneralCategory, lazy)
+-- Lists
+import Data.List.Index as X
+-- Lenses
+import Lens.Micro.Platform as X hiding ((&))
+-- Monads and monad transformers
+import Control.Monad.IO.Class as X
+import Control.Monad.State as X
+import Control.Monad.Reader as X
+-- Common types
+import Data.Text.All as X (Text, LText)
+import Data.ByteString as X (ByteString)
+import Data.Map as X (Map)
+import Data.Set as X (Set)
+-- Files
+import System.Directory as X
+import System.FilePath as X
+-- Deepseq
+import Control.DeepSeq as X
+-- Hashable
+import Data.Hashable as X
+-- Lazy bytestring
+import qualified Data.ByteString.Lazy as BSL
+
+
+type LByteString = BSL.ByteString

lib/JS.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 -- TODO: try to make it more type-safe somehow?
 
@@ -11,10 +10,10 @@
 module JS where
 
 
-import BasePrelude
+import Imports
+
 -- Text
 import qualified Data.Text.All as T
-import Data.Text.All (Text)
 -- Interpolation
 import NeatInterpolation
 

lib/Markdown.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 module Markdown
 (
@@ -30,18 +29,13 @@ module Markdown
 where
 
 
-import BasePrelude hiding (Space)
--- Lenses
-import Lens.Micro.Platform hiding ((&))
--- Monad transformers and monads
-import Control.Monad.State
+import Imports
+
 -- Text
 import qualified Data.Text.All as T
-import Data.Text.All (Text)
 -- ByteString
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString as BS
-import Data.ByteString (ByteString)
 -- Parsing
 import Text.Megaparsec hiding (State)
 import Text.Megaparsec.Text
@@ -53,7 +47,6 @@ import Text.HTML.SanitizeXSS
 -- Containers
 import Data.Tree
 import qualified Data.Set as S
-import Data.Set (Set)
 -- Markdown
 import CMark hiding (Node)
 import qualified CMark as MD

lib/Merge.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 
 module Merge
@@ -9,12 +8,10 @@ module Merge
 where
 
 
-import BasePrelude
--- Lenses
-import Lens.Micro.Platform hiding ((&))
+import Imports
+
 -- Text
 import qualified Data.Text.All as T
-import Data.Text.All (Text)
 import Data.List.Split
 -- Vector
 import qualified Data.Vector as V

lib/Types.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -124,20 +123,12 @@ module Types
 where
 
 
-import BasePrelude hiding (Category)
--- Monads and monad transformers
-import Control.Monad.State
-import Control.Monad.Reader
--- Lenses
-import Lens.Micro.Platform hiding ((&))
+import Imports
+
 -- Containers
 import qualified Data.Map as M
-import Data.Map (Map)
--- Lists
-import Data.List.Index
 -- Text
 import qualified Data.Text.All as T
-import Data.Text.All (Text)
 -- JSON
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Types as A

lib/Utils.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -65,26 +64,20 @@ module Utils
 where
 
 
-import BasePrelude
+import Imports
+
 -- Lists
 import Data.List.Extra (stripSuffix)
 -- Monads
 import Control.Monad.Extra
--- Lenses
-import Lens.Micro.Platform hiding ((&))
 -- Monads and monad transformers
-import Control.Monad.Trans
 import Control.Monad.Catch
 -- Containers
 import qualified Data.Set as S
 import qualified Data.Map as M
-import Data.Map (Map)
--- Hashable (needed for Uid)
-import Data.Hashable
 -- Randomness
 import System.Random
 -- Text
-import Data.Text.All (Text)
 import qualified Data.Text.All as T
 -- JSON
 import qualified Data.Aeson as A

lib/View.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 module View
 (
@@ -43,12 +42,8 @@ module View
 where
 
 
-import BasePrelude hiding (Category)
--- Lenses
-import Lens.Micro.Platform hiding ((&))
--- Monads and monad transformers
-import Control.Monad.IO.Class
-import Control.Monad.Reader
+import Imports
+
 -- Lists
 import Data.List.Split
 -- Containers
@@ -57,12 +52,10 @@ import Data.Tree
 -- Text
 import qualified Data.Text.All as T
 import qualified Data.Text.Lazy.All as TL
-import Data.Text.All (Text)
 import NeatInterpolation
 -- Web
 import Lucid hiding (for_)
 -- Files
-import System.FilePath
 import qualified System.FilePath.Find as F
 -- Network
 import Data.IP

tests/WebSpec.hs

@@ -44,7 +44,7 @@ tests = run $ do
   markdownTests
 
 mainPageTests :: Spec
-mainPageTests = session "main page" $ using Chrome $ do
+mainPageTests = session "main page" $ using [chromeCaps] $ do
   openGuide "/"
   wd "is initially empty" $ do
     checkPresent "#categories"
@@ -77,7 +77,7 @@ mainPageTests = session "main page" $ using Chrome $ do
       height2 `shouldBeInRange` (90, 140)
 
 categoryTests :: Spec
-categoryTests = session "categories" $ using Chrome $ do
+categoryTests = session "categories" $ using [chromeCaps] $ do
   openGuide "/"
   wd "add a new category" $ do
     createCategory "Some category"
@@ -245,7 +245,7 @@ categoryTests = session "categories" $ using Chrome $ do
       "body" `shouldHaveText` "Something went wrong"
 
 itemTests :: Spec
-itemTests = session "items" $ using Chrome $ do
+itemTests = session "items" $ using [chromeCaps] $ do
   openGuide "/"
   wd "create a test category" $ do
     createCategory "Item test category"
@@ -428,7 +428,7 @@ itemTests = session "items" $ using Chrome $ do
 -- TODO: merge tests
 
 markdownTests :: Spec
-markdownTests = session "markdown" $ using Chrome $ do
+markdownTests = session "markdown" $ using [chromeCaps] $ do
   openGuide "/"
   describe "Markdown isn't allowed in category names" $ do
     wd "when creating a category" $ do
@@ -617,7 +617,7 @@ run ts = do
 
 _site :: IO ()
 _site = run $ do
-  session "_" $ using Chrome $ do
+  session "_" $ using [chromeCaps] $ do
     wd "_" $ do
       openGuidePage "/"
       _pause