{-# 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
".-_:'=#$%"