diff --git a/app/DevelMain.hs b/app/DevelMain.hs index 5dbce5e..5ea777a 100644 --- a/app/DevelMain.hs +++ b/app/DevelMain.hs @@ -45,9 +45,6 @@ module DevelMain where -import Prelude -import Vervis.Application (getApplicationRepl, shutdownApp) - import Control.Exception (finally) import Control.Monad ((>=>)) import Control.Concurrent @@ -56,6 +53,8 @@ import Foreign.Store import Network.Wai.Handler.Warp import GHC.Word +import Vervis.Application (getApplicationRepl, shutdownApp) + -- | Start or restart the server. -- newStore is from foreign-store. -- A Store holds onto some data across ghci reloads diff --git a/app/devel.hs b/app/devel.hs index 0084dae..baeaf5e 100644 --- a/app/devel.hs +++ b/app/devel.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -13,10 +13,7 @@ - . -} -{-# LANGUAGE PackageImports #-} - -import "vervis" Vervis.Application (develMain) -import Prelude (IO) +import Vervis.Application (develMain) main :: IO () main = develMain diff --git a/app/main.hs b/app/main.hs index a2cb3dd..a36aad6 100644 --- a/app/main.hs +++ b/app/main.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -13,7 +13,6 @@ - . -} -import Prelude (IO) import Vervis.Application (appMain) main :: IO () diff --git a/src/Control/Applicative/Local.hs b/src/Control/Applicative/Local.hs index 6de769c..cba8830 100644 --- a/src/Control/Applicative/Local.hs +++ b/src/Control/Applicative/Local.hs @@ -21,8 +21,6 @@ module Control.Applicative.Local ) where -import Prelude - import Control.Applicative -- | Apply action between zero and @n@ times, inclusive, and list the results. diff --git a/src/Control/Concurrent/Local.hs b/src/Control/Concurrent/Local.hs index 97b89ec..e9998b6 100644 --- a/src/Control/Concurrent/Local.hs +++ b/src/Control/Concurrent/Local.hs @@ -19,8 +19,6 @@ module Control.Concurrent.Local ) where -import Prelude - import Control.Concurrent import Control.Monad import Control.Monad.IO.Class diff --git a/src/Control/Concurrent/ResultShare.hs b/src/Control/Concurrent/ResultShare.hs index ed83da8..11685fe 100644 --- a/src/Control/Concurrent/ResultShare.hs +++ b/src/Control/Concurrent/ResultShare.hs @@ -38,8 +38,6 @@ module Control.Concurrent.ResultShare ) where -import Prelude - import Control.Concurrent import Control.Concurrent.STM.TVar import Control.Exception diff --git a/src/Control/Monad/Trans/Except/Local.hs b/src/Control/Monad/Trans/Except/Local.hs index 2d98aab..465e179 100644 --- a/src/Control/Monad/Trans/Except/Local.hs +++ b/src/Control/Monad/Trans/Except/Local.hs @@ -18,8 +18,6 @@ module Control.Monad.Trans.Except.Local ) where -import Prelude - import Control.Monad.Trans.Except fromMaybeE :: Monad m => Maybe a -> e -> ExceptT e m a diff --git a/src/Crypto/PubKey/Encoding.hs b/src/Crypto/PubKey/Encoding.hs index 208ccb1..4b921b6 100644 --- a/src/Crypto/PubKey/Encoding.hs +++ b/src/Crypto/PubKey/Encoding.hs @@ -34,8 +34,6 @@ module Crypto.PubKey.Encoding ) where -import Prelude - import Control.Exception import Control.Monad import Data.ASN1.BinaryEncoding diff --git a/src/Crypto/PublicVerifKey.hs b/src/Crypto/PublicVerifKey.hs index ad7720d..50ed2fd 100644 --- a/src/Crypto/PublicVerifKey.hs +++ b/src/Crypto/PublicVerifKey.hs @@ -24,8 +24,6 @@ module Crypto.PublicVerifKey ) where -import Prelude - import Control.Exception import Control.Monad import Crypto.Error diff --git a/src/Darcs/Local/Repository.hs b/src/Darcs/Local/Repository.hs index a56cca8..fd0be2d 100644 --- a/src/Darcs/Local/Repository.hs +++ b/src/Darcs/Local/Repository.hs @@ -19,8 +19,6 @@ module Darcs.Local.Repository ) where -import Prelude - import Darcs.Util.Hash import System.Directory (createDirectory) import System.Exit (ExitCode (..)) diff --git a/src/Data/Aeson/Encode/Pretty/ToEncoding.hs b/src/Data/Aeson/Encode/Pretty/ToEncoding.hs index 2e3a61b..bd9f1e6 100644 --- a/src/Data/Aeson/Encode/Pretty/ToEncoding.hs +++ b/src/Data/Aeson/Encode/Pretty/ToEncoding.hs @@ -22,8 +22,6 @@ module Data.Aeson.Encode.Pretty.ToEncoding ) where -import Prelude - import Data.Aeson (ToJSON, Value, encode, decode) import Data.ByteString.Lazy (ByteString) import Data.Maybe (fromJust) diff --git a/src/Data/Aeson/Local.hs b/src/Data/Aeson/Local.hs index 7f2bbb1..6d3c85e 100644 --- a/src/Data/Aeson/Local.hs +++ b/src/Data/Aeson/Local.hs @@ -25,8 +25,6 @@ module Data.Aeson.Local ) where -import Prelude - import Control.Applicative import Data.Aeson import Data.Aeson.Types (Parser) diff --git a/src/Data/Attoparsec/ByteString/Local.hs b/src/Data/Attoparsec/ByteString/Local.hs index d376376..6ac58db 100644 --- a/src/Data/Attoparsec/ByteString/Local.hs +++ b/src/Data/Attoparsec/ByteString/Local.hs @@ -19,8 +19,6 @@ module Data.Attoparsec.ByteString.Local ) where -import Prelude - import Codec.Compression.Zlib.Internal import Data.Attoparsec.ByteString import System.IO diff --git a/src/Data/Binary/Local.hs b/src/Data/Binary/Local.hs index 9f6f050..95d956a 100644 --- a/src/Data/Binary/Local.hs +++ b/src/Data/Binary/Local.hs @@ -26,8 +26,6 @@ module Data.Binary.Local ) where -import Prelude - import Control.Monad.Logger import Data.Binary.Get import Data.ByteString (ByteString) diff --git a/src/Data/ByteString/Local.hs b/src/Data/ByteString/Local.hs index 3c63e50..bdb1ed1 100644 --- a/src/Data/ByteString/Local.hs +++ b/src/Data/ByteString/Local.hs @@ -20,8 +20,6 @@ module Data.ByteString.Local ) where -import Prelude - import Data.ByteString (ByteString) import qualified Data.ByteString as B diff --git a/src/Data/CaseInsensitive/Local.hs b/src/Data/CaseInsensitive/Local.hs index e120338..5677fa0 100644 --- a/src/Data/CaseInsensitive/Local.hs +++ b/src/Data/CaseInsensitive/Local.hs @@ -29,8 +29,6 @@ module Data.CaseInsensitive.Local ) where -import Prelude - import Data.CaseInsensitive import Data.Hashable (Hashable) import Data.String (IsString) diff --git a/src/Data/Char/Local.hs b/src/Data/Char/Local.hs index 53f9d95..e2a5a87 100644 --- a/src/Data/Char/Local.hs +++ b/src/Data/Char/Local.hs @@ -19,8 +19,6 @@ module Data.Char.Local ) where -import Prelude - import Data.Char isAsciiLetter :: Char -> Bool diff --git a/src/Data/Either/Local.hs b/src/Data/Either/Local.hs index 631d2f0..fa0386f 100644 --- a/src/Data/Either/Local.hs +++ b/src/Data/Either/Local.hs @@ -22,8 +22,6 @@ module Data.Either.Local ) where -import Prelude - import Control.Applicative import Control.Exception import Control.Monad.IO.Class diff --git a/src/Data/EventTime/Local.hs b/src/Data/EventTime/Local.hs index 9b70b57..941fbda 100644 --- a/src/Data/EventTime/Local.hs +++ b/src/Data/EventTime/Local.hs @@ -38,8 +38,6 @@ module Data.EventTime.Local ) where -import Prelude - import Data.Text (Text, snoc) import Text.Blaze (ToMarkup (..)) diff --git a/src/Data/Functor/Local.hs b/src/Data/Functor/Local.hs index e3e70ce..91c47b3 100644 --- a/src/Data/Functor/Local.hs +++ b/src/Data/Functor/Local.hs @@ -19,8 +19,6 @@ module Data.Functor.Local ) where -import Prelude - -- | Flipped 'fmap'. fwith :: Functor f => f a -> (a -> b) -> f b fwith = flip fmap diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs index b648c35..19483ab 100644 --- a/src/Data/Git/Local.hs +++ b/src/Data/Git/Local.hs @@ -27,8 +27,6 @@ module Data.Git.Local ) where -import Prelude - import Control.Monad (when) import Data.Byteable (toBytes) import Data.Git diff --git a/src/Data/Graph/DirectedAcyclic/View/Tree.hs b/src/Data/Graph/DirectedAcyclic/View/Tree.hs index d4a44bf..c8b9b45 100644 --- a/src/Data/Graph/DirectedAcyclic/View/Tree.hs +++ b/src/Data/Graph/DirectedAcyclic/View/Tree.hs @@ -20,8 +20,6 @@ module Data.Graph.DirectedAcyclic.View.Tree ) where -import Prelude - import Control.Arrow ((***)) import Data.Function (on) import Data.Hashable (Hashable) diff --git a/src/Data/Graph/Inductive/Query/Cycle.hs b/src/Data/Graph/Inductive/Query/Cycle.hs index 326df4d..6e6e288 100644 --- a/src/Data/Graph/Inductive/Query/Cycle.hs +++ b/src/Data/Graph/Inductive/Query/Cycle.hs @@ -45,8 +45,6 @@ module Data.Graph.Inductive.Query.Cycle ) where -import Prelude - import Data.Graph.Inductive.Graph import Data.Maybe (isNothing) diff --git a/src/Data/Graph/Inductive/Query/Layer.hs b/src/Data/Graph/Inductive/Query/Layer.hs index 11fd4bc..28455c2 100644 --- a/src/Data/Graph/Inductive/Query/Layer.hs +++ b/src/Data/Graph/Inductive/Query/Layer.hs @@ -39,8 +39,6 @@ module Data.Graph.Inductive.Query.Layer ) where -import Prelude - import Data.Graph.Inductive.Basic (gsel) import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.Queue diff --git a/src/Data/Graph/Inductive/Query/Path.hs b/src/Data/Graph/Inductive/Query/Path.hs index 9df7bf3..3bd39e2 100644 --- a/src/Data/Graph/Inductive/Query/Path.hs +++ b/src/Data/Graph/Inductive/Query/Path.hs @@ -26,8 +26,6 @@ module Data.Graph.Inductive.Query.Path ) where -import Prelude - import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.Queue diff --git a/src/Data/Graph/Inductive/Query/TransRed.hs b/src/Data/Graph/Inductive/Query/TransRed.hs index 44c61ca..43d73dd 100644 --- a/src/Data/Graph/Inductive/Query/TransRed.hs +++ b/src/Data/Graph/Inductive/Query/TransRed.hs @@ -18,8 +18,6 @@ module Data.Graph.Inductive.Query.TransRed ) where -import Prelude - import Data.Foldable (foldl') import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.DFS (dfs) diff --git a/src/Data/Hourglass/Local.hs b/src/Data/Hourglass/Local.hs index ffc8337..96d5141 100644 --- a/src/Data/Hourglass/Local.hs +++ b/src/Data/Hourglass/Local.hs @@ -18,8 +18,6 @@ module Data.Hourglass.Local ) where -import Prelude - import Data.Hourglass import Time.System diff --git a/src/Data/Int/Local.hs b/src/Data/Int/Local.hs index 852c6cc..31758e6 100644 --- a/src/Data/Int/Local.hs +++ b/src/Data/Int/Local.hs @@ -19,8 +19,6 @@ module Data.Int.Local ) where -import Prelude - import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty (..), (<|)) diff --git a/src/Data/KeyFile.hs b/src/Data/KeyFile.hs index 556f835..95e4902 100644 --- a/src/Data/KeyFile.hs +++ b/src/Data/KeyFile.hs @@ -21,8 +21,6 @@ module Data.KeyFile ) where -import Prelude - import Control.Monad import Data.ByteString (ByteString) import System.Directory diff --git a/src/Data/List/Local.hs b/src/Data/List/Local.hs index 4abb3be..2a0ce92 100644 --- a/src/Data/List/Local.hs +++ b/src/Data/List/Local.hs @@ -25,8 +25,6 @@ module Data.List.Local ) where -import Prelude - import Data.Function (on) import Data.List.NonEmpty (NonEmpty (..), (<|), toList) diff --git a/src/Data/List/NonEmpty/Local.hs b/src/Data/List/NonEmpty/Local.hs index b9dd958..da41e41 100644 --- a/src/Data/List/NonEmpty/Local.hs +++ b/src/Data/List/NonEmpty/Local.hs @@ -21,8 +21,6 @@ module Data.List.NonEmpty.Local ) where -import Prelude - import Data.Function import Data.List.NonEmpty (NonEmpty (..)) diff --git a/src/Data/Maybe/Local.hs b/src/Data/Maybe/Local.hs index 5e6bfa5..72bdc6e 100644 --- a/src/Data/Maybe/Local.hs +++ b/src/Data/Maybe/Local.hs @@ -19,8 +19,6 @@ module Data.Maybe.Local ) where -import Prelude - partitionMaybes :: [(Maybe a, b)] -> ([(a, b)], [b]) partitionMaybes = foldr f ([], []) where diff --git a/src/Data/MediaType.hs b/src/Data/MediaType.hs index 5ad3f15..6b8cae1 100644 --- a/src/Data/MediaType.hs +++ b/src/Data/MediaType.hs @@ -27,8 +27,6 @@ module Data.MediaType ) where -import Prelude - import Data.Text (Text) data MediaType diff --git a/src/Data/Paginate/Local.hs b/src/Data/Paginate/Local.hs index 8739616..10a1014 100644 --- a/src/Data/Paginate/Local.hs +++ b/src/Data/Paginate/Local.hs @@ -48,8 +48,6 @@ module Data.Paginate.Local ) where -import Prelude - import Data.Default.Class import Data.Maybe import Data.Ratio diff --git a/src/Data/Time/Clock/Local.hs b/src/Data/Time/Clock/Local.hs index 0e9ac42..93db9bb 100644 --- a/src/Data/Time/Clock/Local.hs +++ b/src/Data/Time/Clock/Local.hs @@ -18,8 +18,6 @@ module Data.Time.Clock.Local ) where -import Prelude - import Data.Time.Clock import Data.EventTime.Local diff --git a/src/Data/Tree/Local.hs b/src/Data/Tree/Local.hs index 45137ab..d36d8c5 100644 --- a/src/Data/Tree/Local.hs +++ b/src/Data/Tree/Local.hs @@ -18,8 +18,6 @@ module Data.Tree.Local ) where -import Prelude - import Data.List (sortOn) import Data.Tree diff --git a/src/Data/Tuple/Local.hs b/src/Data/Tuple/Local.hs index 48a7524..b4a9c0c 100644 --- a/src/Data/Tuple/Local.hs +++ b/src/Data/Tuple/Local.hs @@ -21,8 +21,6 @@ module Data.Tuple.Local ) where -import Prelude - fst3 :: (a, b, c) -> a fst3 (x, _, _) = x diff --git a/src/Database/Esqueleto/Local.hs b/src/Database/Esqueleto/Local.hs index c25df83..0eb8d06 100644 --- a/src/Database/Esqueleto/Local.hs +++ b/src/Database/Esqueleto/Local.hs @@ -18,8 +18,6 @@ module Database.Esqueleto.Local ) where -import Prelude - import Data.CaseInsensitive (CI) import Database.Esqueleto diff --git a/src/Database/Persist/Class/Local.hs b/src/Database/Persist/Class/Local.hs index 45dd0f1..3c17082 100644 --- a/src/Database/Persist/Class/Local.hs +++ b/src/Database/Persist/Class/Local.hs @@ -18,8 +18,6 @@ module Database.Persist.Class.Local ) where -import Prelude - import Control.Monad import Data.Bifunctor import Data.CaseInsensitive (CI) diff --git a/src/Database/Persist/JSON.hs b/src/Database/Persist/JSON.hs index 695e3bd..b547dc4 100644 --- a/src/Database/Persist/JSON.hs +++ b/src/Database/Persist/JSON.hs @@ -28,8 +28,6 @@ module Database.Persist.JSON ) where -import Prelude - import Data.Aeson import Data.Aeson.Text import Data.Text.Lazy.Encoding diff --git a/src/Database/Persist/Local.hs b/src/Database/Persist/Local.hs index 561fe48..22c6032 100644 --- a/src/Database/Persist/Local.hs +++ b/src/Database/Persist/Local.hs @@ -22,8 +22,6 @@ module Database.Persist.Local ) where -import Prelude - import Control.Applicative import Control.Exception import Control.Monad diff --git a/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs b/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs index 9497a9b..071fe0d 100644 --- a/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs +++ b/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs @@ -21,8 +21,6 @@ module Database.Persist.Local.Class.PersistEntityHierarchy ) where -import Prelude - import Database.Persist import Database.Persist.Graph.Class diff --git a/src/Database/Persist/Sql/Local.hs b/src/Database/Persist/Sql/Local.hs index d495a6d..aa7d3a8 100644 --- a/src/Database/Persist/Sql/Local.hs +++ b/src/Database/Persist/Sql/Local.hs @@ -18,8 +18,6 @@ module Database.Persist.Sql.Local ) where -import Prelude - import Data.CaseInsensitive (CI) import Database.Persist.Sql diff --git a/src/Diagrams/IntransitiveDAG.hs b/src/Diagrams/IntransitiveDAG.hs index c2d0807..5b2bfe0 100644 --- a/src/Diagrams/IntransitiveDAG.hs +++ b/src/Diagrams/IntransitiveDAG.hs @@ -21,8 +21,6 @@ module Diagrams.IntransitiveDAG ) where -import Prelude - import Control.Arrow ((&&&)) import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.Layer (rlayerWith) diff --git a/src/Formatting/CaseInsensitive.hs b/src/Formatting/CaseInsensitive.hs index 62a0c69..6c41cf9 100644 --- a/src/Formatting/CaseInsensitive.hs +++ b/src/Formatting/CaseInsensitive.hs @@ -19,8 +19,6 @@ module Formatting.CaseInsensitive ) where -import Prelude - import Data.CaseInsensitive import Data.Text (Text) import Data.Text.Lazy.Builder (fromText) diff --git a/src/GitPackProto.hs b/src/GitPackProto.hs index d92b1b9..b876cdc 100644 --- a/src/GitPackProto.hs +++ b/src/GitPackProto.hs @@ -20,8 +20,6 @@ module GitPackProto ) where -import Prelude - import Control.Applicative ((<|>)) import Data.Attoparsec.Text import Data.ByteString (ByteString, unsnoc) diff --git a/src/Language/Haskell/TH/Quote/Local.hs b/src/Language/Haskell/TH/Quote/Local.hs index 8816c33..2689d74 100644 --- a/src/Language/Haskell/TH/Quote/Local.hs +++ b/src/Language/Haskell/TH/Quote/Local.hs @@ -19,8 +19,6 @@ module Language.Haskell.TH.Quote.Local ) where -import Prelude - import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax (Q, Exp, Dec) diff --git a/src/Network/FedURI.hs b/src/Network/FedURI.hs index c266941..c814eba 100644 --- a/src/Network/FedURI.hs +++ b/src/Network/FedURI.hs @@ -38,8 +38,6 @@ module Network.FedURI ) where -import Prelude - import Control.Monad ((<=<)) import Data.Aeson import Data.Bifunctor (bimap, first) diff --git a/src/Network/HTTP/Client/Conduit/ActivityPub.hs b/src/Network/HTTP/Client/Conduit/ActivityPub.hs index 42c85e3..0babd7d 100644 --- a/src/Network/HTTP/Client/Conduit/ActivityPub.hs +++ b/src/Network/HTTP/Client/Conduit/ActivityPub.hs @@ -38,8 +38,6 @@ module Network.HTTP.Client.Conduit.ActivityPub ) where -import Prelude - import Control.Exception (throwIO, bracket) import Control.Monad.IO.Unlift (MonadIO, liftIO, MonadUnliftIO, withRunInIO) import Data.Aeson (FromJSON, Result (..), fromJSON, json') diff --git a/src/Network/HTTP/Digest.hs b/src/Network/HTTP/Digest.hs index 1d3551d..100a2d4 100644 --- a/src/Network/HTTP/Digest.hs +++ b/src/Network/HTTP/Digest.hs @@ -37,8 +37,6 @@ module Network.HTTP.Digest ) where -import Prelude - import Crypto.Hash import Data.ByteString (ByteString) import Network.HTTP.Types.Header diff --git a/src/Network/SSH/Local.hs b/src/Network/SSH/Local.hs index a0442b5..df64208 100644 --- a/src/Network/SSH/Local.hs +++ b/src/Network/SSH/Local.hs @@ -18,8 +18,6 @@ module Network.SSH.Local ) where -import Prelude - import Data.ByteString.Char8 (ByteString, pack) import Network.SSH diff --git a/src/Text/Blaze/Local.hs b/src/Text/Blaze/Local.hs index 5f7b820..02aa09e 100644 --- a/src/Text/Blaze/Local.hs +++ b/src/Text/Blaze/Local.hs @@ -18,8 +18,6 @@ module Text.Blaze.Local ) where -import Prelude - import Data.CaseInsensitive (CI) import Text.Blaze diff --git a/src/Text/Display.hs b/src/Text/Display.hs index 1fc7450..d59f72b 100644 --- a/src/Text/Display.hs +++ b/src/Text/Display.hs @@ -36,8 +36,6 @@ module Text.Display ) where -import Prelude - import Data.Text (Text) class Display a where diff --git a/src/Text/Email/Local.hs b/src/Text/Email/Local.hs index f56113b..7c51b6f 100644 --- a/src/Text/Email/Local.hs +++ b/src/Text/Email/Local.hs @@ -18,8 +18,6 @@ module Text.Email.Local ) where -import Prelude - import Text.Email.Validate import qualified Data.Text as T diff --git a/src/Text/FilePath/Local.hs b/src/Text/FilePath/Local.hs index ea15c8f..c78f27d 100644 --- a/src/Text/FilePath/Local.hs +++ b/src/Text/FilePath/Local.hs @@ -24,8 +24,6 @@ module Text.FilePath.Local ) where -import Prelude - import Control.Arrow ((***)) import Data.Text (Text) import System.FilePath diff --git a/src/Text/Jasmine/Local.hs b/src/Text/Jasmine/Local.hs index 711e5cb..09f5d66 100644 --- a/src/Text/Jasmine/Local.hs +++ b/src/Text/Jasmine/Local.hs @@ -31,8 +31,6 @@ module Text.Jasmine.Local ) where -import Prelude - import qualified Data.ByteString.Lazy as BL (ByteString, empty) discardm :: BL.ByteString -> Either String BL.ByteString diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 08b99e3..5514554 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -19,8 +19,6 @@ module Vervis.API ) where -import Prelude - import Control.Applicative import Control.Concurrent.MVar import Control.Concurrent.STM.TVar diff --git a/src/Vervis/Access.hs b/src/Vervis/Access.hs index 87385e1..68d0c7e 100644 --- a/src/Vervis/Access.hs +++ b/src/Vervis/Access.hs @@ -59,8 +59,6 @@ module Vervis.Access ) where -import Prelude - import Control.Applicative ((<|>)) import Control.Monad.IO.Class import Control.Monad.Trans.Maybe diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs index 1d7989f..d40011f 100644 --- a/src/Vervis/ActivityPub.hs +++ b/src/Vervis/ActivityPub.hs @@ -33,8 +33,6 @@ module Vervis.ActivityPub ) where -import Prelude - import Control.Exception hiding (try) import Control.Monad import Control.Monad.IO.Class diff --git a/src/Vervis/ActivityStreams.hs b/src/Vervis/ActivityStreams.hs deleted file mode 100644 index 767d933..0000000 --- a/src/Vervis/ActivityStreams.hs +++ /dev/null @@ -1,224 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2018 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Vervis.ActivityStreams - ( Actor (..) - , ActivityStreams2 (..) - , provideAS2 - , makeActor - ) -where - -import Control.Monad.Trans.Writer -import Data.Aeson (pairs) -import Data.Monoid - -import Vervis.Import -import Vervis.Model.Ident - --- AS2 is divided into core and extensions-for-common-social-web-use-cases, I'm --- starting with the core, looking at the AS2 vocab spec - -{- -data Object = Object - { objectAttachment :: - , objectAttributedTo :: - , objectAudience :: - , objectContent :: - , objectContext :: - , objectName :: - , objectEndTime :: - , objectGenerator :: - , objectIcon :: - , objectImage :: - , objectInReplyTo :: - , objectLocation :: - , objectPreview :: - , objectPublished :: - , objectReplies :: - , objectStartTime :: - , objectSummary :: - , objectTag :: - , objectUpdated :: - , objectUrl :: - , objectTo :: - , objectBto :: - , objectCc :: - , objectBcc :: - , objectMediaType :: - , objectDuration :: - } - -data Link = Link - { linkHref :: - , linkRel :: - , linkMediaType :: - , linkName :: - , linkHrefLang :: - , linkHeight :: - , linkWidth :: - , linkPreview :: - } - -data Activity = Activity - { activityAsObject :: Object - , activityActor :: - , activityObject :: - , activityTarget :: - , activityResult :: - , activityOrigin :: - , activityInstrument :: - } - -data IntransitiveActivity = IntransitiveActivity - { iactivityAsObject :: Object - , iactivityActor :: - , iactivityTarget :: - , iactivityResult :: - , iactivityOrigin :: - , iactivityInstrument :: - } - -data Collection = Collection - { collectionAsObject :: Object - , collectionTotalItems :: - , collectionCurrent :: - , collectionFirst :: - , collectionLast :: - , collectionItems :: - } - -data OrderedCollection = OrderedCollection - { ocollectionAsCollection :: Collection - } - -data CollectionPage = CollectionPage - { collectionPageAsCollection :: Collection - , collectionPagePartOf :: - , collectionPageNext :: - , collectionPagePrev :: - } - -data OrderedCollectionPage = OrderedCollectionPage - { orderedCollectionPageAsCollectionPage :: CollectionPage - , orederdCollectionPageStartIndex :: - } - --- Now come the extended types - --- Activity types - I'm skipping them for now - --- Actor types - -data Application = Application - { applicationAsObject :: Object - } - -data Group = Group - { groupAsObject :: Object - } - -data Organization = Organization - { organizationAsObject :: Object - } - -data Person = Person - { personAsObject :: Object - } - -data Service = Service - { serviceAsObject :: Object - } --} - --- Actor objects in AP - -data Actor = Actor - { -- Requirements - actorId :: Text - , actorType :: Text - -- Must - , actorInbox :: Text - , actorOutbox :: Text - -- Should - --, actorFollowing - --, actorFollowers - -- May - --, actorLiked - --, actorStreams - --, actorPreferredUsername - --, actorEndpoints - } - -fields a = - [ "@context" .= ("https://www.w3.org/ns/activitystreams" :: Text) - , "id" .= actorId a - , "type" .= actorType a - , "inbox" .= actorInbox a - , "outbox" .= actorOutbox a - ] - -instance ToJSON Actor where - toJSON = object . fields - toEncoding = pairs . mconcat . fields - --- NEXT: --- --- * Figure out how to detect the client wanting AS2 / AP --- * Send minimal simple actor per user - -typeActivityStreams2 :: ContentType -typeActivityStreams2 = "application/activity+json" - -typeActivityStreams2LD :: ContentType -typeActivityStreams2LD = - "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"" - -data ActivityStreams2 = ActivityPubActor Actor - -instance ToContent ActivityStreams2 where - toContent (ActivityPubActor a) = toContent $ toEncoding a - -{- -instance ToTypedContent ActivityStreams2 where - toTypedContent = TypedContent typeActivityStreams2 . toContent - -instance HasContentType ActivityStreams2 where - getContentType _ = typeActivityStreams2 - -data ActivityStreams2LD = ActivityStreams2LD ActivityStreams2 - -instance ToContent ActivityStreams2LD where - toContent (ActivityStreams2LD a) = toContent a - -instance ToTypedContent ActivityStreams2LD where - toTypedContent = TypedContent typeActivityStreams2LD . toContent - -instance HasContentType ActivityStreams2LD where - getContentType _ = typeActivityStreams2LD --} - -provideAS2 :: Monad m => ActivityStreams2 -> Writer (Endo [ProvidedRep m]) () -provideAS2 as2 = do - provideRepType typeActivityStreams2 $ return as2 - provideRepType typeActivityStreams2LD $ return as2 - -makeActor ur shr = - Actor - { actorId = ur $ SharerR shr - , actorType = "Person" - , actorInbox = ur $ SharerR shr - , actorOutbox = ur $ error "We don't have outboxes yet" - } diff --git a/src/Vervis/ActorKey.hs b/src/Vervis/ActorKey.hs index 784022b..e375744 100644 --- a/src/Vervis/ActorKey.hs +++ b/src/Vervis/ActorKey.hs @@ -23,8 +23,6 @@ module Vervis.ActorKey ) where -import Prelude - import Control.Concurrent (threadDelay) import Control.Concurrent.STM (TVar, modifyTVar') import Control.Monad (forever) diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index dd456cf..35ecece 100644 --- a/src/Vervis/Application.hs +++ b/src/Vervis/Application.hs @@ -30,16 +30,19 @@ module Vervis.Application ) where +import Control.Concurrent.Chan +import Control.Concurrent.STM.TVar +import Control.Monad import Control.Monad.Logger (liftLoc, runLoggingT, logInfo, logError) -import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr, - pgPoolSize, runSqlPool) +import Control.Monad.Trans.Reader +import Data.Default.Class +import Database.Persist.Postgresql import Graphics.SVGFonts.Fonts (lin2) import Graphics.SVGFonts.ReadFont (loadFont) -import Vervis.Import import Language.Haskell.TH.Syntax (qLocation) import Network.HTTP.Client (newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) -import Network.Wai (Middleware) +import Network.Wai import Network.Wai.Handler.Warp (Settings, defaultSettings, defaultShouldDisplayException, runSettings, setHost, @@ -48,15 +51,20 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination, mkRequestLogger, outputFormat) -import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet, - toLogStr) -import Yesod.Default.Main (LogFunc) -import Yesod.Mail.Send (runMailer) +import System.Log.FastLogger +import Yesod.Auth +import Yesod.Core +import Yesod.Core.Dispatch +import Yesod.Core.Types hiding (Logger) +import Yesod.Default.Config2 +import Yesod.Persist.Core +import Yesod.Static import qualified Data.Text as T (unpack) import qualified Data.HashMap.Strict as M (empty) import Database.Persist.Schema.PostgreSQL (schemaBackend) +import Yesod.Mail.Send (runMailer) import Control.Concurrent.ResultShare import Data.KeyFile @@ -67,6 +75,7 @@ import Web.Hashids.Local import Vervis.ActorKey (generateActorKey, actorKeyRotator) import Vervis.Federation +import Vervis.Foundation import Vervis.KeyFile (isInitialSetup) import Vervis.RemoteActorStore @@ -88,6 +97,7 @@ import Vervis.Handler.Wiki import Vervis.Handler.Workflow import Vervis.Migration (migrateDB) +import Vervis.Settings import Vervis.Ssh (runSsh) -- This line actually creates our YesodDispatch instance. It is the second half diff --git a/src/Vervis/Avatar.hs b/src/Vervis/Avatar.hs index 160de7b..0e51ad0 100644 --- a/src/Vervis/Avatar.hs +++ b/src/Vervis/Avatar.hs @@ -18,8 +18,6 @@ module Vervis.Avatar ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Data.Default.Class (def) import Data.Text (Text) diff --git a/src/Vervis/BinaryBody.hs b/src/Vervis/BinaryBody.hs index ef6c30d..5b5d8ad 100644 --- a/src/Vervis/BinaryBody.hs +++ b/src/Vervis/BinaryBody.hs @@ -24,8 +24,6 @@ module Vervis.BinaryBody ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (MonadLogger) import Data.Binary.Get (Get) diff --git a/src/Vervis/ChangeFeed.hs b/src/Vervis/ChangeFeed.hs index 8433ac1..97090e2 100644 --- a/src/Vervis/ChangeFeed.hs +++ b/src/Vervis/ChangeFeed.hs @@ -18,8 +18,6 @@ module Vervis.ChangeFeed ) where -import Prelude - import Data.Monoid ((<>)) import Data.Text (Text) import Yesod.Core (Route) diff --git a/src/Vervis/Changes.hs b/src/Vervis/Changes.hs index 067a05a..0d74b66 100644 --- a/src/Vervis/Changes.hs +++ b/src/Vervis/Changes.hs @@ -19,8 +19,6 @@ module Vervis.Changes ) where -import Prelude - import Data.Text (Text) import Data.Time.Clock (UTCTime) diff --git a/src/Vervis/Colour.hs b/src/Vervis/Colour.hs index 0b58404..bad12be 100644 --- a/src/Vervis/Colour.hs +++ b/src/Vervis/Colour.hs @@ -34,8 +34,6 @@ module Vervis.Colour ) where -import Prelude - import Data.Colour.SRGB (Colour, sRGB24) import Data.Word (Word8) diff --git a/src/Vervis/Content.hs b/src/Vervis/Content.hs index 7fdb4a1..a7356af 100644 --- a/src/Vervis/Content.hs +++ b/src/Vervis/Content.hs @@ -20,8 +20,6 @@ module Vervis.Content ) where -import Prelude - import Data.ByteString (ByteString) import Data.Monoid ((<>)) import Network.Git.Put (serializeService) diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs index 9b06d8b..7870d52 100644 --- a/src/Vervis/Discussion.hs +++ b/src/Vervis/Discussion.hs @@ -20,8 +20,6 @@ module Vervis.Discussion ) where -import Prelude - import Control.Arrow (second) import Data.Graph.Inductive.Graph (mkGraph, lab') import Data.Graph.Inductive.PatriciaTree (Gr) diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 31a5850..d9c6254 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -23,8 +23,6 @@ module Vervis.Federation ) where -import Prelude - import Control.Applicative import Control.Concurrent.MVar import Control.Concurrent.STM.TVar diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index 7d9d3a1..9ff3b74 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -19,8 +19,6 @@ module Vervis.Federation.Discussion ) where -import Prelude - --import Control.Applicative --import Control.Concurrent.MVar --import Control.Concurrent.STM.TVar diff --git a/src/Vervis/Field/Key.hs b/src/Vervis/Field/Key.hs index cc620b1..b265749 100644 --- a/src/Vervis/Field/Key.hs +++ b/src/Vervis/Field/Key.hs @@ -20,8 +20,6 @@ module Vervis.Field.Key ) where -import Prelude - import Data.ByteString (ByteString) import Data.ByteString.Base64 (decode) import Data.Char (isDigit) diff --git a/src/Vervis/Field/Person.hs b/src/Vervis/Field/Person.hs index 04eb22c..38aa708 100644 --- a/src/Vervis/Field/Person.hs +++ b/src/Vervis/Field/Person.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -18,13 +18,20 @@ module Vervis.Field.Person ) where -import Vervis.Import hiding ((==.)) - import Data.Char (isDigit) +import Data.Text (Text) import Database.Esqueleto +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types + +import qualified Data.Text as T import Data.Char.Local (isAsciiLetter) + +import Vervis.Foundation import Vervis.Model.Ident (text2shr) +import Vervis.Settings checkPassLength :: Field Handler Text -> Field Handler Text checkPassLength = @@ -36,7 +43,7 @@ checkPassLength = \alternative, such as a client TLS certificate, that can work \ \somewhat like SSH and GPG keys." minlen = 8 - in checkBool ((>= minlen) . length) msg + in checkBool ((>= minlen) . T.length) msg passConfirmField :: Field Handler Text passConfirmField = Field diff --git a/src/Vervis/Field/Project.hs b/src/Vervis/Field/Project.hs index 08e1c92..f7e33bf 100644 --- a/src/Vervis/Field/Project.hs +++ b/src/Vervis/Field/Project.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -18,20 +18,26 @@ module Vervis.Field.Project ) where -import Vervis.Import hiding ((==.)) - import Data.Char (isDigit) import Data.Char.Local (isAsciiLetter) -import Data.Text (split) +import Data.Text (Text) import Database.Esqueleto +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types +import Yesod.Persist.Core +import qualified Data.Text as T + +import Vervis.Foundation +import Vervis.Model import Vervis.Model.Ident (PrjIdent, prj2text, text2prj) checkTemplate :: Field Handler Text -> Field Handler Text checkTemplate = let charOk c = isAsciiLetter c || isDigit c - wordOk w = (not . null) w && all charOk w - identOk t = (not . null) t && all wordOk (split (== '-') t) + wordOk w = (not . T.null) w && T.all charOk w + identOk t = (not . T.null) t && all wordOk (T.split (== '-') t) msg :: Text msg = "The project identifier must be a sequence of one or more words \ \separated by hyphens (‘-’), and each such word may contain \ diff --git a/src/Vervis/Field/Repo.hs b/src/Vervis/Field/Repo.hs index e75e612..27279fd 100644 --- a/src/Vervis/Field/Repo.hs +++ b/src/Vervis/Field/Repo.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -22,22 +22,28 @@ module Vervis.Field.Repo ) where -import Vervis.Import hiding ((==.), on, isNothing) - +import Data.Bifunctor import Data.Char (isDigit) import Data.Char.Local (isAsciiLetter) -import Data.Text (split) +import Data.Text (Text) import Database.Esqueleto +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types +import Yesod.Persist.Core +import qualified Data.Text as T import qualified Database.Persist as P ((==.)) +import Vervis.Foundation +import Vervis.Model import Vervis.Model.Ident (shr2text, text2rp, prj2text) checkIdentTemplate :: Field Handler Text -> Field Handler Text checkIdentTemplate = let charOk c = isAsciiLetter c || isDigit c - wordOk w = (not . null) w && all charOk w - identOk t = (not . null) t && all wordOk (split (== '-') t) + wordOk w = (not . T.null) w && T.all charOk w + identOk t = (not . T.null) t && all wordOk (T.split (== '-') t) msg :: Text msg = "The repo identifier must be a sequence of one or more words \ \separated by hyphens (‘-’), and each such word may contain \ @@ -73,7 +79,7 @@ selectCollabFromAll rid = selectField $ do collab ?. RepoCollabPerson ==. just (person ^. PersonId) where_ $ isNothing $ collab ?. RepoCollabId return (sharer ^. SharerIdent, person ^. PersonId) - optionsPairs $ map (shr2text . unValue *** unValue) l + optionsPairs $ map (bimap (shr2text . unValue) unValue) l -- | Select a new collaborator for a repo, from the list of collaborators of -- the project it belongs to. It can be any collaborator of the project, who @@ -95,7 +101,7 @@ selectCollabFromProject jid rid = selectField $ do pcollab ^. ProjectCollabPerson ==. person ^. PersonId where_ $ isNothing $ rcollab ?. RepoCollabId return (sharer ^. SharerIdent, person ^. PersonId) - optionsPairs $ map (shr2text . unValue *** unValue) l + optionsPairs $ map (bimap (shr2text . unValue) unValue) l -- | Select a project for a new repository to belong to. It can be any project -- of the same sharer who's sharing the repo. diff --git a/src/Vervis/Field/Role.hs b/src/Vervis/Field/Role.hs index 24878fa..109eb0b 100644 --- a/src/Vervis/Field/Role.hs +++ b/src/Vervis/Field/Role.hs @@ -19,8 +19,6 @@ module Vervis.Field.Role ) where -import Prelude - import Data.Text (Text) import Database.Esqueleto import Yesod.Form.Fields (textField, selectField, optionsEnum) diff --git a/src/Vervis/Field/Sharer.hs b/src/Vervis/Field/Sharer.hs index 6a10083..17c0023 100644 --- a/src/Vervis/Field/Sharer.hs +++ b/src/Vervis/Field/Sharer.hs @@ -23,8 +23,6 @@ module Vervis.Field.Sharer ) where -import Prelude - import Control.Monad (void) import Control.Monad.Trans.Maybe import Data.Char (isDigit) diff --git a/src/Vervis/Field/Ticket.hs b/src/Vervis/Field/Ticket.hs index e65deb4..357451e 100644 --- a/src/Vervis/Field/Ticket.hs +++ b/src/Vervis/Field/Ticket.hs @@ -19,8 +19,6 @@ module Vervis.Field.Ticket ) where -import Prelude - import Control.Arrow ((***)) import Data.Text (Text) import Database.Esqueleto hiding ((%)) diff --git a/src/Vervis/Field/Workflow.hs b/src/Vervis/Field/Workflow.hs index 335089a..9834368 100644 --- a/src/Vervis/Field/Workflow.hs +++ b/src/Vervis/Field/Workflow.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -21,20 +21,26 @@ module Vervis.Field.Workflow ) where -import Vervis.Import hiding ((==.)) - import Data.Char (isDigit, isAlphaNum) import Data.Char.Local (isAsciiLetter) -import Data.Text (split) +import Data.Text (Text) import Database.Esqueleto +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types +import Yesod.Persist.Core +import qualified Data.Text as T + +import Vervis.Foundation +import Vervis.Model import Vervis.Model.Ident checkTemplate :: Field Handler Text -> Field Handler Text checkTemplate = let charOk c = isAsciiLetter c || isDigit c - wordOk w = (not . null) w && all charOk w - identOk t = (not . null) t && all wordOk (split (== '-') t) + wordOk w = (not . T.null) w && T.all charOk w + identOk t = (not . T.null) t && all wordOk (T.split (== '-') t) msg :: Text msg = "The identifier must be a sequence of one or more words \ \separated by hyphens (‘-’), and each such word may contain \ @@ -101,7 +107,7 @@ newEnumIdentField wid = checkEnmUniqueCI wid enumIdentField checkCtorName :: Field Handler Text -> Field Handler Text checkCtorName = let charOk c = isAlphaNum c || c == ' ' - nameOk t = (not . null) t && all charOk t + nameOk t = (not . T.null) t && T.all charOk t msg :: Text msg = "The name may contain only letters, digits and spaces." in checkBool nameOk msg diff --git a/src/Vervis/Form/Discussion.hs b/src/Vervis/Form/Discussion.hs index 8dadcf8..a1d7e39 100644 --- a/src/Vervis/Form/Discussion.hs +++ b/src/Vervis/Form/Discussion.hs @@ -19,8 +19,6 @@ module Vervis.Form.Discussion ) where -import Prelude - import Data.Text (Text) import Yesod.Form diff --git a/src/Vervis/Form/Group.hs b/src/Vervis/Form/Group.hs index a96d014..dd83e97 100644 --- a/src/Vervis/Form/Group.hs +++ b/src/Vervis/Form/Group.hs @@ -21,8 +21,6 @@ module Vervis.Form.Group ) where -import Prelude - import Data.Text (Text) import Yesod.Form.Fields (textField, selectFieldList) import Yesod.Form.Functions (aopt, areq, renderDivs) diff --git a/src/Vervis/Form/Key.hs b/src/Vervis/Form/Key.hs index eb9849c..263ad69 100644 --- a/src/Vervis/Form/Key.hs +++ b/src/Vervis/Form/Key.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -18,10 +18,14 @@ module Vervis.Form.Key ) where -import Vervis.Import +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types import Vervis.Field.Key -import Vervis.Model.Ident (text2ky) +import Vervis.Foundation +import Vervis.Model +import Vervis.Model.Ident newKeyAForm :: PersonId -> AForm Handler SshKey newKeyAForm pid = SshKey diff --git a/src/Vervis/Form/Person.hs b/src/Vervis/Form/Person.hs deleted file mode 100644 index 0801f08..0000000 --- a/src/Vervis/Form/Person.hs +++ /dev/null @@ -1,43 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Vervis.Form.Person - ( -- NewPerson (..) - -- , newPersonForm - ) -where - -import Vervis.Import - -import Vervis.Field.Person -import Vervis.Field.Sharer -import Vervis.Model.Ident (ShrIdent) - -data NewPerson = NewPerson - { npLogin :: ShrIdent - , npPass :: Text - , npName :: Maybe Text - , npEmail :: Maybe Text - } - -newPersonAForm :: AForm Handler NewPerson -newPersonAForm = NewPerson - <$> areq newSharerIdentField "Username*" Nothing - <*> areq passField "Password*" Nothing - <*> aopt textField "Full name" Nothing - <*> aopt emailField "E-mail" Nothing - -newPersonForm :: Form NewPerson -newPersonForm = renderDivs newPersonAForm diff --git a/src/Vervis/Form/Project.hs b/src/Vervis/Form/Project.hs index 0e48e98..190a68d 100644 --- a/src/Vervis/Form/Project.hs +++ b/src/Vervis/Form/Project.hs @@ -22,13 +22,20 @@ module Vervis.Form.Project ) where -import Vervis.Import hiding (on, isNothing) - +import Data.Bifunctor +import Data.Maybe +import Data.Text (Text) import Database.Esqueleto hiding ((==.)) +import Database.Persist ((==.)) +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types +import Yesod.Persist.Core import qualified Database.Esqueleto as E import Vervis.Field.Project +import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo @@ -93,9 +100,9 @@ newProjectCollabAForm sid jid = NewProjectCollab on $ collab ?. ProjectCollabProject E.==. just (val jid) &&. collab ?. ProjectCollabPerson E.==. just (person ^. PersonId) - where_ $ isNothing $ collab ?. ProjectCollabId + where_ $ E.isNothing $ collab ?. ProjectCollabId return (sharer ^. SharerIdent, person ^. PersonId) - optionsPairs $ map (shr2text . unValue *** unValue) l + optionsPairs $ map (bimap (shr2text . unValue) unValue) l selectRole = selectField $ optionsPersistKey [RoleSharer ==. sid] [] $ diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index a69a500..43f7fec 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -22,14 +22,14 @@ module Vervis.Form.Repo ) where ---import Prelude +import Data.Text (Text) +import Database.Persist +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types -import Database.Esqueleto hiding ((==.)) - -import qualified Database.Esqueleto as E ((==.)) - -import Vervis.Import hiding (isNothing, on) import Vervis.Field.Repo +import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo diff --git a/src/Vervis/Form/Role.hs b/src/Vervis/Form/Role.hs index c6c8dd6..7912ba7 100644 --- a/src/Vervis/Form/Role.hs +++ b/src/Vervis/Form/Role.hs @@ -20,8 +20,6 @@ module Vervis.Form.Role ) where -import Prelude - import Data.Text (Text) import Yesod.Form.Fields (textField) import Yesod.Form.Functions (areq, renderDivs) diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index 4d0680f..539c027 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -24,8 +24,6 @@ module Vervis.Form.Ticket ) where -import Prelude - import Control.Applicative (liftA2, liftA3) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) diff --git a/src/Vervis/Form/Workflow.hs b/src/Vervis/Form/Workflow.hs index 8e6627d..3c8a582 100644 --- a/src/Vervis/Form/Workflow.hs +++ b/src/Vervis/Form/Workflow.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -25,13 +25,13 @@ module Vervis.Form.Workflow ) where -import Vervis.Import hiding (on, isNothing) - -import Database.Esqueleto hiding ((==.)) - -import qualified Database.Esqueleto as E ((==.)) +import Data.Text (Text) +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types import Vervis.Field.Workflow +import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Workflow diff --git a/src/Vervis/Formatting.hs b/src/Vervis/Formatting.hs index f8066d1..4d73101 100644 --- a/src/Vervis/Formatting.hs +++ b/src/Vervis/Formatting.hs @@ -25,8 +25,6 @@ module Vervis.Formatting ) where -import Prelude - import Data.CaseInsensitive import Data.Text.Lazy.Builder (fromText) import Formatting diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 4e7bad9..93182a5 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -15,12 +15,10 @@ module Vervis.Foundation where -import Prelude (init, last) - -import Control.Concurrent.MVar (MVar, newEmptyMVar) +import Control.Concurrent.Chan import Control.Concurrent.STM.TVar +import Control.Monad import Control.Monad.Logger.CallStack (logWarn) -import Control.Monad.STM (atomically) import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Crypto.Error (CryptoFailable (..)) @@ -29,32 +27,41 @@ import Data.Char import Data.Either (isRight) import Data.HashMap.Strict (HashMap) import Data.List.NonEmpty (NonEmpty (..)) -import Data.Maybe (fromJust) -import Data.PEM (pemContent) -import Data.Text.Encoding (decodeUtf8') +import Data.Text (Text) +import Data.Text.Encoding +import Data.Time.Calendar +import Data.Time.Clock import Data.Time.Interval (TimeInterval, fromTimeUnit, toTimeUnit) -import Data.Time.Units (Second, Minute, Day) +import Data.Traversable +import Data.Vector (Vector) import Database.Persist.Postgresql import Database.Persist.Sql (ConnectionPool, runSqlPool) import Graphics.SVGFonts.ReadFont (PreparedFont) import Network.HTTP.Client (Manager, HasHttpManager (..)) -import Network.HTTP.Types.Header (hHost) +import Network.HTTP.Types.Header import Network.URI (URI, uriAuthority, uriFragment, uriRegName, parseURI) import Network.Wai import Text.Shakespeare.Text (textFile) import Text.Hamlet (hamletFile) --import Text.Jasmine (minifym) -import UnliftIO.MVar (withMVar) import Web.Hashids +import Yesod.Auth import Yesod.Auth.Account import Yesod.Auth.Account.Message (AccountMsg (MsgUsernameExists)) import Yesod.Auth.Message (AuthMessage (IdentifierNotFound)) -import Yesod.Core.Types (Logger) +import Yesod.Core hiding (logWarn) +import Yesod.Core.Types import Yesod.Default.Util (addStaticContentExternal) +import Yesod.Form.Fields +import Yesod.Form.Functions +import Yesod.Form.Types +import Yesod.Persist.Core +import Yesod.Static import qualified Data.ByteString.Char8 as BC (unpack) import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.HashMap.Strict as M (lookup, insert) +import qualified Data.Time.Units as U import qualified Database.Esqueleto as E import qualified Yesod.Core.Unsafe as Unsafe --import qualified Data.CaseInsensitive as CI @@ -84,11 +91,13 @@ import Yesod.Paginate.Local import Vervis.Access import Vervis.ActorKey -import Vervis.Import.NoFoundation hiding (Handler, Day, last, init, logWarn) +import Vervis.Model import Vervis.Model.Group import Vervis.Model.Ident import Vervis.Model.Role import Vervis.RemoteActorStore +import Vervis.Settings +import Vervis.Style import Vervis.Widget (breadcrumbsW, revisionW) data ActivityReport = ActivityReport @@ -167,7 +176,8 @@ instance Yesod App where makeSessionBackend app = -- sslOnlySessions $ let s = appSettings app - t = fromIntegral (toTimeUnit $ appClientSessionTimeout s :: Minute) + t = fromIntegral + (toTimeUnit $ appClientSessionTimeout s :: U.Minute) k = appClientSessionKeyFile s in Just <$> defaultClientSessionBackend t k @@ -629,8 +639,8 @@ instance YesodAuthVerify App where instance YesodAuthAccount AccountPersistDB' App where requireEmailVerification = appEmailVerification . appSettings - emailVerifyKeyDuration _ = Just $ fromTimeUnit (1 :: Day) - passphraseResetKeyDuration _ = Just $ fromTimeUnit (1 :: Day) + emailVerifyKeyDuration _ = Just $ fromTimeUnit (1 :: U.Day) + passphraseResetKeyDuration _ = Just $ fromTimeUnit (1 :: U.Day) allowLoginByEmailAddress _ = True runAccountDB = unAccountPersistDB' diff --git a/src/Vervis/Git.hs b/src/Vervis/Git.hs index 1d34488..60def2a 100644 --- a/src/Vervis/Git.hs +++ b/src/Vervis/Git.hs @@ -22,8 +22,6 @@ module Vervis.Git ) where -import Prelude - import Control.Arrow ((***)) import Control.Monad (join) import Control.Monad.Trans.Class (lift) diff --git a/src/Vervis/GraphProxy.hs b/src/Vervis/GraphProxy.hs index 1c3b23d..3f4ce88 100644 --- a/src/Vervis/GraphProxy.hs +++ b/src/Vervis/GraphProxy.hs @@ -33,8 +33,6 @@ module Vervis.GraphProxy ) where -import Prelude - import Data.Proxy import Vervis.Model diff --git a/src/Vervis/Handler/Common.hs b/src/Vervis/Handler/Common.hs index d6a28a8..6e1b466 100644 --- a/src/Vervis/Handler/Common.hs +++ b/src/Vervis/Handler/Common.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2019 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -20,8 +20,10 @@ module Vervis.Handler.Common ) where -import Data.FileEmbed (embedFile) -import Vervis.Import +import Data.FileEmbed +import Yesod.Core + +import Vervis.Foundation -- These handlers embed files in the executable at compile time to avoid a -- runtime dependency, and for efficiency. diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index fd8cd57..b3ca6cc 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -23,8 +23,6 @@ module Vervis.Handler.Discussion ) where -import Prelude - import Control.Monad import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except diff --git a/src/Vervis/Handler/Git.hs b/src/Vervis/Handler/Git.hs index 61c59aa..d2e48b0 100644 --- a/src/Vervis/Handler/Git.hs +++ b/src/Vervis/Handler/Git.hs @@ -19,8 +19,6 @@ module Vervis.Handler.Git ) where -import Prelude - import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Data.Binary.Put diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index 35f75c3..388b736 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -27,8 +27,6 @@ module Vervis.Handler.Group ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromMaybe) import Data.Time.Clock (getCurrentTime) diff --git a/src/Vervis/Handler/Home.hs b/src/Vervis/Handler/Home.hs index 3fd7692..d81282b 100644 --- a/src/Vervis/Handler/Home.hs +++ b/src/Vervis/Handler/Home.hs @@ -18,22 +18,29 @@ module Vervis.Handler.Home ) where -import Vervis.Import hiding (on) - import Database.Esqueleto hiding ((==.)) import Yesod.Auth.Account (newAccountR) -import Data.Time.Clock (diffUTCTime) +import Data.Time.Clock import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Traversable +import Database.Persist import Time.Types (Elapsed (..), Seconds (..)) +import Yesod.Auth +import Yesod.Core +import Yesod.Persist.Core import qualified Database.Esqueleto as E ((==.)) +import Data.EventTime.Local + import Vervis.Darcs +import Vervis.Foundation +import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Path +import Vervis.Settings -import Data.EventTime.Local import qualified Vervis.Git as G import qualified Vervis.Darcs as D diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index b8ba005..220f953 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -30,8 +30,6 @@ module Vervis.Handler.Inbox ) where -import Prelude - import Control.Applicative ((<|>)) import Control.Concurrent.STM.TVar (readTVarIO, modifyTVar') import Control.Exception hiding (Handler) diff --git a/src/Vervis/Handler/Key.hs b/src/Vervis/Handler/Key.hs index 7e6057f..33855b7 100644 --- a/src/Vervis/Handler/Key.hs +++ b/src/Vervis/Handler/Key.hs @@ -23,8 +23,6 @@ module Vervis.Handler.Key ) where -import Prelude - import Data.ByteString.Base64 (encode) import Data.Monoid ((<>)) import Data.Text (Text, intercalate) diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index 71ffde2..446695f 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -20,16 +20,12 @@ module Vervis.Handler.Person ) where -import Vervis.Import hiding ((==.)) ---import Prelude - -import Data.List.NonEmpty (NonEmpty (..)) import Database.Esqueleto hiding (isNothing, count) -import Vervis.Form.Person ---import Model import Text.Blaze.Html (toHtml) +import Yesod.Core import Yesod.Auth.Account (newAccountR, resendVerifyEmailWidget, username) import Yesod.Auth.Account.Message (AccountMsg (MsgEmailUnverified)) +import Yesod.Persist.Core import qualified Data.Text as T (unpack) @@ -41,10 +37,12 @@ import Network.FedURI import Web.ActivityPub import Yesod.FedURI ---import Vervis.ActivityStreams import Vervis.ActorKey +import Vervis.Foundation +import Vervis.Model import Vervis.Model.Ident import Vervis.Secure +import Vervis.Settings import Vervis.Widget (avatarW) -- | Account verification email resend form diff --git a/src/Vervis/Handler/Project.hs b/src/Vervis/Handler/Project.hs index 983cf72..e5eadde 100644 --- a/src/Vervis/Handler/Project.hs +++ b/src/Vervis/Handler/Project.hs @@ -32,8 +32,6 @@ module Vervis.Handler.Project ) where -import Prelude - import Data.Maybe (fromMaybe) import Data.Text (Text) import Database.Persist diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index ee34df7..d31eab1 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -38,8 +38,6 @@ module Vervis.Handler.Repo ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (logWarn) import Data.Git.Graph diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Handler/Repo/Darcs.hs index 7af4a06..6c72469 100644 --- a/src/Vervis/Handler/Repo/Darcs.hs +++ b/src/Vervis/Handler/Repo/Darcs.hs @@ -22,8 +22,6 @@ module Vervis.Handler.Repo.Darcs ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Data.List (inits) import Data.Maybe diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index 3f81a3f..8e93b41 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/src/Vervis/Handler/Repo/Git.hs @@ -21,8 +21,6 @@ module Vervis.Handler.Repo.Git ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Data.Git.Graph import Data.Git.Harder diff --git a/src/Vervis/Handler/Role.hs b/src/Vervis/Handler/Role.hs index 9bbc457..ecf7573 100644 --- a/src/Vervis/Handler/Role.hs +++ b/src/Vervis/Handler/Role.hs @@ -26,8 +26,6 @@ module Vervis.Handler.Role ) where -import Prelude - import Database.Persist import Network.HTTP.Types (StdMethod (DELETE)) import Text.Blaze.Html (Html) diff --git a/src/Vervis/Handler/Sharer.hs b/src/Vervis/Handler/Sharer.hs index c295376..dbca530 100644 --- a/src/Vervis/Handler/Sharer.hs +++ b/src/Vervis/Handler/Sharer.hs @@ -19,8 +19,6 @@ module Vervis.Handler.Sharer ) where -import Prelude - import Control.Applicative ((<|>)) import Control.Monad.Logger (logWarn) import Control.Monad.Trans.Maybe diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 4d4293d..67d5d7a 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -54,8 +54,6 @@ module Vervis.Handler.Ticket ) where -import Prelude - import Control.Applicative (liftA2) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (logWarn) diff --git a/src/Vervis/Handler/Wiki.hs b/src/Vervis/Handler/Wiki.hs index 2a765bd..de25406 100644 --- a/src/Vervis/Handler/Wiki.hs +++ b/src/Vervis/Handler/Wiki.hs @@ -18,8 +18,6 @@ module Vervis.Handler.Wiki ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import Data.Traversable (for) diff --git a/src/Vervis/Handler/Workflow.hs b/src/Vervis/Handler/Workflow.hs index 99b1ac3..18f75d3 100644 --- a/src/Vervis/Handler/Workflow.hs +++ b/src/Vervis/Handler/Workflow.hs @@ -45,8 +45,6 @@ module Vervis.Handler.Workflow ) where -import Prelude - import Data.Maybe (fromMaybe) import Data.Text (Text) import Database.Persist diff --git a/src/Vervis/Import.hs b/src/Vervis/Import.hs deleted file mode 100644 index 1c0f3fc..0000000 --- a/src/Vervis/Import.hs +++ /dev/null @@ -1,19 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Vervis.Import ( module Import ) where - -import Vervis.Foundation as Import -import Vervis.Import.NoFoundation as Import hiding (Handler) diff --git a/src/Vervis/Import/NoFoundation.hs b/src/Vervis/Import/NoFoundation.hs deleted file mode 100644 index 6810810..0000000 --- a/src/Vervis/Import/NoFoundation.hs +++ /dev/null @@ -1,35 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Vervis.Import.NoFoundation ( module Import ) where - -import ClassyPrelude.Conduit as Import hiding (delete, deleteBy, readTVarIO, newEmptyMVar, atomically) -import Data.Default as Import (Default (..)) -import Database.Persist.Sql as Import ( SqlBackend - , SqlPersistT - , runMigration - ) ---import Network.HTTP.Client.Conduit as Import -import Network.HTTP.Types as Import -import Yesod as Import hiding (Header, parseTime) -import Yesod.Auth as Import -import Yesod.Core.Types as Import (loggerSet) -import Yesod.Default.Config2 as Import ---import Yesod.Feed as Import -import Yesod.Static as Import - -import Vervis.Style as Import -import Vervis.Model as Import -import Vervis.Settings as Import diff --git a/src/Vervis/KeyFile.hs b/src/Vervis/KeyFile.hs index 6d5998c..f4b5b6b 100644 --- a/src/Vervis/KeyFile.hs +++ b/src/Vervis/KeyFile.hs @@ -44,8 +44,6 @@ module Vervis.KeyFile ) where -import Prelude - import Control.Monad.Trans.Reader (runReaderT) import Database.Persist.Schema (SchemaBackend, hasEntities) import Database.Persist.Schema.SQL () diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index cde8e2c..d3bebf4 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -18,8 +18,6 @@ module Vervis.Migration ) where -import Prelude - import Control.Applicative import Control.Exception import Control.Monad (unless) diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 13a5809..12ba7ea 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -94,8 +94,6 @@ module Vervis.Migration.Model ) where -import Prelude - import Data.ByteString (ByteString) import Data.Text (Text) import Data.Time (UTCTime) diff --git a/src/Vervis/Migration/TH.hs b/src/Vervis/Migration/TH.hs index bf6f6d1..84f6b06 100644 --- a/src/Vervis/Migration/TH.hs +++ b/src/Vervis/Migration/TH.hs @@ -18,8 +18,6 @@ module Vervis.Migration.TH ) where -import Prelude - import Database.Persist.Schema.TH (entitiesFromFile) import Language.Haskell.TH (Q, Exp) import System.FilePath ((), (<.>)) diff --git a/src/Vervis/Model.hs b/src/Vervis/Model.hs index 6552729..19639ca 100644 --- a/src/Vervis/Model.hs +++ b/src/Vervis/Model.hs @@ -17,9 +17,12 @@ module Vervis.Model where -import ClassyPrelude.Conduit import Yesod hiding (Header, parseTime) +import Data.ByteString (ByteString) +import Data.Hashable +import Data.Text (Text) +import Data.Time.Clock import Database.Persist.Quasi import Database.Persist.Sql (fromSqlKey) import Text.Email.Validate (EmailAddress) diff --git a/src/Vervis/Model/Entity.hs b/src/Vervis/Model/Entity.hs index 0c65058..6c692e5 100644 --- a/src/Vervis/Model/Entity.hs +++ b/src/Vervis/Model/Entity.hs @@ -20,8 +20,6 @@ module Vervis.Model.Entity ) where -import Prelude - import Data.Text (Text) import Database.Persist.Class (PersistEntity) diff --git a/src/Vervis/Model/Group.hs b/src/Vervis/Model/Group.hs index 6afcb47..e52f3c1 100644 --- a/src/Vervis/Model/Group.hs +++ b/src/Vervis/Model/Group.hs @@ -18,8 +18,6 @@ module Vervis.Model.Group ) where -import Prelude - import Database.Persist.TH data GroupRole = GRMember | GRAdmin diff --git a/src/Vervis/Model/Ident.hs b/src/Vervis/Model/Ident.hs index ce41d7a..3f1792a 100644 --- a/src/Vervis/Model/Ident.hs +++ b/src/Vervis/Model/Ident.hs @@ -43,8 +43,6 @@ module Vervis.Model.Ident ) where -import Prelude - import Data.CaseInsensitive (CI) import Data.Text (Text) import Database.Esqueleto (SqlString) diff --git a/src/Vervis/Model/Repo.hs b/src/Vervis/Model/Repo.hs index f0f2ceb..8dc76c6 100644 --- a/src/Vervis/Model/Repo.hs +++ b/src/Vervis/Model/Repo.hs @@ -18,8 +18,6 @@ module Vervis.Model.Repo ) where -import Prelude - import Database.Persist.TH data VersionControlSystem = VCSGit | VCSDarcs diff --git a/src/Vervis/Model/Role.hs b/src/Vervis/Model/Role.hs index 07c255a..7e0d0ba 100644 --- a/src/Vervis/Model/Role.hs +++ b/src/Vervis/Model/Role.hs @@ -19,8 +19,6 @@ module Vervis.Model.Role ) where -import Prelude - import Database.Persist.TH data RepoOperation = RepoOpPush deriving (Eq, Show, Read, Enum, Bounded) diff --git a/src/Vervis/Model/TH.hs b/src/Vervis/Model/TH.hs index 55007a8..5866c2b 100644 --- a/src/Vervis/Model/TH.hs +++ b/src/Vervis/Model/TH.hs @@ -22,8 +22,6 @@ module Vervis.Model.TH ) where -import Prelude - import Control.Applicative ((<|>)) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) diff --git a/src/Vervis/Model/Ticket.hs b/src/Vervis/Model/Ticket.hs index 22e3e25..9735d55 100644 --- a/src/Vervis/Model/Ticket.hs +++ b/src/Vervis/Model/Ticket.hs @@ -18,8 +18,6 @@ module Vervis.Model.Ticket ) where -import Prelude - import Database.Persist.TH data TicketStatus = TSNew | TSTodo | TSClosed diff --git a/src/Vervis/Model/Workflow.hs b/src/Vervis/Model/Workflow.hs index e85c3e7..504df04 100644 --- a/src/Vervis/Model/Workflow.hs +++ b/src/Vervis/Model/Workflow.hs @@ -19,8 +19,6 @@ module Vervis.Model.Workflow ) where -import Prelude - import Database.Persist.TH data WorkflowScope = WSSharer | WSPublic | WSFeatured diff --git a/src/Vervis/Paginate.hs b/src/Vervis/Paginate.hs index 4f7906a..05bc621 100644 --- a/src/Vervis/Paginate.hs +++ b/src/Vervis/Paginate.hs @@ -23,8 +23,6 @@ module Vervis.Paginate ) where -import Prelude - import Control.Arrow (second) import Data.Default.Class (def) import Data.Maybe (fromMaybe) diff --git a/src/Vervis/Palette.hs b/src/Vervis/Palette.hs index 68023ca..b13a463 100644 --- a/src/Vervis/Palette.hs +++ b/src/Vervis/Palette.hs @@ -36,8 +36,6 @@ module Vervis.Palette ) where -import Prelude - import Data.Word (Word8) type RGB = (Word8, Word8, Word8) diff --git a/src/Vervis/Patch.hs b/src/Vervis/Patch.hs index adb725f..a1b2e49 100644 --- a/src/Vervis/Patch.hs +++ b/src/Vervis/Patch.hs @@ -25,8 +25,6 @@ module Vervis.Patch ) where -import Prelude - import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) diff --git a/src/Vervis/Path.hs b/src/Vervis/Path.hs index b9033eb..eb098ba 100644 --- a/src/Vervis/Path.hs +++ b/src/Vervis/Path.hs @@ -22,8 +22,6 @@ module Vervis.Path ) where -import Prelude - import Data.Text (Text) import System.FilePath (()) import Yesod.Core.Handler (getsYesod) diff --git a/src/Vervis/Query.hs b/src/Vervis/Query.hs index 2efe5f5..644dc87 100644 --- a/src/Vervis/Query.hs +++ b/src/Vervis/Query.hs @@ -22,8 +22,6 @@ module Vervis.Query ) where -import Prelude - import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Reader (ReaderT, ask) import Data.Maybe (listToMaybe) diff --git a/src/Vervis/RemoteActorStore.hs b/src/Vervis/RemoteActorStore.hs index 1da82d3..640634e 100644 --- a/src/Vervis/RemoteActorStore.hs +++ b/src/Vervis/RemoteActorStore.hs @@ -30,8 +30,6 @@ module Vervis.RemoteActorStore ) where -import Prelude - import Control.Applicative import Control.Concurrent (forkIO) import Control.Concurrent.MVar (MVar, newMVar) diff --git a/src/Vervis/Role.hs b/src/Vervis/Role.hs index 53531d5..5c5445a 100644 --- a/src/Vervis/Role.hs +++ b/src/Vervis/Role.hs @@ -18,8 +18,6 @@ module Vervis.Role ) where -import Prelude - import Control.Arrow (second, (&&&), (***)) import Data.Graph.Inductive.Graph (mkGraph) import Data.Graph.Inductive.PatriciaTree (Gr) diff --git a/src/Vervis/Secure.hs b/src/Vervis/Secure.hs index 99cbfb6..9c9f614 100644 --- a/src/Vervis/Secure.hs +++ b/src/Vervis/Secure.hs @@ -39,8 +39,6 @@ module Vervis.Secure ) where -import Prelude - import Control.Monad ((<=<)) import Data.Text (Text) import Network.Wai (isSecure) diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index a2882ca..5193055 100644 --- a/src/Vervis/Settings.hs +++ b/src/Vervis/Settings.hs @@ -22,7 +22,6 @@ -- declared in the Foundation.hs file. module Vervis.Settings where -import ClassyPrelude.Conduit hiding (throw) import Yesod hiding (Header, parseTime) import Yesod.Static import Data.Default (Default (..)) @@ -30,7 +29,10 @@ import Data.Default (Default (..)) import Control.Exception (throw) import Data.Aeson (Result (..), fromJSON, withObject, (.!=), (.:?)) +import Data.ByteString (ByteString) import Data.FileEmbed (embedFile) +import Data.String +import Data.Text (Text) import Data.Time.Clock import Data.Time.Interval import Data.Time.Interval.Aeson diff --git a/src/Vervis/SourceTree.hs b/src/Vervis/SourceTree.hs index ac7dcb2..b55fbfc 100644 --- a/src/Vervis/SourceTree.hs +++ b/src/Vervis/SourceTree.hs @@ -26,8 +26,6 @@ module Vervis.SourceTree ) where -import Prelude - import Data.Text (Text) import qualified Data.ByteString.Lazy as BL (ByteString) diff --git a/src/Vervis/Ssh.hs b/src/Vervis/Ssh.hs index 5cda862..2e1b965 100644 --- a/src/Vervis/Ssh.hs +++ b/src/Vervis/Ssh.hs @@ -18,8 +18,6 @@ module Vervis.Ssh ) where -import Prelude - import Control.Applicative ((<|>), optional) import Control.Monad (when) import Control.Monad.IO.Class (liftIO) diff --git a/src/Vervis/Style.hs b/src/Vervis/Style.hs index c657a2c..9354bc6 100644 --- a/src/Vervis/Style.hs +++ b/src/Vervis/Style.hs @@ -37,8 +37,6 @@ module Vervis.Style ) where -import Prelude - import Text.Cassius (ToCss (..)) import qualified Text.Cassius as C (Color (Color)) diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index f53712d..fdde7b1 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -28,8 +28,6 @@ module Vervis.Ticket ) where -import Prelude - import Control.Arrow ((***)) import Data.Foldable (for_) import Data.Text (Text) diff --git a/src/Vervis/TicketFilter.hs b/src/Vervis/TicketFilter.hs index ad9d38f..d5bf7ff 100644 --- a/src/Vervis/TicketFilter.hs +++ b/src/Vervis/TicketFilter.hs @@ -19,8 +19,6 @@ module Vervis.TicketFilter ) where -import Prelude - import Data.Default.Class import Database.Esqueleto diff --git a/src/Vervis/Time.hs b/src/Vervis/Time.hs index ef0959d..7d9470f 100644 --- a/src/Vervis/Time.hs +++ b/src/Vervis/Time.hs @@ -18,8 +18,6 @@ module Vervis.Time ) where -import Prelude - import Data.Text (Text) import Data.Time.Calendar (toGregorian) import Data.Time.Clock (UTCTime (..)) diff --git a/src/Vervis/Widget.hs b/src/Vervis/Widget.hs index 43ca855..68ed4ef 100644 --- a/src/Vervis/Widget.hs +++ b/src/Vervis/Widget.hs @@ -22,8 +22,6 @@ module Vervis.Widget ) where -import Prelude - import Data.Text (Text) import Data.Time.Calendar (toGregorian) import Data.Time.Clock (UTCTime (..)) diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs index beb15ce..0bd4f3b 100644 --- a/src/Vervis/Widget/Discussion.hs +++ b/src/Vervis/Widget/Discussion.hs @@ -19,8 +19,6 @@ module Vervis.Widget.Discussion ) where -import Prelude - import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) diff --git a/src/Vervis/Widget/Repo.hs b/src/Vervis/Widget/Repo.hs index f844bac..f67cf7f 100644 --- a/src/Vervis/Widget/Repo.hs +++ b/src/Vervis/Widget/Repo.hs @@ -20,8 +20,6 @@ module Vervis.Widget.Repo ) where -import Prelude - import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty) import Data.Set (Set) diff --git a/src/Vervis/Widget/Role.hs b/src/Vervis/Widget/Role.hs index fdb244a..28923c7 100644 --- a/src/Vervis/Widget/Role.hs +++ b/src/Vervis/Widget/Role.hs @@ -18,8 +18,6 @@ module Vervis.Widget.Role ) where -import Prelude - import Data.Graph.Inductive.Graph (Graph) import Diagrams.Backend.SVG import Diagrams.Core.Compile (renderDia) diff --git a/src/Vervis/Widget/Sharer.hs b/src/Vervis/Widget/Sharer.hs index 865e658..1e6932e 100644 --- a/src/Vervis/Widget/Sharer.hs +++ b/src/Vervis/Widget/Sharer.hs @@ -19,8 +19,6 @@ module Vervis.Widget.Sharer ) where -import Prelude - import Yesod.Core import Network.FedURI diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs index d359b0a..d16fbc4 100644 --- a/src/Vervis/Widget/Ticket.hs +++ b/src/Vervis/Widget/Ticket.hs @@ -22,8 +22,6 @@ module Vervis.Widget.Ticket ) where -import Prelude - import Control.Arrow ((&&&), (***)) import Data.HashMap.Lazy (HashMap) import Data.Maybe (mapMaybe) diff --git a/src/Vervis/Widget/Workflow.hs b/src/Vervis/Widget/Workflow.hs index 7cc1c1a..00b7f0f 100644 --- a/src/Vervis/Widget/Workflow.hs +++ b/src/Vervis/Widget/Workflow.hs @@ -18,8 +18,6 @@ module Vervis.Widget.Workflow ) where -import Prelude - import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident (wfl2text) diff --git a/src/Vervis/Wiki.hs b/src/Vervis/Wiki.hs index fa4e065..b6a7dac 100644 --- a/src/Vervis/Wiki.hs +++ b/src/Vervis/Wiki.hs @@ -18,8 +18,6 @@ module Vervis.Wiki ) where -import Prelude - import Data.Text (Text) import qualified Data.ByteString.Lazy as BL (ByteString) diff --git a/src/Web/ActivityAccess.hs b/src/Web/ActivityAccess.hs index dd42310..d7bdb6a 100644 --- a/src/Web/ActivityAccess.hs +++ b/src/Web/ActivityAccess.hs @@ -23,8 +23,6 @@ module Web.ActivityAccess ) where -import Prelude - import Crypto.Hash import Crypto.MAC.HMAC import Crypto.Random diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index 0f90cf5..afd5488 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -78,8 +78,6 @@ module Web.ActivityPub ) where -import Prelude - import Control.Applicative ((<|>), optional) import Control.Exception (Exception, displayException, try) import Control.Monad (when, unless, (<=<), join) diff --git a/src/Web/Hashids/Local.hs b/src/Web/Hashids/Local.hs index 9592daa..9b11622 100644 --- a/src/Web/Hashids/Local.hs +++ b/src/Web/Hashids/Local.hs @@ -20,8 +20,6 @@ module Web.Hashids.Local ) where -import Prelude - import Control.Monad (replicateM) import Data.ByteString (ByteString) import Data.Int (Int64) diff --git a/src/Web/PathPieces/Local.hs b/src/Web/PathPieces/Local.hs index 85cbc55..ac8b4b6 100644 --- a/src/Web/PathPieces/Local.hs +++ b/src/Web/PathPieces/Local.hs @@ -18,8 +18,6 @@ module Web.PathPieces.Local ) where -import Prelude - import Data.CaseInsensitive (CI) import Web.PathPieces diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs index fcaf6ca..bdb80f9 100644 --- a/src/Yesod/ActivityPub.hs +++ b/src/Yesod/ActivityPub.hs @@ -22,8 +22,6 @@ module Yesod.ActivityPub ) where -import Prelude - import Control.Exception import Control.Monad.Logger.CallStack import Data.ByteString (ByteString) diff --git a/src/Yesod/Auth/Unverified.hs b/src/Yesod/Auth/Unverified.hs index 50695f0..656be3c 100644 --- a/src/Yesod/Auth/Unverified.hs +++ b/src/Yesod/Auth/Unverified.hs @@ -65,8 +65,6 @@ module Yesod.Auth.Unverified ) where -import Prelude - import Control.Applicative ((<|>)) import Control.Monad (when) import Control.Monad.Trans.Maybe diff --git a/src/Yesod/Auth/Unverified/Creds.hs b/src/Yesod/Auth/Unverified/Creds.hs index 10c991c..c43120d 100644 --- a/src/Yesod/Auth/Unverified/Creds.hs +++ b/src/Yesod/Auth/Unverified/Creds.hs @@ -104,8 +104,6 @@ import Control.Monad (void) -- Now come imports that I added -import Prelude - import Control.Monad.Trans.Resource (MonadResourceBase) import Yesod.Auth hiding (credsKey) diff --git a/src/Yesod/Auth/Unverified/Internal.hs b/src/Yesod/Auth/Unverified/Internal.hs index 9ac77fb..14225ab 100644 --- a/src/Yesod/Auth/Unverified/Internal.hs +++ b/src/Yesod/Auth/Unverified/Internal.hs @@ -22,8 +22,6 @@ module Yesod.Auth.Unverified.Internal ) where -import Prelude - import Data.Text (Text) import Yesod.Auth (YesodAuth (..)) import Yesod.Core (MonadHandler (..), Route) diff --git a/src/Yesod/FedURI.hs b/src/Yesod/FedURI.hs index f9577e6..54ea8e6 100644 --- a/src/Yesod/FedURI.hs +++ b/src/Yesod/FedURI.hs @@ -24,8 +24,6 @@ module Yesod.FedURI ) where -import Prelude - import Control.Monad import Data.Text (Text) import Data.Text.Encoding diff --git a/src/Yesod/MonadSite.hs b/src/Yesod/MonadSite.hs index a1b1062..a0bdcf1 100644 --- a/src/Yesod/MonadSite.hs +++ b/src/Yesod/MonadSite.hs @@ -30,8 +30,6 @@ module Yesod.MonadSite ) where -import Prelude - import Control.Exception import Control.Monad.Fail import Control.Monad.IO.Class diff --git a/src/Yesod/Paginate/Local.hs b/src/Yesod/Paginate/Local.hs index 143d454..a74063b 100644 --- a/src/Yesod/Paginate/Local.hs +++ b/src/Yesod/Paginate/Local.hs @@ -28,8 +28,6 @@ module Yesod.Paginate.Local ) where -import Prelude - import Data.Default.Class import Data.Text (Text) import Text.Blaze (ToMarkup) diff --git a/src/Yesod/Persist/Local.hs b/src/Yesod/Persist/Local.hs index 24cd7d9..f79d0d9 100644 --- a/src/Yesod/Persist/Local.hs +++ b/src/Yesod/Persist/Local.hs @@ -19,8 +19,6 @@ module Yesod.Persist.Local ) where -import Prelude - import Control.Monad.IO.Class import Control.Monad.Trans.Reader diff --git a/src/Yesod/RenderSource.hs b/src/Yesod/RenderSource.hs index 174533f..09ee30d 100644 --- a/src/Yesod/RenderSource.hs +++ b/src/Yesod/RenderSource.hs @@ -44,8 +44,6 @@ module Yesod.RenderSource ) where -import Prelude - import Control.Exception import Control.Monad.Catch (throwM) import Control.Monad.Logger (logDebug, logWarn) diff --git a/src/Yesod/SessionEntity.hs b/src/Yesod/SessionEntity.hs index 63f9658..65e4b36 100644 --- a/src/Yesod/SessionEntity.hs +++ b/src/Yesod/SessionEntity.hs @@ -46,8 +46,6 @@ module Yesod.SessionEntity ) where -import Prelude - import Control.Monad.Trans.Maybe import Data.Text (Text) import Data.Typeable (Typeable) diff --git a/vervis.cabal b/vervis.cabal index 0675444..a72350f 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -114,7 +114,6 @@ library Vervis.Access Vervis.ActivityPub - Vervis.ActivityStreams Vervis.ActorKey Vervis.API Vervis.Application @@ -139,7 +138,6 @@ library Vervis.Form.Discussion Vervis.Form.Group Vervis.Form.Key - Vervis.Form.Person Vervis.Form.Project Vervis.Form.Repo Vervis.Form.Role @@ -166,8 +164,6 @@ library Vervis.Handler.Ticket Vervis.Handler.Wiki Vervis.Handler.Workflow - Vervis.Import - Vervis.Import.NoFoundation Vervis.KeyFile Vervis.Migration Vervis.Migration.Model @@ -210,7 +206,6 @@ library default-extensions: TemplateHaskell QuasiQuotes OverloadedStrings - NoImplicitPrelude MultiParamTypeClasses TypeFamilies GADTs @@ -246,8 +241,6 @@ library -- for Darcs.Local.PatchInfo.Parser , bytestring-lexing , case-insensitive - , classy-prelude - , classy-prelude-conduit -- for defining colors for use with diagrams , colour , conduit @@ -397,7 +390,6 @@ test-suite test default-extensions: TemplateHaskell QuasiQuotes OverloadedStrings - NoImplicitPrelude CPP MultiParamTypeClasses TypeFamilies @@ -422,8 +414,6 @@ test-suite test , shakespeare , transformers , hspec >= 2.0.0 - , classy-prelude - , classy-prelude-yesod , aeson hs-source-dirs: test default-language: Haskell2010