{-# OPTIONS_GHC -XTypeSynonymInstances -XFlexibleInstances -XOverlappingInstances #-}
module YAML(FromYAML(..),parseYamlFile) where

import Data.Char
import Control.Monad.Identity
import Control.Monad
import qualified Data.Map as Map
import Data.Yaml.Syck

class FromYAML a where
    fromYaml   :: YamlNode -> a
    fromYamlM  :: Monad m =>YamlNode -> m a

    fromYaml y = runIdentity (fromYamlM y)
    fromYamlM y = return (fromYaml y)


instance FromYAML a => FromYAML [a] where
    fromYamlM MkNode { n_elem = ESeq ys } = mapM fromYamlM ys
    fromYamlM MkNode { n_elem = ENil } = return []
    fromYamlM _ = fail "expected YAML list"

instance (FromYAML a, FromYAML b) => FromYAML [(a,b)] where
    fromYamlM MkNode { n_elem = EMap ys } = flip mapM ys $ \ (x,y) -> do
        x <- fromYamlM x
        y <- fromYamlM y
        return (x,y)
    fromYamlM MkNode { n_elem = ENil } = return []
    fromYamlM _ = fail "expected YAML map"

instance FromYAML String where
    fromYamlM MkNode { n_elem = EStr cs } = return $ unpackBuf cs
    fromYamlM MkNode { n_elem = ENil } = return ""
    fromYamlM _ = fail "expected YAML string"


instance (Ord a,FromYAML a, FromYAML b) => FromYAML (Map.Map a b) where
    fromYamlM MkNode { n_elem = EMap ys } = do
        let f (x,y) = return (,) `ap` fromYamlM x `ap` fromYamlM y
        es <- mapM f ys
        return $ Map.fromList es
    fromYamlM MkNode { n_elem = ENil } = return Map.empty
    fromYamlM _ = fail "expected YAML map"


instance FromYAML YamlNode where
    fromYaml x = x

instance FromYAML Bool where
    fromYamlM MkNode { n_elem = EStr cs } = case map toLower (unpackBuf cs) of
        "true"  -> return True
        "false" -> return False
        "yes"   -> return True
        "no"    -> return False
        "y"     -> return True
        "n"     -> return False
        "on"    -> return True
        "off"   -> return False
        _ -> fail "expected true or false"
    fromYamlM _ = fail "expected true or false"