From b9043d58d1200f4021aebe7ed6957687fff7d173 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hamal=20Dvo=C5=99=C3=A1k?= <mordae@anilinux.org> Date: Wed, 26 May 2021 01:53:31 +0200 Subject: [PATCH] Port to Praha prelude MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Jan Hamal Dvořák <mordae@anilinux.org> --- hikaru.cabal | 4 +-- lib/Hikaru/Action.hs | 7 +++-- lib/Hikaru/CSRF.hs | 9 +++---- lib/Hikaru/Config.hs | 58 ++++++++++++++++++++++------------------- lib/Hikaru/Develop.hs | 4 ++- lib/Hikaru/Dispatch.hs | 7 ++--- lib/Hikaru/Form.hs | 6 +++-- lib/Hikaru/Link.hs | 4 +-- lib/Hikaru/Localize.hs | 9 +++---- lib/Hikaru/Media.hs | 14 +++++----- lib/Hikaru/Route.hs | 5 ++-- lib/Hikaru/Types.hs | 3 +-- lib/Hikaru/Widget.hs | 4 +-- test/Hikaru/Demo.hs | 17 ++++++------ test/Hikaru/DemoSpec.hs | 2 +- test/Hikaru/FormSpec.hs | 2 +- test/Hikaru/Test.hs | 2 +- 17 files changed, 81 insertions(+), 76 deletions(-) diff --git a/hikaru.cabal b/hikaru.cabal index 482b7a1..82c6fe4 100644 --- a/hikaru.cabal +++ b/hikaru.cabal @@ -67,7 +67,7 @@ common common -Wredundant-constraints build-depends: - aeson >=1.4 && <1.6 + , aeson >=1.4 && <1.6 , base >=4.13 && <4.16 , binary >=0.8 && <0.9 , bytestring >=0.10 && <0.12 @@ -80,7 +80,7 @@ common common , lucid >=2.9 && <2.10 , memory >=0.15 && <0.16 , mtl >=2.2 && <2.3 - , relude >=0.7 && <1.1 + , praha >=0.1 && <0.2 , resourcet >=1.2 && <1.3 , string-conversions >=0.4 && <0.5 , text >=1.2 && <1.3 diff --git a/lib/Hikaru/Action.hs b/lib/Hikaru/Action.hs index 3ffc038..1d7edbd 100644 --- a/lib/Hikaru/Action.hs +++ b/lib/Hikaru/Action.hs @@ -113,7 +113,7 @@ module Hikaru.Action , FilePath ) where - import Relude hiding (writeIORef, readIORef, modifyIORef', newIORef) + import Praha import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -126,8 +126,7 @@ where import Data.Aeson import Data.Binary.Builder import Data.Dynamic - import Data.List (lookup, deleteBy) - import Data.String.Conversions + import Data.List (deleteBy, lookup, map, filter) import Hikaru.Config import Hikaru.Media import Hikaru.Types @@ -556,7 +555,7 @@ where where throwLimitIO :: Int64 -> IO a throwLimitIO n = throwIO (PayloadTooLarge, msg :: Text) - where msg = "Limit is " <> show n <> " bytes." + where msg = "Limit is " <> tshow n <> " bytes." -- | diff --git a/lib/Hikaru/CSRF.hs b/lib/Hikaru/CSRF.hs index d5904fa..d7ceacb 100644 --- a/lib/Hikaru/CSRF.hs +++ b/lib/Hikaru/CSRF.hs @@ -15,11 +15,10 @@ module Hikaru.CSRF , isTokenValid ) where - import Relude + import Praha import Crypto.Hash import Crypto.MAC.HMAC - import Data.String.Conversions import Data.Text (splitOn) import Data.Time.Clock.POSIX (getPOSIXTime) @@ -37,7 +36,7 @@ where secret <- getConfigDefault "CSRF_SECRET" "" let signature = sign now secret - in return $ mconcat [ show now, ":", signature ] + in return $ mconcat [ tshow now, ":", signature ] -- | @@ -73,11 +72,11 @@ where sign :: Int64 -> Text -> Text - sign timestamp secret = show $ hmacGetDigest digest + sign timestamp secret = tshow $ hmacGetDigest digest where digest = hmac timeBytes secretBytes :: HMAC SHA256 secretBytes = cs secret :: ByteString - timeBytes = show timestamp :: ByteString + timeBytes = cs (show timestamp) :: ByteString -- vim:set ft=haskell sw=2 ts=2 et: diff --git a/lib/Hikaru/Config.hs b/lib/Hikaru/Config.hs index 312c253..a52c981 100644 --- a/lib/Hikaru/Config.hs +++ b/lib/Hikaru/Config.hs @@ -1,24 +1,23 @@ -{-| -Module : Hikaru.Config -Copyright : Jan Hamal Dvořák -License : AGPL-3.0-or-later - -Maintainer : mordae@anilinux.org -Stability : unstable -Portability : non-portable (ghc) - -This module provides means to read configuration from environment and files. - -Example: - -@ -base <- 'configDefault' -file <- 'configFromFile' \"site.env\" -env <- 'configFromEnv' - -let cfg = env <> file <> base -@ --} +-- +-- Module : Hikaru.Config +-- Copyright : Jan Hamal Dvořák +-- License : AGPL-3.0-or-later +-- +-- Maintainer : mordae@anilinux.org +-- Stability : unstable +-- Portability : non-portable (ghc) +-- +-- This module provides means to read configuration from environment and files. +-- +-- Example: +-- +-- @ +-- base <- 'configDefault' +-- file <- 'configFromFile' \"site.env\" +-- env <- 'configFromEnv' +-- +-- let cfg = env <> file <> base +-- @ module Hikaru.Config ( Config @@ -35,13 +34,17 @@ module Hikaru.Config , generateSecret ) where - import Relude hiding (drop, lines, isPrefixOf, length, span) + import Praha + + import Hikaru.Types + import UnliftIO.Environment import Crypto.Random.Entropy import Data.ByteArray.Encoding - import Data.String.Conversions - import Data.Text hiding (map) - import Hikaru.Types + + import Data.Text (lines, strip, drop, span, isPrefixOf) + import Data.Text.IO (readFile) + import Data.List (map) import qualified Data.Map as Map @@ -84,8 +87,9 @@ where -- @ -- configFromFile :: (MonadIO m) => FilePath -> m Config - configFromFile path = Map.fromList <$> parseFile <$> readFileText path + configFromFile path = Map.fromList <$> parseFile <$> contents where + contents = liftIO (readFile path) parseFile = mapMaybe parseLine . lines parseLine = fmap tidy . fmap parseKV . reject . strip parseKV = fmap (drop 1) . span (/= '=') @@ -114,7 +118,7 @@ where configGet :: (Param a) => Text -> Config -> a configGet name cfg = case configGetMaybe name cfg of Just value -> value - Nothing -> error (name <> " not set!") + Nothing -> error (cs name <> " not set!") -- | diff --git a/lib/Hikaru/Develop.hs b/lib/Hikaru/Develop.hs index cd48833..0ba78b3 100644 --- a/lib/Hikaru/Develop.hs +++ b/lib/Hikaru/Develop.hs @@ -14,7 +14,9 @@ module Hikaru.Develop ( developWith ) where - import Relude + import Praha + + import UnliftIO.MVar import Control.Concurrent (killThread, forkFinally) import Foreign.Store diff --git a/lib/Hikaru/Dispatch.hs b/lib/Hikaru/Dispatch.hs index c969f10..ec0e1af 100644 --- a/lib/Hikaru/Dispatch.hs +++ b/lib/Hikaru/Dispatch.hs @@ -32,15 +32,16 @@ module Hikaru.Dispatch , TopLevel ) where - import Relude + import Praha - import Control.Exception (catch) + import Control.Monad.State import Data.CaseInsensitive (original) - import Data.List (lookup, deleteBy) + import Data.List (lookup, deleteBy, intersperse, reverse, map) import Hikaru.Route import Hikaru.Types import Network.HTTP.Types.Header import Network.Wai + import UnliftIO.Exception import qualified Data.Map.Strict as Map diff --git a/lib/Hikaru/Form.hs b/lib/Hikaru/Form.hs index e57b936..a467a0b 100644 --- a/lib/Hikaru/Form.hs +++ b/lib/Hikaru/Form.hs @@ -96,15 +96,17 @@ module Hikaru.Form , FromFormMessage(..) ) where - import Relude hiding (Option, show, elem) + import Praha hiding (show, elem) + import Control.Monad.State import Data.Dynamic - import Data.List (elem, lookup) + import Data.List (elem, map, lookup, filter) import Data.Text (strip) import Hikaru.Action import Hikaru.CSRF import Hikaru.Localize import Hikaru.Types + import System.IO import Text.Show diff --git a/lib/Hikaru/Link.hs b/lib/Hikaru/Link.hs index f9ef966..d41017c 100644 --- a/lib/Hikaru/Link.hs +++ b/lib/Hikaru/Link.hs @@ -25,13 +25,13 @@ module Hikaru.Link , isActivePrefix ) where - import Relude + import Praha import Data.Binary.Builder - import Data.String.Conversions import Lucid import Network.HTTP.Types.URI import Hikaru.Action + import Data.List (isPrefixOf, map, filter) -- | diff --git a/lib/Hikaru/Localize.hs b/lib/Hikaru/Localize.hs index 2091313..b61cdbd 100644 --- a/lib/Hikaru/Localize.hs +++ b/lib/Hikaru/Localize.hs @@ -64,10 +64,9 @@ module Hikaru.Localize , selectLanguages ) where - import Relude + import Praha - import Data.List (nub) - import Data.String.Conversions + import Data.List (filter, map, nub) import Hikaru.Action import Hikaru.Media import Lucid @@ -129,7 +128,7 @@ where langs <- getLanguages case mapMaybe (flip localize msg) langs of - [] -> return $ show msg + [] -> return $ tshow msg x:_ -> return x @@ -142,7 +141,7 @@ where langs <- getLanguages case mapMaybe (flip localizeHtml msg) langs of - [] -> toHtml $ (show msg :: Text) + [] -> toHtml $ tshow msg x:_ -> x diff --git a/lib/Hikaru/Media.hs b/lib/Hikaru/Media.hs index 1f7dcb2..c34b1ae 100644 --- a/lib/Hikaru/Media.hs +++ b/lib/Hikaru/Media.hs @@ -25,12 +25,12 @@ module Hikaru.Media , selectMedia ) where - import Relude hiding (head, get, many) - import Relude.Unsafe (head) - import Text.ParserCombinators.ReadP - import Data.String.Conversions + import Praha hiding (many) + import Data.Text (toLower) - import Data.List (lookup) + + import Data.List (filter, lookup, head, sortOn) + import Text.ParserCombinators.ReadP import Data.Char (isControl, isSpace) @@ -70,7 +70,7 @@ where -- parseMedia :: Text -> [Media] parseMedia text = case readP_to_S pMediaList (cs (toLower text)) of - (m, ""):_ -> sortWith (negate . mediaQuality) m + (m, ""):_ -> sortOn (negate . mediaQuality) m _else -> [] @@ -163,7 +163,7 @@ where [ ] -> Nothing (l, r):_ -> Just $ l { mediaQuality = mediaQuality r } where - best = sortWith (negate . mediaQuality . snd) good + best = sortOn (negate . mediaQuality . snd) good good = filter (uncurry matchMedia) prod prod = [(l, r) | l <- ls, r <- rs] diff --git a/lib/Hikaru/Route.hs b/lib/Hikaru/Route.hs index 63b4d0c..4a04c41 100644 --- a/lib/Hikaru/Route.hs +++ b/lib/Hikaru/Route.hs @@ -59,10 +59,9 @@ module Hikaru.Route , Route ) where - import Relude hiding (get, put, head) + import Praha - import Data.List (lookup) - import Data.String.Conversions + import Data.List (lookup, map) import Hikaru.Media import Hikaru.Types import Network.HTTP.Types.Header diff --git a/lib/Hikaru/Types.hs b/lib/Hikaru/Types.hs index fbed52f..2952270 100644 --- a/lib/Hikaru/Types.hs +++ b/lib/Hikaru/Types.hs @@ -17,10 +17,9 @@ module Hikaru.Types , defaultHandler ) where - import Relude + import Praha import Data.ByteString (ByteString) - import Data.String.Conversions import Data.Text (pack, unpack) import Network.HTTP.Types.Header import Network.HTTP.Types.Status diff --git a/lib/Hikaru/Widget.hs b/lib/Hikaru/Widget.hs index bd1a456..60906b8 100644 --- a/lib/Hikaru/Widget.hs +++ b/lib/Hikaru/Widget.hs @@ -63,9 +63,9 @@ module Hikaru.Widget , Render(..) ) where - import Relude + import Praha import Data.Text (stripPrefix) - import Data.List (lookup) + import Data.List (lookup, filter) import Lucid import Hikaru.Types import Hikaru.Action diff --git a/test/Hikaru/Demo.hs b/test/Hikaru/Demo.hs index 45df6ee..3ad2023 100644 --- a/test/Hikaru/Demo.hs +++ b/test/Hikaru/Demo.hs @@ -12,15 +12,16 @@ module Hikaru.Demo ( makeDemo ) where - import Relude hiding (for_, Option, get) + import Praha hiding (for_) - import Control.Concurrent.MVar (modifyMVar_) + import UnliftIO.MVar import Data.Aeson (Value) import Hikaru import Lucid import Network.HTTP.Types.Header import Network.HTTP.Types.Status import Network.Wai + import Data.Text (unlines) -- Action ------------------------------------------------------------------ @@ -72,7 +73,7 @@ where countVisitor = do counter <- modelCounter <$> getModelEnv liftIO do - modifyMVar_ counter (return . succ) + modifyMVar_ counter (return . (+ 1)) readMVar counter @@ -150,7 +151,7 @@ where -- Present fancy HTML result. sendHTML do h1_ "Welcome!" - p_ $ "You are " >> toHtml (show n :: Text) >> ". visitor!" + p_ $ "You are " >> toHtml (tshow n) >> ". visitor!" getRootTextR :: Action () @@ -160,7 +161,7 @@ where -- Present a plain textual result. sendText $ unlines [ "Welcome!" - , "You are " <> show n <> ". visitor!" + , "You are " <> tshow n <> ". visitor!" ] @@ -219,11 +220,11 @@ where forM cases \Case{..} -> do tr_ do - td_ $ toHtml $ (show caseId :: Text) + td_ $ toHtml $ tshow caseId td_ $ toHtml $ caseName td_ $ toHtml $ caseRecNo - td_ $ toHtml $ (show caseMode :: Text) - td_ $ toHtml $ (show caseActive :: Text) + td_ $ toHtml $ tshow caseMode + td_ $ toHtml $ tshow caseActive -- Forms ------------------------------------------------------------------- diff --git a/test/Hikaru/DemoSpec.hs b/test/Hikaru/DemoSpec.hs index 6af5b77..981fd06 100644 --- a/test/Hikaru/DemoSpec.hs +++ b/test/Hikaru/DemoSpec.hs @@ -14,7 +14,7 @@ module Hikaru.DemoSpec ( spec ) where - import Relude hiding (get) + import Praha import Hikaru.Demo import Hikaru.Test diff --git a/test/Hikaru/FormSpec.hs b/test/Hikaru/FormSpec.hs index 26ad2ce..72c678a 100644 --- a/test/Hikaru/FormSpec.hs +++ b/test/Hikaru/FormSpec.hs @@ -12,7 +12,7 @@ module Hikaru.FormSpec ( spec ) where - import Relude + import Praha import Hikaru () import Hikaru.Test diff --git a/test/Hikaru/Test.hs b/test/Hikaru/Test.hs index 56cff5f..64b42bb 100644 --- a/test/Hikaru/Test.hs +++ b/test/Hikaru/Test.hs @@ -21,7 +21,7 @@ module Hikaru.Test , module Test.Hspec ) where - import Relude hiding (get) + import Praha import qualified Data.ByteString.Lazy as LBS -- GitLab