module Data.Yaml.YamlLight.Lens (
nth, key, key',
_Yaml, AsYaml(..),
yamlInt, yamlReal) where
import Control.Applicative
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.ByteString.Lex.Integral
import Data.ByteString.Lex.Double
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Traversable (sequenceA)
import Data.Yaml.YamlLight
data YamlIx = ArrIx Int | ObjIx YamlLight
type instance Index YamlLight = YamlIx
type instance IxValue YamlLight = YamlLight
instance Ixed YamlLight where
ix k@(ArrIx i) f (YSeq xs) | i < 0 = pure (YSeq xs)
| otherwise = YSeq <$> go xs i where
go [] _ = pure []
go (y:ys) 0 = (:ys) <$> indexed f k y
go (y:ys) i' = (y:) <$> (go ys $! i' 1)
ix k@(ObjIx k') f (YMap m) = case Map.lookup k' m of
Just v -> YMap . flip (Map.insert k') m <$> indexed f k v
Nothing -> pure (YMap m)
ix _ _ y = pure y
instance At YamlLight where
at k@(ObjIx k') f (YMap m) = YMap . aux <$> indexed f k mv
where aux Nothing = maybe m (const (Map.delete k' m)) mv
aux (Just v) = Map.insert k' v m
mv = Map.lookup k' m
at k f y = const y <$> indexed f k Nothing
instance Each YamlLight YamlLight YamlLight YamlLight where
each f (YSeq xs) = YSeq <$> traverse (uncurry $ indexed f)
(zip (map ArrIx [0..]) xs)
each f (YMap m) = YMap <$> sequenceA (Map.mapWithKey (indexed f . ObjIx) m)
each _ y = pure y
instance Plated YamlLight where
plate f (YSeq xs) = YSeq <$> traverse f xs
plate f (YMap m) = YMap <$> traverse f m
plate _f y = pure y
noRemainder :: (a, ByteString) -> Maybe a
noRemainder (x, bs) = if BC.null bs then Just x else Nothing
yamlInt :: Integral b => YamlLight -> Maybe b
yamlInt (YStr s) = readSigned readDecimal s >>= noRemainder
yamlInt _ = Nothing
yamlReal :: YamlLight -> Maybe Double
yamlReal (YStr s) = readDouble s >>= noRemainder
yamlReal _ = Nothing
nth :: Int -> Traversal' YamlLight YamlLight
nth = ix . ArrIx
key :: ByteString -> Traversal' YamlLight YamlLight
key = key' . YStr
key' :: YamlLight -> Traversal' YamlLight YamlLight
key' = ix . ObjIx
class AsYaml a where
fromYaml :: YamlLight -> Maybe a
toYaml :: a -> YamlLight
instance AsYaml (Map YamlLight YamlLight) where
fromYaml (YMap m) = Just m
fromYaml _ = Nothing
toYaml = YMap
instance AsYaml [YamlLight] where
fromYaml (YSeq a) = Just a
fromYaml _ = Nothing
toYaml = YSeq
instance AsYaml ByteString where
fromYaml (YStr s) = Just s
fromYaml _ = Nothing
toYaml = YStr
instance AsYaml String where
fromYaml (YStr s) = Just $ BC.unpack s
fromYaml _ = Nothing
toYaml = YStr . BC.pack
instance AsYaml Int where
fromYaml x@(YStr _) = yamlInt x
fromYaml _ = Nothing
toYaml x = YStr $ if x < 0 then BC.cons '-' bs else bs
where Just bs = packDecimal $ abs x
instance AsYaml Integer where
fromYaml x@(YStr _) = yamlInt x
fromYaml _ = Nothing
toYaml x = YStr $ if x < 0 then BC.cons '-' bs else bs
where Just bs = packDecimal $ abs x
instance AsYaml Double where
fromYaml x@(YStr _) = yamlReal x
fromYaml _ = Nothing
toYaml = YStr . BC.pack . show
instance AsYaml Bool where
fromYaml (YStr s) = case () of
_ | s == BC.pack "true" -> Just True
| s == BC.pack "false" -> Just False
| otherwise -> Nothing
fromYaml _ = Nothing
toYaml True = YStr $ BC.pack "true"
toYaml False = YStr $ BC.pack "false"
_Yaml :: AsYaml a => Prism' YamlLight a
_Yaml = prism' toYaml fromYaml