module BishBosh.UI.SetObject (
SetObject(..),
autoComplete,
mkSearchDepth
) where
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Input.SearchOptions as Input.SearchOptions
import qualified Control.Arrow
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Char
import qualified Data.List
import qualified Data.List.Extra
newtype SetObject = SearchDepth Input.SearchOptions.SearchDepth deriving Eq
instance Control.DeepSeq.NFData SetObject where
rnf (SearchDepth searchDepth) = Control.DeepSeq.rnf searchDepth
instance Show SetObject where
showsPrec _ (SearchDepth searchDepth) = showString Input.SearchOptions.searchDepthTag . showChar ' ' . shows searchDepth
instance Read SetObject where
readsPrec _ s = case Control.Arrow.first Data.List.Extra.lower `map` lex s of
[("searchdepth", s')] -> Control.Arrow.first mkSearchDepth `map` reads s'
_ -> []
mkSearchDepth :: Input.SearchOptions.SearchDepth -> SetObject
mkSearchDepth searchDepth
| searchDepth < Input.SearchOptions.minimumSearchDepth = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.UI.SetObject.mkSearchDepth:\t" $ shows Input.SearchOptions.searchDepthTag " must be positive."
| otherwise = SearchDepth searchDepth
autoComplete :: ShowS
autoComplete = uncurry (++) . Control.Arrow.first (
\word -> case [
tag |
tag <- [Input.SearchOptions.searchDepthTag],
Data.List.Extra.lower word `Data.List.isPrefixOf` Data.List.Extra.lower tag
] of
[tag] -> tag
_ -> word
) . break Data.Char.isSpace . Data.List.Extra.trimStart