{-# LANGUAGE OverloadedStrings #-}

module Main where

import Criterion.Main (bench, bgroup, defaultMain, whnf)
import Data.Char (ord)
import Data.Maybe (maybeToList)
import Data.Text (Text)

import qualified Data.Text as Text
import qualified Data.Vector as Vector
import qualified Unicode.Char.General.Names as UnicodeNames

main = defaultMain
  [ bench "naiveSearchCI" $ whnf naiveSearchCI "latin"
  , bench "naiveSearchCS" $ whnf naiveSearchCS "LATIN"
  , bench "memoSearchCI" $ whnf memoSearchCI "latin"
  , bench "memoSearchCS" $ whnf memoSearchCS "LATIN"
  ]

naiveSearchCI :: Text -> [Char]
naiveSearchCI search =
  filter go [minBound..maxBound]
  where
    go c = any matches $ allNames c
    matches t = Text.toLower search `Text.isInfixOf` Text.toLower (Text.pack t)

naiveSearchCS :: Text -> [Char]
naiveSearchCS search =
  filter go [minBound..maxBound]
  where
    go c = any matches $ allNames c
    matches t = search `Text.isInfixOf` Text.pack t

memoSearchCS :: Text -> [Char]
memoSearchCS search =
  filter go [minBound..maxBound]
  where
    go c = any matches $ allNamesText c
    matches t = search `Text.isInfixOf` t

memoSearchCI :: Text -> [Char]
memoSearchCI search =
  filter go [minBound..maxBound]
  where
    go c = any matches $ allNamesTextLower c
    matches t = Text.toLower search `Text.isInfixOf` t

-- | Retrieve name and aliases (suffixed with @*@) of a 'Char'.
allNames :: Char -> [String]
allNames c =
  maybeToList (UnicodeNames.name c)
  ++ map (++ "*") (UnicodeNames.nameAliases c)

allNamesText :: Char -> [Text]
allNamesText c = Vector.unsafeIndex textNames $ ord c

textNames :: Vector.Vector [Text]
textNames = Vector.fromList $ map go [minBound..maxBound]
  where
    go c = map Text.pack $ allNames c

allNamesTextLower :: Char -> [Text]
allNamesTextLower c = Vector.unsafeIndex textNamesLower $ ord c

textNamesLower :: Vector.Vector [Text]
textNamesLower = Vector.fromList $ map go [minBound..maxBound]
  where
    go c = map (Text.toLower . Text.pack) $ allNames c