{-# 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 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 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 Ord,String -> Name forall a. (String -> a) -> IsString a fromString :: String -> Name $cfromString :: String -> Name IsString,ReadPrec [Name] ReadPrec Name Int -> ReadS Name ReadS [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 -> String -> String [Name] -> String -> String Name -> String forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [Name] -> String -> String $cshowList :: [Name] -> String -> String show :: Name -> String $cshow :: Name -> String showsPrec :: Int -> Name -> String -> String $cshowsPrec :: Int -> Name -> String -> String Show) name :: String -> E Name name :: String -> E Name name String s = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Char -> Bool is_nm_char String s of Bool True -> forall a b. b -> Either a b Right forall a b. (a -> b) -> a -> b $ String -> Name Name String s Bool False -> forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ String -> Reason 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 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 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 Ord,Int -> Safeguard -> String -> String [Safeguard] -> String -> String Safeguard -> String forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [Safeguard] -> String -> String $cshowList :: [Safeguard] -> String -> String show :: Safeguard -> String $cshow :: Safeguard -> String showsPrec :: Int -> Safeguard -> String -> String $cshowsPrec :: Int -> Safeguard -> String -> String Show) instance IsString Safeguard where fromString :: String -> Safeguard fromString String s = case String -> E Safeguard parseSafeguard String s of Left Reason err -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Ord a => [a] -> Set a Set.fromList safeguardKeys :: Safeguard -> [Name] safeguardKeys :: Safeguard -> [Name] safeguardKeys = forall a. Set a -> [a] Set.elems forall b c a. (b -> c) -> (a -> b) -> a -> c . Safeguard -> Set Name _Safeguard isWildSafeguard :: Safeguard -> Bool isWildSafeguard :: Safeguard -> Bool isWildSafeguard = forall (t :: * -> *) a. Foldable t => t a -> Bool null 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 forall a. Set a -> Bool Set.null Set Name st of Bool True -> String "*" Bool False -> forall a b. (a -> b) -> [a] -> [b] map Char -> Char tr forall a b. (a -> b) -> a -> b $ [String] -> String unwords forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map Name -> String _name forall a b. (a -> b) -> a -> b $ 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 "*" -> forall a b. b -> Either a b Right forall a b. (a -> b) -> a -> b $ [Name] -> Safeguard safeguard [] String _ | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Char -> Bool chk String s -> Safeguard -> E Safeguard chk' forall a b. (a -> b) -> a -> b $ [Name] -> Safeguard safeguard forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map String -> Name Name forall a b. (a -> b) -> a -> b $ String -> [String] words forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map Char -> Char tr String s | Bool otherwise -> forall {b}. Either Reason b oops where chk :: Char -> Bool chk Char c = Char cforall 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 -> forall {b}. Either Reason b oops Bool False -> 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 = forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ String -> Reason 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 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 = forall a. Ord a => [a] -> Set a Set.fromList String ".-_:'=#$%"