diff --git a/lib/Hikaru/Action.hs b/lib/Hikaru/Action.hs index 541af39f0db5ca731dccdea315e5cae68561cfc7..14c01b374b04fa7999ed9875f02b0bb222331d0c 100644 --- a/lib/Hikaru/Action.hs +++ b/lib/Hikaru/Action.hs @@ -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. diff --git a/lib/Hikaru/CSRF.hs b/lib/Hikaru/CSRF.hs index 73b195637a5577a5f8b9af07755626d8196b22d2..f44492ac17c0bd2bd1714026f013f4c5931f89f2 100644 --- a/lib/Hikaru/CSRF.hs +++ b/lib/Hikaru/CSRF.hs @@ -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 #-} -- | diff --git a/lib/Hikaru/Form.hs b/lib/Hikaru/Form.hs index b25a558294980ec78341001d120245584c8d7f09..d85a4a4263dea53be52450426eedc6005caab6c3 100644 --- a/lib/Hikaru/Form.hs +++ b/lib/Hikaru/Form.hs @@ -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) diff --git a/lib/Hikaru/Link.hs b/lib/Hikaru/Link.hs index 02864853c75fc9a69eff3ed2fa752667651d4544..503184d0210c1e102ad53da1733b43dea8a176c8 100644 --- a/lib/Hikaru/Link.hs +++ b/lib/Hikaru/Link.hs @@ -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 ----------------------------------------------------------- diff --git a/lib/Hikaru/Localize.hs b/lib/Hikaru/Localize.hs index d87caa4e7169eec9e6998e828afec28fc11a77d9..8b6ba09d21172f2b62dc325c91fb964aeb0a6a0e 100644 --- a/lib/Hikaru/Localize.hs +++ b/lib/Hikaru/Localize.hs @@ -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 #-} -- | diff --git a/lib/Hikaru/Route.hs b/lib/Hikaru/Route.hs index a2c2a5a5efea11d741f9381555ec2e7306c488ec..a2ddc39d1ac680c52e89925a5b42ca4462007ec1 100644 --- a/lib/Hikaru/Route.hs +++ b/lib/Hikaru/Route.hs @@ -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 #-} -- | diff --git a/lib/Hikaru/Types.hs b/lib/Hikaru/Types.hs index ab025cd9a1ec25a4950998d469f683770df9ed9b..dfa9d36b28783cf7ee2533ceb37128218bbb59a9 100644 --- a/lib/Hikaru/Types.hs +++ b/lib/Hikaru/Types.hs @@ -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