{-# 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       }
    deriving (Eq,Ord,IsString,Read,Show)


name :: String -> E Name
name s =
    case all is_nm_char s of
        True  -> Right $ Name s
        False -> Left  $ strMsg "bad name syntax"

_name :: Name -> String
_name = _Name


newtype Safeguard
    = Safeguard { _Safeguard :: Set.Set Name }
    deriving (Eq,Ord,Show)

instance IsString Safeguard where
    fromString s =
        case parseSafeguard s of
          Left err -> X.throw err
          Right sg -> sg

safeguard :: [Name] -> Safeguard
safeguard = Safeguard . Set.fromList

safeguardKeys :: Safeguard -> [Name]
safeguardKeys = Set.elems . _Safeguard

isWildSafeguard :: Safeguard -> Bool
isWildSafeguard = null . safeguardKeys

printSafeguard :: Safeguard -> String
printSafeguard (Safeguard st) =
    case Set.null st of
      True  -> "*"
      False -> map tr $ unwords $ map _name $ Set.elems st
  where
    tr ' ' = ','
    tr c   = c

parseSafeguard :: String -> E Safeguard
parseSafeguard s =
    case s of
      "*"             -> Right $ safeguard []
      _   | all chk s -> chk'  $ safeguard $ map Name $ words $ map tr s
          | otherwise -> oops
  where
    chk  c  = c==',' || is_nm_char c

    chk' sg =
        case isWildSafeguard sg of
          True  -> oops
          False -> Right sg

    tr ','  = ' '
    tr c    = c

    oops    = Left $ strMsg "bad safeguard syntax"

is_nm_char :: Char -> Bool
is_nm_char c = isAscii c || isDigit c || c `Set.member` sg_sym_chs

sg_sym_chs :: Set.Set Char
sg_sym_chs = Set.fromList ".-_:'=#$%"
