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

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