add ReferrerView type and some helper functions

src/Guide/Utils.hs

@@ -31,6 +31,9 @@ module Guide.Utils
   makeSlug,
   (//),
 
+  -- * Referrers
+  toReferrerView,
+  
   -- * IP
   sockAddrToIP,
 
@@ -214,6 +217,57 @@ appends backslashes (@\@) and not slashes (@/@).
 (//) :: Url -> Text -> Url
 (//) x y = fromMaybe x (T.stripSuffix "/" x) <> "/" <>
            fromMaybe y (T.stripPrefix "/" y)
+----------------------------------------------------------------------------
+-- ReferrerView
+----------------------------------------------------------------------------
+
+data SearchEngine
+  = Google
+  | Yandex
+  | Yahoo
+  | Bing
+  | Ecosia
+  | DuckDuckGo
+  deriving (Show, Eq)
+
+data ReferrerView
+  = RefSearchEngine SearchEngine (Maybe Text)
+  -- ^ engine + keyword
+  | RefUrl Url
+  -- ^ some url
+  deriving (Eq)
+
+showKeyword :: Maybe Text -> String
+showKeyword (Just keyword) = " (\"" <> T.toString keyword <> "\")"
+showKeyword _ = ""
+
+toSearchEngine :: Text -> Maybe SearchEngine
+toSearchEngine t
+  | "google" `elem` lst = Just Google
+  | "yandex" `elem` lst = Just Yandex
+  | "yahoo"  `elem` lst = Just Yahoo
+  | "bing"   `elem` lst = Just Bing
+  | "ecosia" `elem` lst = Just Ecosia
+  | "duckduckgo" `elem` lst = Just DuckDuckGo
+  | otherwise = Nothing
+  where lst = T.splitOn "." t
+
+instance Show ReferrerView where
+  show (RefSearchEngine searchEngine keyword)
+    = show searchEngine <> showKeyword keyword
+  show (RefUrl url) = T.toString url
+
+-- TODO: getQuery url :: Url -> Maybe Text
+
+toReferrerView :: Url -> ReferrerView
+toReferrerView url
+  = case toSearchEngine domain of
+      Just se -> RefSearchEngine se Nothing -- (getQuery url)
+      Nothing -> RefUrl url
+  where
+    uri = URI.parseURI $ T.toString url
+    uriAuth = fromJust $ uri >>= URI.uriAuthority
+    domain = T.pack $ URI.uriRegName uriAuth
 
 ----------------------------------------------------------------------------
 -- IP

src/Guide/Views.hs

@@ -60,7 +60,6 @@ import qualified Guide.Diff as Diff
 import Guide.Cache
 import Guide.Views.Utils
 
-
 {- Note [autosize]
 ~~~~~~~~~~~~~~~~~~
 
@@ -279,7 +278,7 @@ renderStats globalState acts = do
                      $ rawVisits
       for_ (reverse $ sortWith (fst.snd) visits) $ \(r, (n, u)) -> do
         tr_ $ do
-          td_ (toHtml r)
+          td_ (toHtml $ show (toReferrerView r))
           td_ (toHtml (show n))
           td_ (toHtml (show u))
   table_ $ do