50 lines
1.3 KiB
Haskell
50 lines
1.3 KiB
Haskell
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
module YAML (
|
|
(.:)
|
|
, Value(..)
|
|
, YAML(..)
|
|
, encode
|
|
) where
|
|
|
|
import Data.List (intercalate)
|
|
import Data.Map (Map, toList)
|
|
|
|
data Value = Simple String | Array [Value] | Object [(String, Value)] deriving (Show)
|
|
|
|
class YAML a where
|
|
toYAML :: a -> Value
|
|
|
|
instance YAML Value where
|
|
toYAML = id
|
|
|
|
instance {-# OVERLAPPABLE #-} YAML a => YAML [a] where
|
|
toYAML = Array . fmap toYAML
|
|
|
|
instance {-# OVERLAPPABLE #-} YAML a => YAML (Map String a) where
|
|
toYAML = Object . toList . fmap toYAML
|
|
|
|
instance {-# OVERLAPPABLE #-} Show a => YAML a where
|
|
toYAML = Simple . show
|
|
|
|
instance YAML String where
|
|
toYAML = Simple
|
|
|
|
encode :: YAML a => a -> String
|
|
encode = intercalate "\n" . getLines . toYAML
|
|
where
|
|
getLines (Simple s) = lines s
|
|
getLines (Array l) = concat $ (dashFirst . getLines) <$> l
|
|
getLines (Object m) = concat $ keyVal <$> m
|
|
dashFirst [] = []
|
|
dashFirst (l:ls) = ("- " ++ l) : ((" " ++) <$> ls)
|
|
keyVal (k, Simple s) =
|
|
case lines s of
|
|
[v] -> [k ++ ": " ++ v]
|
|
l -> (k ++ ": |") : (('\t' :) <$> l)
|
|
keyVal (k, v) = (k ++ ":") : (('\t' :) <$> getLines v)
|
|
|
|
(.:) :: YAML a => String -> a -> (String, Value)
|
|
(.:) k v = (k, toYAML v)
|