Implement search

app/Main.hs

@@ -66,13 +66,14 @@ type API =
   :<|> "utf8" :> Capture "bytes" Text :> Get '[PlainText, HTML] Utf8Model
   :<|> "codepoints" :> Capture "codepoints" Text :> Get '[PlainText, HTML] CodepointsModel
   :<|> "text" :> Capture "text" Text :> Get '[PlainText, HTML] TextModel
+  :<|> "search" :> Capture "search" Text :> Get '[PlainText, HTML] SearchModel
 
 server :: Server API
 server =
-  rootR :<|> utf8R :<|> codepointsR :<|> textR
+  rootR :<|> utf8R :<|> codepointsR :<|> textR :<|> searchR
   where
-    rootR host = do
+    rootR host' = do
-      pure $ RootModel $ fromMaybe "" host
+      pure $ RootModel $ fromMaybe "" host'
 
     utf8R bytesP = do
       bytes <- Parsers.parseHexBytes bytesP `orThrow` const err400
@@ -85,6 +86,9 @@ server =
     textR textP = do
       pure $ TextModel textP
 
+    searchR searchP = do
+      pure $ mkSearchModel searchP
+
 -- /
 
 newtype RootModel = RootModel
@@ -224,28 +228,53 @@ newtype TextModel = TextModel
   }
 
 instance MimeRender HTML TextModel where
-  mimeRender _ model = renderHtml $ documentWithBody $ do
+  mimeRender _ model = charTableHtml $ Text.unpack model.text
-    H.table $ for_ (Text.unpack model.text) $ \c -> do
+instance MimeRender PlainText TextModel where
+  mimeRender _ model = charTableText $ Text.unpack model.text
+
+-- /search/<search>
+
+newtype SearchModel = SearchModel
+  { results :: [Char]
+  }
+
+mkSearchModel :: Text -> SearchModel
+mkSearchModel search = SearchModel $ searchAllChars search
+
+searchAllChars :: Text -> [Char]
+searchAllChars search = [c | c <- [minBound..maxBound], any (\name -> Text.toLower search `Text.isInfixOf` Text.toLower (Text.pack name)) (allNames c)]
+
+instance MimeRender HTML SearchModel where
+  mimeRender _ model = charTableHtml model.results
+
+instance MimeRender PlainText SearchModel where
+  mimeRender _ model = charTableText model.results
+
+-- Utilities
+
+charTableHtml :: [Char] -> BL.ByteString
+charTableHtml chars =
+  renderHtml $ documentWithBody $ do
+    H.table $ for_ chars $ \c -> do
       H.tr $ do
         H.td $ H.input ! A.class_ "charbox" ! A.value (H.toValue [c])
         H.td $ H.code $ printfHtml "U+%04X" c
         H.td $ H.code $ H.toHtml $ intercalate ", " $ allNames c
         H.td $ H.code $ H.toHtml $ fromMaybe "" $ blockName c
 
-instance MimeRender PlainText TextModel where
+
-  mimeRender _ model = renderText $ Table.render "  "
+charTableText :: [Char] -> BL.ByteString
+charTableText chars =
+  renderText $ Table.render "  "
     [ map Table.cl
       [ Text.pack [c]
       , Text.pack $ printf "U+%04X" c
       , Text.pack $ intercalate ", " $ allNames c
       , Text.pack $ fromMaybe "" $ blockName c
       ]
-    | c <- Text.unpack model.text
+    | c <- chars
     ]
 
-
--- Utilities
-
 renderText :: Text -> BL.ByteString
 renderText = BL.fromStrict . Encoding.encodeUtf8