{-# LANGUAGE CPP #-}
module Text.Format.ArgKey ( ArgKey (..), topKey, popKey ) where
import Control.Arrow
import Data.Char (isDigit)
import qualified Data.List as L
#if MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif
import Text.Format.Error
data ArgKey = Index Int
| Name String
| Nest ArgKey ArgKey
deriving (Eq, Ord)
#if MIN_VERSION_base(4, 11, 0)
instance Semigroup ArgKey where
(<>) = associate
#endif
instance Monoid ArgKey where
mempty = Index (-1)
#if !MIN_VERSION_base(4, 11, 0)
mappend = associate
#endif
instance Read ArgKey where
readsPrec _ "" = [ (mempty, "") ]
readsPrec _ cs = [ parse cs ]
where
parse :: String -> (ArgKey, String)
parse cs =
case break cs of
("", cs1) -> (undefined, cs1)
(_, "!") -> (undefined, "!")
(cs1, "") -> (parse1 cs1, "")
(cs1, cs2) -> first (mappend $ parse1 cs1) (parse cs2)
parse1 :: String -> ArgKey
parse1 cs = if all isDigit cs then Index (read cs) else Name cs
break :: String -> (String, String)
break cs =
case L.break (== '!') cs of
(cs1, "") -> (cs1, "")
(cs1, "!") -> (cs1, "!")
(cs1, '!' : '!' : cs2) -> first ((cs1 ++ "!") ++) (break cs2)
(cs1, '!' : cs2) -> (cs1, cs2)
instance Show ArgKey where
show k@(Index i) = if mempty == k then "" else show i
show (Name s) = escape s
where
escape :: String -> String
escape "" = ""
escape ('!' : cs) = "!!" ++ escape cs
escape (c : cs) = (c : escape cs)
show (Nest k1 k2) = show k1 ++ "!" ++ show k2
associate :: ArgKey -> ArgKey -> ArgKey
associate k (Index (-1)) = k
associate (Index (-1)) k = k
associate (Nest k11 k12) k2 = associate k11 $ associate k12 k2
associate k1 k2 = Nest k1 k2
topKey :: ArgKey -> ArgKey
topKey (Nest k@(Nest _ _) _) = topKey k
topKey (Nest k _) = k
topKey k = if k == mempty then vferror "empty arg key"
else k
popKey :: ArgKey -> ArgKey
popKey (Nest k1@(Nest _ _) k2) = mappend (popKey k1) k2
popKey (Nest _ k) = k
popKey k = if k == mempty then vferror "empty arg key"
else mempty