-- | A set of strings to match.
module Graphics.Text.Font.Choose.StrSet(StrSet(..), module S, validStrSet) where

import Data.Set (Set)
import qualified Data.Set as S

import Data.MessagePack (MessagePack(..))
import Test.QuickCheck (Arbitrary(..))

-- | A set of strings to match.
newtype StrSet = StrSet { StrSet -> Set String
unStrSet :: Set String } deriving (StrSet -> StrSet -> Bool
(StrSet -> StrSet -> Bool)
-> (StrSet -> StrSet -> Bool) -> Eq StrSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrSet -> StrSet -> Bool
== :: StrSet -> StrSet -> Bool
$c/= :: StrSet -> StrSet -> Bool
/= :: StrSet -> StrSet -> Bool
Eq, Int -> StrSet -> ShowS
[StrSet] -> ShowS
StrSet -> String
(Int -> StrSet -> ShowS)
-> (StrSet -> String) -> ([StrSet] -> ShowS) -> Show StrSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrSet -> ShowS
showsPrec :: Int -> StrSet -> ShowS
$cshow :: StrSet -> String
show :: StrSet -> String
$cshowList :: [StrSet] -> ShowS
showList :: [StrSet] -> ShowS
Show, ReadPrec [StrSet]
ReadPrec StrSet
Int -> ReadS StrSet
ReadS [StrSet]
(Int -> ReadS StrSet)
-> ReadS [StrSet]
-> ReadPrec StrSet
-> ReadPrec [StrSet]
-> Read StrSet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StrSet
readsPrec :: Int -> ReadS StrSet
$creadList :: ReadS [StrSet]
readList :: ReadS [StrSet]
$creadPrec :: ReadPrec StrSet
readPrec :: ReadPrec StrSet
$creadListPrec :: ReadPrec [StrSet]
readListPrec :: ReadPrec [StrSet]
Read)

instance MessagePack StrSet where
    toObject :: StrSet -> Object
toObject = [String] -> Object
forall a. MessagePack a => a -> Object
toObject ([String] -> Object) -> (StrSet -> [String]) -> StrSet -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String -> [String]
forall a. Set a -> [a]
S.toList (Set String -> [String])
-> (StrSet -> Set String) -> StrSet -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrSet -> Set String
unStrSet
    fromObject :: Object -> Maybe StrSet
fromObject Object
msg = Set String -> StrSet
StrSet (Set String -> StrSet)
-> ([String] -> Set String) -> [String] -> StrSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> StrSet) -> Maybe [String] -> Maybe StrSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Maybe [String]
forall a. MessagePack a => Object -> Maybe a
fromObject Object
msg
instance Arbitrary StrSet where
    arbitrary :: Gen StrSet
arbitrary = Set String -> StrSet
StrSet (Set String -> StrSet)
-> (Set String -> Set String) -> Set String -> StrSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShowS -> Set String -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\0')) (Set String -> StrSet) -> Gen (Set String) -> Gen StrSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set String)
forall a. Arbitrary a => Gen a
arbitrary

-- | Whether the StrSet can be processed by FontConfig.
validStrSet :: StrSet -> Bool
validStrSet :: StrSet -> Bool
validStrSet (StrSet Set String
self) = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
'\0' (String -> Bool) -> Set String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`all` Set String
self