Monad.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.FuzzySet.Monad
  ( add
  , add_
  , findMin
  , values
  , addMany
  , addMany_
  , find
  , findOne
  , findOneMin
  , closestMatch
  , closestMatchMin
  , size
  , isEmpty
  , FuzzySearchT (..)
  , FuzzySearch
  , runFuzzySearchT
  , runDefaultFuzzySearchT
  , runFuzzySearch
  , runDefaultFuzzySearch
  , MonadFuzzySearch
  ) where

import Control.Monad (void)
import Control.Monad.Except (ExceptT)
import Control.Monad.Fix
import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT)
import Control.Monad.State (MonadState, StateT, evalStateT, gets)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Trans.Select (SelectT)
import Control.Monad.Writer (WriterT)
import Data.FuzzySet.Simple (FuzzySet, FuzzyMatch, emptySet)
import qualified Data.FuzzySet.Simple as Simple
import qualified Data.FuzzySet.Internal as FuzzySet
import Data.FuzzySet.Utils ((<$$$>), (<$$>))
import Data.Text (Text)

-- | FuzzySearch monad transformer
newtype FuzzySearchT m a = FuzzySearchT { getFuzzySearchT :: StateT FuzzySet m a }
  deriving
    ( Functor
    , Applicative
    , Monad
    , MonadState FuzzySet
    , MonadIO
    , MonadFix
    )

-- | Evaluate a `FuzzySearchT` computation with the given options.
runFuzzySearchT :: (Monad m)
  => FuzzySearchT m a
  -> Int
  -- ^ Lower bound on gram sizes to use (inclusive)
  -> Int
  -- ^ Upper bound on gram sizes to use (inclusive)
  -> Bool
  -- ^ Whether or not to use the Levenshtein distance to determine the score
  -> m a
  -- ^ The result of running the computation in the inner monad
runFuzzySearchT value = evalStateT ( getFuzzySearchT value ) <$$$> emptySet

-- | Evaluate a `FuzzySearchT` computation with the following defaults:
--
--   * Gram size lower: @2@
--   * Gram size upper: @3@
--   * Use Levenshtein distance: @True@
runDefaultFuzzySearchT :: (Monad m) => FuzzySearchT m a -> m a
runDefaultFuzzySearchT value = runFuzzySearchT value 2 3 True

-- | FuzzySearch monad
type FuzzySearch = FuzzySearchT Identity

-- | Evaluate a `FuzzySearch` computation with the given options.
runFuzzySearch
  :: FuzzySearch a
  -> Int
  -- ^ Lower bound on gram sizes to use (inclusive)
  -> Int
  -- ^ Upper bound on gram sizes to use (inclusive)
  -> Bool
  -- ^ Whether or not to use the Levenshtein distance to determine the score
  -> a
  -- ^ The result of running the computation
runFuzzySearch value = runIdentity <$$$> runFuzzySearchT value

-- | Evaluate a `FuzzySearch` computation with the following defaults:
--
--   * Gram size lower: @2@
--   * Gram size upper: @3@
--   * Use Levenshtein distance: @True@
runDefaultFuzzySearch :: FuzzySearch a -> a
runDefaultFuzzySearch value = runFuzzySearch value 2 3 True

class (MonadState FuzzySet m) => MonadFuzzySearch m where
  -- | Add a string to the set. A boolean is returned which is @True@ if the
  --   string was inserted, or @False@ if it already existed in the set.
  add     :: Text
          -- ^ The new entry
          -> m Bool
          -- ^ A flag to indicate whether the value was added (i.e., did not
          --   already exist in the set)
  -- | Try to match a string against the entries in the set, and return a list
  --   of all results with a score greater than or equal to the specified
  --   minimum score (i.e., the first argument). The results are ordered by
  --   similarity, with the closest match first.
  findMin :: Double
          -- ^ A minimum score
          -> Text
          -- ^ The string to search for
          -> m [FuzzyMatch]
          -- ^ A list of results (score and matched value)

instance MonadTrans FuzzySearchT where
  lift = FuzzySearchT . lift

instance (Monad m) => MonadFuzzySearch (FuzzySearchT m) where
  add     = FuzzySet.add_
  findMin = gets <$$> Simple.findMin

instance (MonadFuzzySearch m) => MonadFuzzySearch (StateT FuzzySet m) where
  add     = lift . add
  findMin = lift <$$> findMin

instance (MonadFuzzySearch m) => MonadFuzzySearch (ExceptT e m) where
  add     = lift . add
  findMin = lift <$$> findMin

instance (MonadFuzzySearch m) => MonadFuzzySearch (ReaderT r m) where
  add     = lift . add
  findMin = lift <$$> findMin

instance (MonadFuzzySearch m, Monoid w) => MonadFuzzySearch (WriterT w m) where
  add     = lift . add
  findMin = lift <$$> findMin

instance (MonadFuzzySearch m) => MonadFuzzySearch (MaybeT m) where
  add     = lift . add
  findMin = lift <$$> findMin

instance (MonadFuzzySearch m) => MonadFuzzySearch (ContT r m) where
  add     = lift . add
  findMin = lift <$$> findMin

instance (MonadFuzzySearch m, MonadState FuzzySet (SelectT s m)) => MonadFuzzySearch (SelectT s m) where
  add     = lift . add
  findMin = lift <$$> findMin

-- | Add a string to the set, or do nothing if a key that matches the string
--   already exists.
--
-- This function is identical to 'add', except that the latter returns a
-- boolean to indicate whether any new value was added.
add_ :: (MonadFuzzySearch m) => Text -> m ()
add_ = void . add

-- | Add a list of strings to the set, all at once.
--
-- Unless you need to know the subset of values that were actually inserted,
-- use 'addMany_' instead.
addMany :: (MonadFuzzySearch m)
  => [Text]
  -- ^ A list of strings to add to the set
  -> m [Text]
  -- ^ A list of values that were inserted
addMany = FuzzySet.addMany_

-- | Add a list of strings to the set, all at once.
--
-- This function is identical to 'addMany', except that the latter returns a
-- list of all values that were inserted.
addMany_ :: (MonadFuzzySearch m)
  => [Text]
  -- ^ A list of strings to add to the set
  -> m ()
addMany_ = void . addMany

-- | Try to match the given string against the entries in the set, using a
--   minimum score of 0.33. Return a list of results ordered by similarity
--   score, with the closest match first. Use 'findMin' if you need to specify
--   a custom threshold value.
find :: (MonadFuzzySearch m)
  => Text
  -- ^ The string to search for
  -> m [FuzzyMatch]
  -- ^ A list of results (score and matched value)
find str = gets (Simple.find str)

-- | Try to match the given string against the entries in the set using the
--   specified minimum score and return the closest match, if one is found.
findOneMin :: (MonadFuzzySearch m)
  => Double
  -- ^ A minimum score
  -> Text
  -- ^ The string to search for
  -> m (Maybe FuzzyMatch)
  -- ^ The closest match, if one is found
findOneMin minScore str = gets (Simple.findOneMin minScore str)

-- | Try to match the given string against the entries in the set, and return
--   the closest match, if one is found. A minimum score of 0.33 is used. To
--   specify a custom threshold value, instead use 'findOneMin'.
findOne :: (MonadFuzzySearch m)
  => Text
  -- ^ The string to search for
  -> m (Maybe FuzzyMatch)
  -- ^ The closest match, if one is found
findOne str = gets (Simple.findOne str)

-- | Try to match the given string against the entries in the set using the
--   specified minimum score and return the string that most closely matches
--   the input, if a match is found.
closestMatchMin :: (MonadFuzzySearch m)
  => Double
  -- ^ A minimum score
  -> Text
  -- ^ The string to search for
  -> m (Maybe Text)
  -- ^ The string most closely matching the input, if a match is found
closestMatchMin minScore str = gets (Simple.closestMatchMin minScore str)

-- | Try to match the given string against the entries in the set, and return
--   the string that most closely matches the input, if a match is found. A
--   minimum score of 0.33 is used. To specify a custom threshold value,
--   instead use 'closestMatchMin'.
closestMatch :: (MonadFuzzySearch m)
  => Text
  -- ^ The string to search for
  -> m (Maybe Text)
  -- ^ The string most closely matching the input, if a match is found
closestMatch str = gets (Simple.closestMatch str)

-- | Return the elements of the set. No particular order is guaranteed.
values :: (MonadFuzzySearch m) => m [Text]
values = gets Simple.values

-- | Return the number of entries in the set.
size :: (MonadFuzzySearch m) => m Int
size = length <$> values

-- | Return a boolean indicating whether the set is empty.
isEmpty :: (MonadFuzzySearch m) => m Bool
isEmpty = null <$> values