diff --git a/hikaru.cabal b/hikaru.cabal
index 8559e1f7c6924efd3874485589cf9081a03749cf..a306e4f72f8972f54af38e3efd38e8e6424d5cbc 100644
--- a/hikaru.cabal
+++ b/hikaru.cabal
@@ -55,7 +55,7 @@ library
DisambiguateRecordFields NoFieldSelectors OverloadedRecordDot
ghc-options:
- -Wall -Wcompat -Wincomplete-uni-patterns
+ -Wall -Wcompat -Wincomplete-uni-patterns -Wpartial-fields
-Wincomplete-record-updates -Widentities -Wredundant-constraints
-Wunused-packages
@@ -69,6 +69,7 @@ library
containers >=0.6,
cookie >=0.4,
foreign-store >=0.2,
+ HsOpenSSL >=0.11,
http-types >=0.12,
hvect >=0.4,
lucid >=2.9,
@@ -82,8 +83,7 @@ library
wai >=3.2,
wai-extra >=3.0,
wai-websockets >=3.0,
- websockets >=0.12,
- HsOpenSSL >=0.11
+ websockets >=0.12
test-suite spec
type: exitcode-stdio-1.0
@@ -111,7 +111,7 @@ test-suite spec
DisambiguateRecordFields NoFieldSelectors OverloadedRecordDot
ghc-options:
- -Wall -Wcompat -Wincomplete-uni-patterns
+ -Wall -Wcompat -Wincomplete-uni-patterns -Wpartial-fields
-Wincomplete-record-updates -Widentities -Wredundant-constraints
-threaded -rtsopts -with-rtsopts=-N
@@ -125,6 +125,8 @@ test-suite spec
containers >=0.6,
cookie >=0.4,
foreign-store >=0.2,
+ hikaru,
+ hspec,
http-types >=0.12,
hvect >=0.4,
lucid >=2.9,
@@ -138,6 +140,4 @@ test-suite spec
wai >=3.2,
wai-extra >=3.0,
wai-websockets >=3.0,
- websockets >=0.12,
- hikaru,
- hspec
+ websockets >=0.12
diff --git a/lib/Hikaru/CSRF.hs b/lib/Hikaru/CSRF.hs
index 0d1f2eccb43e9966034de75a13faaa2aa86ce87c..d99a1b8fed7ce55962a6ea3e8aaa8223f903fbd5 100644
--- a/lib/Hikaru/CSRF.hs
+++ b/lib/Hikaru/CSRF.hs
@@ -18,17 +18,15 @@ where
import Praha
import Praha.Config.Environment
- import System.IO.Unsafe
+ import Hikaru.Action
+ import Data.Text (splitOn)
+ import Data.Time.Clock.POSIX (getPOSIXTime)
import OpenSSL
- import OpenSSL.Random
import OpenSSL.EVP.Base64
import OpenSSL.EVP.Digest
-
- import Data.Text (splitOn)
- import Data.Time.Clock.POSIX (getPOSIXTime)
-
- import Hikaru.Action
+ import OpenSSL.Random
+ import System.IO.Unsafe
sha256 :: Digest
diff --git a/lib/Hikaru/Dispatch.hs b/lib/Hikaru/Dispatch.hs
index f19237e4d4237795beab2b98a3661e5a38d68549..1052d94175f289ffdf72287b57ff075eb5bf85e7 100644
--- a/lib/Hikaru/Dispatch.hs
+++ b/lib/Hikaru/Dispatch.hs
@@ -34,12 +34,11 @@ where
import Hikaru.Action (abortMiddleware)
import Hikaru.Route
- import Network.HTTP.Types.Status
+ import Data.List (sortOn, reverse, lookup)
import Network.HTTP.Types.Header
+ import Network.HTTP.Types.Status
import Network.Wai
- import Data.List (reverse, lookup, sortOn)
-
-- |
-- Since routes do not share a common type (due to their captured parameters
diff --git a/lib/Hikaru/Link.hs b/lib/Hikaru/Link.hs
index eae4ab15f9ce71737273f849c27e31bb2cc52bec..5de3cb1759041f41504a42b95b47572f35fea345 100644
--- a/lib/Hikaru/Link.hs
+++ b/lib/Hikaru/Link.hs
@@ -24,15 +24,12 @@ where
import Hikaru.Route
import Hikaru.Types
- import Network.HTTP.Types.URI
-
import Data.Binary.Builder
+ import Data.HVect
import Data.List (map, filter)
import Data.Maybe (isJust)
-
- import Data.HVect
-
import Lucid
+ import Network.HTTP.Types.URI
-- |
diff --git a/lib/Hikaru/Media.hs b/lib/Hikaru/Media.hs
index b8d3620cb67b55ba9538186da20b3f5c55613921..63901d3ac1c0186c57352c741ced8dc9f6b89818 100644
--- a/lib/Hikaru/Media.hs
+++ b/lib/Hikaru/Media.hs
@@ -27,10 +27,9 @@ module Hikaru.Media
where
import Praha
- import Data.List (filter, lookup, sortOn)
-
- import Data.Char
import Data.Attoparsec.Text
+ import Data.Char
+ import Data.List (filter, lookup, sortOn)
-- |
diff --git a/lib/Hikaru/Route.hs b/lib/Hikaru/Route.hs
index cfd6b8d6455316a60be079a24b881e2375f61bff..9a74029fb795360d764788eff7cb510c8d873c57 100644
--- a/lib/Hikaru/Route.hs
+++ b/lib/Hikaru/Route.hs
@@ -55,18 +55,17 @@ module Hikaru.Route
)
where
import Praha hiding (curry)
+
import Hikaru.Media
import Hikaru.Types
+ import Data.HVect hiding (reverse)
+ import Data.List (nub, reverse, lookup)
+ import Data.Typeable (TypeRep, typeRep)
import Network.HTTP.Types.Header
import Network.Wai
import Network.Wai.Handler.WebSockets
- import Data.List (reverse, nub, lookup)
- import Data.Typeable (TypeRep, typeRep)
-
- import Data.HVect hiding (reverse)
-
-- |
-- Route combines path description with a handler that gets saturated
diff --git a/lib/Hikaru/Widget.hs b/lib/Hikaru/Widget.hs
index d3ac9d9bd81d3398a39be837f7fa3450ff7494e8..d2b06f88b05b87f87c0bcbcb6f91bea1c68ac308 100644
--- a/lib/Hikaru/Widget.hs
+++ b/lib/Hikaru/Widget.hs
@@ -54,6 +54,7 @@ module Hikaru.Widget
-- * Building Widgets
, WidgetT
+ , getPrefix
, getArguments
, getArgumentMaybe
, getArgumentDefault
@@ -64,11 +65,12 @@ module Hikaru.Widget
)
where
import Praha
- import Data.Text (stripPrefix)
+
import Data.List (lookup, filter)
- import Lucid
- import Hikaru.Types
+ import Data.Text (stripPrefix)
import Hikaru.Action
+ import Hikaru.Types
+ import Lucid
-- |
@@ -161,6 +163,15 @@ where
}
+ -- |
+ -- Obtain widget prefix as text.
+ --
+ getPrefix :: (Monad m) => WidgetT m Text
+ getPrefix = WidgetT do
+ Env{prefix} <- ask
+ return prefix
+
+
-- |
-- Obtain all widget arguments as pieces of text.
--
diff --git a/test/Hikaru/Demo.hs b/test/Hikaru/Demo.hs
index 2def3760b77acc88f1a340c9a80e034923a6ff03..d5c006dbe8e91e3f4f9dd2c5bbd1b8c461ed2c0a 100644
--- a/test/Hikaru/Demo.hs
+++ b/test/Hikaru/Demo.hs
@@ -16,13 +16,12 @@ where
import Hikaru
- import UnliftIO.MVar
import Data.Aeson (Value)
+ import Data.Text (unlines)
import Lucid
import Network.HTTP.Types.Header
import Network.HTTP.Types.Status
- import Network.Wai
- import Data.Text (unlines)
+ import UnliftIO.MVar
-- Action ------------------------------------------------------------------
@@ -39,10 +38,10 @@ where
deriving (Functor, Applicative, Monad, MonadIO)
instance MonadAction Action where
- getActionEnv = Action (demoActionEnv <$> ask)
+ getActionEnv = Action ((.demoActionEnv) <$> ask)
instance MonadModel Action where
- getModelEnv = Action (demoModelEnv <$> ask)
+ getModelEnv = Action ((.demoModelEnv) <$> ask)
data DemoEnv
@@ -74,7 +73,7 @@ where
countVisitor :: (MonadModel m) => m Word
countVisitor = do
- counter <- modelCounter <$> getModelEnv
+ counter <- (.modelCounter) <$> getModelEnv
liftIO do
modifyMVar_ counter (return . (+ 1))
readMVar counter
@@ -82,7 +81,7 @@ where
addCase :: (MonadModel m) => AddCase -> m Case
addCase AddCase{..} = do
- nextId <- liftIO . readMVar . modelCounter =<< getModelEnv
+ nextId <- liftIO . readMVar . (.modelCounter) =<< getModelEnv
let case' = Case { caseId = nextId
, caseName = acName
@@ -91,7 +90,7 @@ where
, caseActive = acActive
}
- cases <- modelCases <$> getModelEnv
+ cases <- (.modelCases) <$> getModelEnv
liftIO do
modifyMVar_ cases (return . (<> [case']))
@@ -110,7 +109,7 @@ where
runAction :: ModelEnv -> Action () -> Application
runAction me act = do
respond \ae -> do
- runReaderT (unAction act) (DemoEnv ae me)
+ runReaderT ((.unAction) act) (DemoEnv ae me)
makeApplication :: ModelEnv -> Application
@@ -215,7 +214,7 @@ where
handle = do
setHeader hCacheControl "no-store"
- cases <- liftIO . readMVar . modelCases =<< getModelEnv
+ cases <- liftIO . readMVar . (.modelCases) =<< getModelEnv
sendHTML do
h1_ "Cases"
@@ -361,18 +360,18 @@ where
(\(x1, x2) x3 x4 -> AddCase x1 x2 x3 x4)
<$> element MsgCaseName do
(,)
- <$> input "name" acName do
+ <$> input "name" (.acName) do
return ()
- <*> input "recno" acRecNo do
+ <*> input "recno" (.acRecNo) do
return ()
<*> element MsgCaseMode do
- select "mode" acMode do
+ select "mode" (.acMode) do
return ()
<*> element MsgCaseEnabled do
- select "active" acActive do
+ select "active" (.acActive) do
hint RenderExpanded