implementation module format

import StdEnv

import Data.Func
import Data.Either
import Data.Error
import Data.Functor
import Data.List
import Data.Maybe
import Data.GenEq
import Control.Applicative
import Control.Monad
import Text => qualified join
import Text.Parsers.Simple.ParserCombinators

:: FormatString :== [Format]
:: Format
	= FMTLiteral String
	| FMTApply FormatFun [Format]

:: FormatFun
	= FFTag

derive gEq Format, FormatFun
instance == FormatString where == x y = x === y

format :: [(String, String)] FormatString -> MaybeErrorString String
format tags f = concat <$> mapM fmt f
where
	fmt :: Format -> MaybeErrorString String
	fmt (FMTLiteral s) = pure s
	fmt (FMTApply fun args) = case (fun, args) of
		(FFTag, [tag,alt])
			= flip fromMaybe o flip lookup tags <$> fmt tag <*> fmt alt
		(FFTag, _) = Error "`tag` must have exactly two arguments"
		_ = Error "Unimplemented function"

parseFormat :: [Char] -> MaybeErrorString FormatString
parseFormat s = either (Error o concat) Ok (parse (some pFormat) s)

pFormat :: Parser Char Format
pFormat
	=   FMTApply <$ pToken '$' <*> pFormatFun <* pToken '{' <*> pSepBy pFormat pComma <* pToken '}'
	<|> FMTLiteral <$> toString <$> some (
		     pToken '\\' *> pSatisfy (\x->isMember x ['${},'])
		<|> pSatisfy (\x->not (isMember x ['$[],'])))
	

pFormatFun :: Parser Char FormatFun
pFormatFun = FFTag <$ pList (map pToken ['tag'])