From 26e5248881c216a22cb48ce999964ea07064d428 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jan=20Hamal=20Dvo=C5=99=C3=A1k?= <mordae@anilinux.org>
Date: Sun, 9 Feb 2020 17:24:13 +0100
Subject: [PATCH] Inline a bunch of things
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>
---
 lib/Hikaru/Action.hs   |  1 +
 lib/Hikaru/CSRF.hs     |  2 ++
 lib/Hikaru/Form.hs     | 10 +++++++
 lib/Hikaru/Link.hs     |  3 ++
 lib/Hikaru/Localize.hs |  2 ++
 lib/Hikaru/Route.hs    |  5 ++++
 lib/Hikaru/Types.hs    | 63 ++++++++++++++++++++++++++++++++++++++----
 7 files changed, 80 insertions(+), 6 deletions(-)

diff --git a/lib/Hikaru/Action.hs b/lib/Hikaru/Action.hs
index 541af39..14c01b3 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 73b1956..f44492a 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 b25a558..d85a4a4 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 0286485..503184d 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 d87caa4..8b6ba09 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 a2c2a5a..a2ddc39 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 ab025cd..dfa9d36 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
-- 
GitLab