{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Salak.Internal.Key(
Key(..)
, Keys(..)
, simpleKeys
, ToKeys(..)
, isNum
) where
import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import Data.Coerce (coerce)
import Data.Hashable
import Data.List (intercalate)
import Data.Text (Text)
import qualified Data.Text as T
data Key
= KT !Text
| KI !Int
deriving Eq
instance Ord Key where
compare (KT a) (KT b) = compare a b
compare (KI a) (KI b) = compare a b
compare (KI _) _ = LT
compare _ _ = GT
newtype Keys = Keys { unKeys :: [Key] } deriving Eq
instance Show Keys where
show ks = toKey (coerce ks)
where
toKey = intercalate "." . go
go (a@(KT _):cs) = let (b,c) = break isStr cs in (show a ++ concat (show <$> b)) : go c
go (a:cs) = show a : go cs
go [] = []
isStr :: Key -> Bool
isStr (KT _) = True
isStr _ = False
isNum :: Key -> Bool
isNum (KI _) = True
isNum _ = False
instance Hashable Key where
hash (KT a) = hash a
hash (KI a) = hash a
hashWithSalt i (KT a) = hashWithSalt i a
hashWithSalt i (KI a) = hashWithSalt i a
instance Show Key where
show (KT x) = T.unpack x
show (KI i) = "[" ++ show i ++ "]"
simpleKeys :: Text -> [Key]
simpleKeys as = fmap KT $ filter (not.T.null) $ T.splitOn "." as
exprs :: Parser [Key]
exprs = concat <$> ( (expr <|> return []) `sepBy` char '.')
sName :: Parser Key
sName = KT . T.pack <$> do
a <- choice [letter, digit]
b <- many' (choice [letter, digit, char '-', char '_'])
return (a:b)
sNum :: Parser Key
sNum = KI <$> paren decimal
where
paren e = do
_ <- char '['
ex <- e
_ <- char ']'
return ex
expr :: Parser [Key]
expr = (:) <$> sName <*> many' sNum
class ToKeys a where
toKeys :: a -> Either String Keys
instance ToKeys Keys where
toKeys = Right
instance ToKeys Text where
toKeys = fmap Keys . selectors
where
selectors = go . parse exprs . flip T.snoc '\n'
go (Done i r) = if i /= "\n" then Left $ "uncomplete parse" ++ T.unpack i else Right r
go a = Left (show a)
instance ToKeys String where
toKeys = toKeys . T.pack