{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} module Data.KeyStore.Types.NameAndSafeguard ( Name , name , _name , Safeguard , safeguard , safeguardKeys , isWildSafeguard , printSafeguard , parseSafeguard ) where import Data.KeyStore.Types.E import Data.Char import qualified Data.Set as Set import Data.String import qualified Control.Exception as X newtype Name = Name { Name -> String _Name :: String } deriving (Name -> Name -> Bool (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Name -> Name -> Bool $c/= :: Name -> Name -> Bool == :: Name -> Name -> Bool $c== :: Name -> Name -> Bool Eq,Eq Name Eq Name -> (Name -> Name -> Ordering) -> (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> (Name -> Name -> Bool) -> (Name -> Name -> Name) -> (Name -> Name -> Name) -> Ord Name Name -> Name -> Bool Name -> Name -> Ordering Name -> Name -> Name forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Name -> Name -> Name $cmin :: Name -> Name -> Name max :: Name -> Name -> Name $cmax :: Name -> Name -> Name >= :: Name -> Name -> Bool $c>= :: Name -> Name -> Bool > :: Name -> Name -> Bool $c> :: Name -> Name -> Bool <= :: Name -> Name -> Bool $c<= :: Name -> Name -> Bool < :: Name -> Name -> Bool $c< :: Name -> Name -> Bool compare :: Name -> Name -> Ordering $ccompare :: Name -> Name -> Ordering $cp1Ord :: Eq Name Ord,String -> Name (String -> Name) -> IsString Name forall a. (String -> a) -> IsString a fromString :: String -> Name $cfromString :: String -> Name IsString,ReadPrec [Name] ReadPrec Name Int -> ReadS Name ReadS [Name] (Int -> ReadS Name) -> ReadS [Name] -> ReadPrec Name -> ReadPrec [Name] -> Read Name forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Name] $creadListPrec :: ReadPrec [Name] readPrec :: ReadPrec Name $creadPrec :: ReadPrec Name readList :: ReadS [Name] $creadList :: ReadS [Name] readsPrec :: Int -> ReadS Name $creadsPrec :: Int -> ReadS Name Read,Int -> Name -> ShowS [Name] -> ShowS Name -> String (Int -> Name -> ShowS) -> (Name -> String) -> ([Name] -> ShowS) -> Show Name forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Name] -> ShowS $cshowList :: [Name] -> ShowS show :: Name -> String $cshow :: Name -> String showsPrec :: Int -> Name -> ShowS $cshowsPrec :: Int -> Name -> ShowS Show) name :: String -> E Name name :: String -> E Name name String s = case (Char -> Bool) -> String -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Char -> Bool is_nm_char String s of Bool True -> Name -> E Name forall a b. b -> Either a b Right (Name -> E Name) -> Name -> E Name forall a b. (a -> b) -> a -> b $ String -> Name Name String s Bool False -> Reason -> E Name forall a b. a -> Either a b Left (Reason -> E Name) -> Reason -> E Name forall a b. (a -> b) -> a -> b $ String -> Reason forall a. Error a => String -> a strMsg String "bad name syntax" _name :: Name -> String _name :: Name -> String _name = Name -> String _Name newtype Safeguard = Safeguard { Safeguard -> Set Name _Safeguard :: Set.Set Name } deriving (Safeguard -> Safeguard -> Bool (Safeguard -> Safeguard -> Bool) -> (Safeguard -> Safeguard -> Bool) -> Eq Safeguard forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Safeguard -> Safeguard -> Bool $c/= :: Safeguard -> Safeguard -> Bool == :: Safeguard -> Safeguard -> Bool $c== :: Safeguard -> Safeguard -> Bool Eq,Eq Safeguard Eq Safeguard -> (Safeguard -> Safeguard -> Ordering) -> (Safeguard -> Safeguard -> Bool) -> (Safeguard -> Safeguard -> Bool) -> (Safeguard -> Safeguard -> Bool) -> (Safeguard -> Safeguard -> Bool) -> (Safeguard -> Safeguard -> Safeguard) -> (Safeguard -> Safeguard -> Safeguard) -> Ord Safeguard Safeguard -> Safeguard -> Bool Safeguard -> Safeguard -> Ordering Safeguard -> Safeguard -> Safeguard forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: Safeguard -> Safeguard -> Safeguard $cmin :: Safeguard -> Safeguard -> Safeguard max :: Safeguard -> Safeguard -> Safeguard $cmax :: Safeguard -> Safeguard -> Safeguard >= :: Safeguard -> Safeguard -> Bool $c>= :: Safeguard -> Safeguard -> Bool > :: Safeguard -> Safeguard -> Bool $c> :: Safeguard -> Safeguard -> Bool <= :: Safeguard -> Safeguard -> Bool $c<= :: Safeguard -> Safeguard -> Bool < :: Safeguard -> Safeguard -> Bool $c< :: Safeguard -> Safeguard -> Bool compare :: Safeguard -> Safeguard -> Ordering $ccompare :: Safeguard -> Safeguard -> Ordering $cp1Ord :: Eq Safeguard Ord,Int -> Safeguard -> ShowS [Safeguard] -> ShowS Safeguard -> String (Int -> Safeguard -> ShowS) -> (Safeguard -> String) -> ([Safeguard] -> ShowS) -> Show Safeguard forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Safeguard] -> ShowS $cshowList :: [Safeguard] -> ShowS show :: Safeguard -> String $cshow :: Safeguard -> String showsPrec :: Int -> Safeguard -> ShowS $cshowsPrec :: Int -> Safeguard -> ShowS Show) instance IsString Safeguard where fromString :: String -> Safeguard fromString String s = case String -> E Safeguard parseSafeguard String s of Left Reason err -> Reason -> Safeguard forall a e. Exception e => e -> a X.throw Reason err Right Safeguard sg -> Safeguard sg safeguard :: [Name] -> Safeguard safeguard :: [Name] -> Safeguard safeguard = Set Name -> Safeguard Safeguard (Set Name -> Safeguard) -> ([Name] -> Set Name) -> [Name] -> Safeguard forall b c a. (b -> c) -> (a -> b) -> a -> c . [Name] -> Set Name forall a. Ord a => [a] -> Set a Set.fromList safeguardKeys :: Safeguard -> [Name] safeguardKeys :: Safeguard -> [Name] safeguardKeys = Set Name -> [Name] forall a. Set a -> [a] Set.elems (Set Name -> [Name]) -> (Safeguard -> Set Name) -> Safeguard -> [Name] forall b c a. (b -> c) -> (a -> b) -> a -> c . Safeguard -> Set Name _Safeguard isWildSafeguard :: Safeguard -> Bool isWildSafeguard :: Safeguard -> Bool isWildSafeguard = [Name] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null ([Name] -> Bool) -> (Safeguard -> [Name]) -> Safeguard -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Safeguard -> [Name] safeguardKeys printSafeguard :: Safeguard -> String printSafeguard :: Safeguard -> String printSafeguard (Safeguard Set Name st) = case Set Name -> Bool forall a. Set a -> Bool Set.null Set Name st of Bool True -> String "*" Bool False -> (Char -> Char) -> ShowS forall a b. (a -> b) -> [a] -> [b] map Char -> Char tr ShowS -> ShowS forall a b. (a -> b) -> a -> b $ [String] -> String unwords ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ (Name -> String) -> [Name] -> [String] forall a b. (a -> b) -> [a] -> [b] map Name -> String _name ([Name] -> [String]) -> [Name] -> [String] forall a b. (a -> b) -> a -> b $ Set Name -> [Name] forall a. Set a -> [a] Set.elems Set Name st where tr :: Char -> Char tr Char ' ' = Char ',' tr Char c = Char c parseSafeguard :: String -> E Safeguard parseSafeguard :: String -> E Safeguard parseSafeguard String s = case String s of String "*" -> Safeguard -> E Safeguard forall a b. b -> Either a b Right (Safeguard -> E Safeguard) -> Safeguard -> E Safeguard forall a b. (a -> b) -> a -> b $ [Name] -> Safeguard safeguard [] String _ | (Char -> Bool) -> String -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Char -> Bool chk String s -> Safeguard -> E Safeguard chk' (Safeguard -> E Safeguard) -> Safeguard -> E Safeguard forall a b. (a -> b) -> a -> b $ [Name] -> Safeguard safeguard ([Name] -> Safeguard) -> [Name] -> Safeguard forall a b. (a -> b) -> a -> b $ (String -> Name) -> [String] -> [Name] forall a b. (a -> b) -> [a] -> [b] map String -> Name Name ([String] -> [Name]) -> [String] -> [Name] forall a b. (a -> b) -> a -> b $ String -> [String] words (String -> [String]) -> String -> [String] forall a b. (a -> b) -> a -> b $ (Char -> Char) -> ShowS forall a b. (a -> b) -> [a] -> [b] map Char -> Char tr String s | Bool otherwise -> E Safeguard forall b. Either Reason b oops where chk :: Char -> Bool chk Char c = Char cChar -> Char -> Bool forall a. Eq a => a -> a -> Bool ==Char ',' Bool -> Bool -> Bool || Char -> Bool is_nm_char Char c chk' :: Safeguard -> E Safeguard chk' Safeguard sg = case Safeguard -> Bool isWildSafeguard Safeguard sg of Bool True -> E Safeguard forall b. Either Reason b oops Bool False -> Safeguard -> E Safeguard forall a b. b -> Either a b Right Safeguard sg tr :: Char -> Char tr Char ',' = Char ' ' tr Char c = Char c oops :: Either Reason b oops = Reason -> Either Reason b forall a b. a -> Either a b Left (Reason -> Either Reason b) -> Reason -> Either Reason b forall a b. (a -> b) -> a -> b $ String -> Reason forall a. Error a => String -> a strMsg String "bad safeguard syntax" is_nm_char :: Char -> Bool is_nm_char :: Char -> Bool is_nm_char Char c = Char -> Bool isAscii Char c Bool -> Bool -> Bool || Char -> Bool isDigit Char c Bool -> Bool -> Bool || Char c Char -> Set Char -> Bool forall a. Ord a => a -> Set a -> Bool `Set.member` Set Char sg_sym_chs sg_sym_chs :: Set.Set Char sg_sym_chs :: Set Char sg_sym_chs = String -> Set Char forall a. Ord a => [a] -> Set a Set.fromList String ".-_:'=#$%"