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 SetObject -> SetObject -> Bool
(SetObject -> SetObject -> Bool)
-> (SetObject -> SetObject -> Bool) -> Eq SetObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetObject -> SetObject -> Bool
$c/= :: SetObject -> SetObject -> Bool
== :: SetObject -> SetObject -> Bool
$c== :: SetObject -> SetObject -> Bool
Eq
instance Control.DeepSeq.NFData SetObject where
rnf :: SetObject -> ()
rnf (SearchDepth SearchDepth
searchDepth) = SearchDepth -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf SearchDepth
searchDepth
instance Show SetObject where
showsPrec :: SearchDepth -> SetObject -> ShowS
showsPrec SearchDepth
_ (SearchDepth SearchDepth
searchDepth) = String -> ShowS
showString String
Input.SearchOptions.searchDepthTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchDepth -> ShowS
forall a. Show a => a -> ShowS
shows SearchDepth
searchDepth
instance Read SetObject where
readsPrec :: SearchDepth -> ReadS SetObject
readsPrec SearchDepth
_ String
s = case ShowS -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first ShowS
Data.List.Extra.lower ((String, String) -> (String, String))
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS String
lex String
s of
[(String
"searchdepth", String
s')] -> (SearchDepth -> SetObject)
-> (SearchDepth, String) -> (SetObject, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first SearchDepth -> SetObject
mkSearchDepth ((SearchDepth, String) -> (SetObject, String))
-> [(SearchDepth, String)] -> [(SetObject, String)]
forall a b. (a -> b) -> [a] -> [b]
`map` ReadS SearchDepth
forall a. Read a => ReadS a
reads String
s'
[(String, String)]
_ -> []
mkSearchDepth :: Input.SearchOptions.SearchDepth -> SetObject
mkSearchDepth :: SearchDepth -> SetObject
mkSearchDepth SearchDepth
searchDepth
| SearchDepth
searchDepth SearchDepth -> SearchDepth -> Bool
forall a. Ord a => a -> a -> Bool
< SearchDepth
Input.SearchOptions.minimumSearchDepth = Exception -> SetObject
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> SetObject)
-> (String -> Exception) -> String -> SetObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkOutOfBounds (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.UI.SetObject.mkSearchDepth:\t" (String -> SetObject) -> String -> SetObject
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
Input.SearchOptions.searchDepthTag String
" must be positive."
| Bool
otherwise = SearchDepth -> SetObject
SearchDepth SearchDepth
searchDepth
autoComplete :: ShowS
autoComplete :: ShowS
autoComplete = (String -> ShowS) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> ShowS
forall a. [a] -> [a] -> [a]
(++) ((String, String) -> String)
-> (String -> (String, String)) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Control.Arrow.first (
\String
word -> case [
String
tag |
String
tag <- [String
Input.SearchOptions.searchDepthTag],
ShowS
Data.List.Extra.lower String
word String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`Data.List.isPrefixOf` ShowS
Data.List.Extra.lower String
tag
] of
[String
tag] -> String
tag
[String]
_ -> String
word
) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
Data.Char.isSpace (String -> (String, String)) -> ShowS -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Data.List.Extra.trimStart