Skip to content
Snippets Groups Projects
Verified Commit 26e52488 authored by jan.hamal.dvorak's avatar jan.hamal.dvorak
Browse files

Inline a bunch of things 


Signed-off-by: default avatarJan Hamal Dvořák <mordae@anilinux.org>
parent 2efaf214
No related branches found
No related tags found
No related merge requests found
Show whitespace changes
Inline Side-by-side
lib/Hikaru/Action.hs
+ 1
− 0
View file @ 26e52488
......@@ -140,6 +140,7 @@ where
default getActionEnv
:: (MonadTrans t, MonadAction n, m ~ t n) => m ActionEnv
getActionEnv = lift getActionEnv
{-# INLINE getActionEnv #-}
-- |
-- Allow access to action when building HTML responses.
......
lib/Hikaru/CSRF.hs
+ 2
− 0
View file @ 26e52488
......@@ -34,10 +34,12 @@ where
default csrfTokenValidity
:: (MonadTrans t, MonadCsrf n, m ~ t n) => m Int64
csrfTokenValidity = lift csrfTokenValidity
{-# INLINE csrfTokenValidity #-}
default csrfTokenSecret
:: (MonadTrans t, MonadCsrf n, m ~ t n) => m Text
csrfTokenSecret = lift csrfTokenSecret
{-# INLINE csrfTokenSecret #-}
-- |
......
lib/Hikaru/Form.hs
+ 10
− 0
View file @ 26e52488
......@@ -106,8 +106,11 @@ where
v1 <> v2 = FormFields ([v1, v2]) []
{-# INLINE (<>) #-}
instance Monoid (View l) where
mempty = FormFields [] []
{-# INLINE mempty #-}
-- |
......@@ -132,9 +135,11 @@ where
instance Semigroup NoteLevel where
(<>) = min
{-# INLINE (<>) #-}
instance Monoid NoteLevel where
mempty = NoteSuccess
{-# INLINE mempty #-}
newtype FormT l m a
......@@ -148,6 +153,7 @@ where
instance MonadTrans (FormT l) where
lift = FormT . lift . lift
{-# INLINE lift #-}
instance (MonadCsrf m) => MonadCsrf (FormT l m)
......@@ -161,14 +167,17 @@ where
fmap f Form{..} = Form do
x <- unForm
return $ fmap f x
{-# INLINE fmap #-}
instance (Monad m) => Applicative (Form l m) where
pure x = Form $ return $ Just x
{-# INLINE pure #-}
Form{unForm = unFormL} <*> Form{unForm = unFormR} = Form do
l <- unFormL
r <- unFormR
return $ l <*> r
{-# INLINE (<*>) #-}
data Env l
......@@ -188,6 +197,7 @@ where
instance MonadTrans (FieldT l a) where
lift = FieldT . lift . lift
{-# INLINE lift #-}
instance (MonadCsrf m) => MonadCsrf (FieldT l a m)
......
lib/Hikaru/Link.hs
+ 3
− 0
View file @ 26e52488
......@@ -85,6 +85,7 @@ where
--
lhref_ :: [Text] -> [(Text, Text)] -> Attribute
lhref_ ps qs = href_ (makeLink ps qs)
{-# INLINE lhref_ #-}
-- |
......@@ -92,6 +93,7 @@ where
--
phref_ :: [Text] -> Attribute
phref_ ps = href_ (makeLink ps [])
{-# INLINE phref_ #-}
-- |
......@@ -99,6 +101,7 @@ where
--
qhref_ :: [(Text, Text)] -> Attribute
qhref_ qs = href_ (makeLink [] qs)
{-# INLINE qhref_ #-}
-- Path Feedback -----------------------------------------------------------
......
lib/Hikaru/Localize.hs
+ 2
− 0
View file @ 26e52488
......@@ -91,6 +91,7 @@ where
--
localize :: (Monad m) => Locale -> a -> Maybe (HtmlT m ())
localize _lc = const Nothing
{-# INLINE localize #-}
-- |
......@@ -99,6 +100,7 @@ where
--
instance Localized Text where
localize _lc = Just . toHtml
{-# INLINE localize #-}
-- |
......
lib/Hikaru/Route.hs
+ 5
− 0
View file @ 26e52488
......@@ -81,15 +81,18 @@ where
instance Functor Route where
fmap f r = Route \env -> fmap (fmap f) (runRoute r env)
{-# INLINE fmap #-}
instance Applicative Route where
pure x = Route \env -> (env, Just x)
{-# INLINE pure #-}
(<*>) rf rx = Route \env ->
case runRoute rf env of
(env', Just f) -> runRoute (fmap f rx) env'
(env', Nothing) -> case runRoute rx env' of
(env'', _) -> (env'', Nothing)
{-# INLINE (<*>) #-}
-- |
......@@ -130,12 +133,14 @@ where
instance Semigroup Score where
(Suitable x) <> (Suitable y) = Suitable (x * y)
x <> y = max x y
{-# INLINE (<>) #-}
-- |
-- Results form a monoid with 'Suitable' as the neutral element.
--
instance Monoid Score where
mempty = Suitable 1.0
{-# INLINE mempty #-}
-- |
......
lib/Hikaru/Types.hs
+ 57
− 6
View file @ 26e52488
......@@ -27,6 +27,8 @@ where
import Network.Wai
import qualified Data.ByteString.Lazy
import qualified Data.Text.Encoding
import qualified Data.Text.Encoding.Error
import qualified Data.Text.Lazy
......@@ -40,48 +42,63 @@ where
instance FromParam Int where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Int8 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Int16 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Int32 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Int64 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Word where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Word8 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Word16 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Word32 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Word64 where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Integer where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Natural where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Float where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam Double where
fromParam = readMaybe . unpack
{-# INLINE fromParam #-}
instance FromParam () where
fromParam _ = Just ()
{-# INLINE fromParam #-}
instance FromParam Bool where
fromParam "true" = Just True
......@@ -89,26 +106,34 @@ where
fromParam "false" = Just False
fromParam "False" = Just False
fromParam _else = Nothing
{-# INLINE fromParam #-}
instance FromParam Char where
fromParam inp = case (unpack inp) of
[x] -> Just x
_else -> Nothing
{-# INLINE fromParam #-}
instance FromParam String where
fromParam = Just . unpack
{-# INLINE fromParam #-}
instance FromParam Text where
fromParam = Just . id
{-# INLINE fromParam #-}
instance FromParam Data.Text.Lazy.Text where
fromParam = Just . cs
fromParam = Just . Data.Text.Lazy.fromStrict
{-# INLINE fromParam #-}
instance FromParam Data.ByteString.ByteString where
fromParam = Just . cs
fromParam = Just . Data.Text.Encoding.encodeUtf8
{-# INLINE fromParam #-}
instance FromParam Data.ByteString.Lazy.ByteString where
fromParam = Just . cs
fromParam = Just . Data.ByteString.Lazy.fromStrict
. Data.Text.Encoding.encodeUtf8
{-# INLINE fromParam #-}
-- |
......@@ -121,70 +146,95 @@ where
instance ToParam Int where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Int8 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Int16 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Int32 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Int64 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Word where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Word8 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Word16 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Word32 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Word64 where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Integer where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Natural where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Float where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam Double where
toParam = pack . show
{-# INLINE toParam #-}
instance ToParam () where
toParam _ = ""
{-# INLINE toParam #-}
instance ToParam Bool where
toParam True = "true"
toParam False = "false"
{-# INLINE toParam #-}
instance ToParam Char where
toParam char = pack [char]
{-# INLINE toParam #-}
instance ToParam String where
toParam = pack
{-# INLINE toParam #-}
instance ToParam Text where
toParam = id
{-# INLINE toParam #-}
instance ToParam Data.Text.Lazy.Text where
toParam = cs
toParam = Data.Text.Lazy.toStrict
{-# INLINE toParam #-}
instance ToParam Data.ByteString.ByteString where
toParam = cs
toParam = Data.Text.Encoding.decodeUtf8With
Data.Text.Encoding.Error.lenientDecode
{-# INLINE toParam #-}
instance ToParam Data.ByteString.Lazy.ByteString where
toParam = cs
toParam = Data.Text.Encoding.decodeUtf8With
Data.Text.Encoding.Error.lenientDecode
. Data.ByteString.Lazy.toStrict
{-# INLINE toParam #-}
-- |
......@@ -245,6 +295,7 @@ where
--
instance Semigroup RequestError where
(<>) = min
{-# INLINE (<>) #-}
-- |
-- Request errors can be thrown and catched, when accompanied with
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment

Pirátský GitLab - Home of the CopyLeft