{-# 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)