Generic search

Proposed.hs

{-# LANGUAGE OverloadedStrings #-}
module Search where

import Data.List
import Data.Ord
import Data.Maybe
import qualified Data.Text as T

data SearchResult a = SearchResult
    { searchRank   :: Double
    , searchResult :: a
    } deriving Show

class Search a where
    -- | Provides a way to add weight to values that have certian
    --   properties, like maybe you want to show more recent items first
    --   even though they don't match the search terms as well
    factor :: a -> Double
    factor _ = 1

    -- | Provide a ranked result given some a, return nothing it's a
    --   decided non-match
    match :: T.Text -> a -> Maybe (SearchResult a)

search :: Search a => T.Text -> [a] -> [SearchResult a]
search t = rankResults . map applyFactor . catMaybes . map (match t)

    where
        applyFactor :: Search a => SearchResult a -> SearchResult a
        applyFactor (SearchResult d v) = SearchResult (d * factor v) v

        rankResults :: [SearchResult a] -> [SearchResult a]
        rankResults = reverse . sortBy (comparing searchRank)

Usage.hs

{-# LANGUAGE OverloadedStrings #-}
---
--- Example usage:
---
import Search
import qualified Data.Text as T

dataBase :: [T.Text]
dataBase = [ "Sam State 123 Main St, Austin TX 02199"
           , "Steve Smith 452 State St, Austin TX 02199"
           , "Jim Austin 582 State Ave, Hallop MO 02349"
           ]

testSearches :: [T.Text]
testSearches = [ "452"
               , "Steve"
               , "State"
               , "State St"
               , "State St, Austin"
               , "Jim Austin"
               , "Main St, Austin TX"
               , "Sam State Main St, Austin"
               ]


instance Search T.Text where
    match t t' = go $ fix t `intersect` fix t'

        where
            -- | More matches means higher ranking
            go :: [T.Text] -> Maybe (SearchResult T.Text)
            go [] = Nothing
            go ms = Just $ SearchResult (fromIntegral $ length ms) t'

            fix :: T.Text -> [T.Text]
            fix = filter (not . T.null)
                . map T.strip
                . T.words
                . T.toCaseFold
                . T.filter (`notElem` ",.-")

main :: IO ()
main = do
    mapM_ search' testSearches

    where
        search' :: T.Text -> IO ()
        search' t = do
            putStrLn $ "\nSearching `" ++ (T.unpack t) ++ "'..."
            mapM_ (putStrLn . show) $ search t dataBase

{- OUTPUT

Searching `452'...
SearchResult {searchRank = 1.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}

Searching `Steve'...
SearchResult {searchRank = 1.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}

Searching `State'...
SearchResult {searchRank = 1.0, searchResult = "Jim Austin 582 State Ave, Hallop MO 02349"}
SearchResult {searchRank = 1.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}
SearchResult {searchRank = 1.0, searchResult = "Sam State 123 Main St, Austin TX 02199"}

Searching `State St'...
SearchResult {searchRank = 2.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}
SearchResult {searchRank = 2.0, searchResult = "Sam State 123 Main St, Austin TX 02199"}
SearchResult {searchRank = 1.0, searchResult = "Jim Austin 582 State Ave, Hallop MO 02349"}

Searching `State St, Austin'...
SearchResult {searchRank = 3.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}
SearchResult {searchRank = 3.0, searchResult = "Sam State 123 Main St, Austin TX 02199"}
SearchResult {searchRank = 2.0, searchResult = "Jim Austin 582 State Ave, Hallop MO 02349"}

Searching `Jim Austin'...
SearchResult {searchRank = 2.0, searchResult = "Jim Austin 582 State Ave, Hallop MO 02349"}
SearchResult {searchRank = 1.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}
SearchResult {searchRank = 1.0, searchResult = "Sam State 123 Main St, Austin TX 02199"}

Searching `Main St, Austin TX'...
SearchResult {searchRank = 4.0, searchResult = "Sam State 123 Main St, Austin TX 02199"}
SearchResult {searchRank = 3.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}
SearchResult {searchRank = 1.0, searchResult = "Jim Austin 582 State Ave, Hallop MO 02349"}

Searching `Sam State Main St, Austin'...
SearchResult {searchRank = 5.0, searchResult = "Sam State 123 Main St, Austin TX 02199"}
SearchResult {searchRank = 3.0, searchResult = "Steve Smith 452 State St, Austin TX 02199"}
SearchResult {searchRank = 2.0, searchResult = "Jim Austin 582 State Ave, Hallop MO 02349"}

-}