{
module Parser where
import Lexer
import JQ
import Text.JSON
import Debug.Trace
import Data.List
import Control.Monad.Error
import Control.Monad.Reader

instance Error (Maybe a) where
  noMsg = Nothing
  strMsg = const Nothing

instance (Error a, Error b) => Error (a, b) where
  noMsg = (noMsg, noMsg)
  strMsg s = (strMsg s, strMsg s)
}

%name runParser TopLevel
%tokentype { Token }

%monad { Either String }
%error { \t -> throwError $ "parse error: unexpected " ++ if null t then [] else (show $ t) }

%token
  '|' { TRes "|" }
  '.' { TRes "." }
  '[' { TRes "[" }
  ']' { TRes "]" }
  '{' { TRes "{" }
  '}' { TRes "}" }
  '(' { TRes "(" }
  ')' { TRes ")" }
  '$' { TRes "$" }
  'as' { TRes "as" }
  ',' { TRes "," }
  ':' { TRes ":" }
  '==' { TRes "==" }
  '=' { TRes "=" }
  '+' { TRes "+" }
  'def' { TRes "def" }
  ';' { TRes ";" }
  'else' { TRes "else" }
  'and' { TRes "and" }
  'or' { TRes "or" }
  Ident { TIdent $$ }
  String { TString $$ }
  Int { TInt $$ }


%left 'else'
%right '|'
%left '='
%left ','
%left 'and' 'or'
%nonassoc '=='
%left '+'

%%

TopLevel
  : Defn TopLevel	{ withDefn $1 $2 }
  | Exp			{ $1 }

Exp 
  : Exp 'else' Exp      { $1 `elsep` $3 }
  | Assign '|' Exp	{ do { v <- snd $1; setvar (fst $1) v $3 } }
  | Exp '|' Exp         { $1 >| $3 }
  | Exp ',' Exp         { $1 `mplus` $3 }
  | Exp 'and' Exp	{ liftM2 andj $1 $3 }
  | Exp 'or' Exp	{ liftM2 orj $1 $3 }
  | Exp '=' Exp         { assignp $1 $3 }
  | Exp '==' Exp        { liftM2 eqj (subexp $1) (subexp $3) }
  | Exp '+' Exp         { liftM2 plusj (subexp $1) (subexp $3) }
  | Term                { $1 }

Assign
  : Term 'as' '$' Ident { ($4, $1) }

Defn
  : 'def' Ident '=' Exp ';' { ($2, [], $4) }
  | 'def' Ident '(' ParamList ')' '=' Exp ';' { ($2, $4, $7) }

ParamList
  :			{ [] }
  | Ident		{ [$1] }
  | Ident ';' ParamList { $1:$3 }
  
ExpD
  : ExpD '|' ExpD       { $1 >| $3 }
  | ExpD '==' ExpD      { liftM2 eqj $1 $3 }
  | Term                { $1 }


Term 
  : '.'                 { input }
  | Term '.' Ident      { $1 >| index $3 }
  | '.' Ident           { index $2 }
  | String              { constStr $1 }
  | Term '[' Exp ']'    { do {t <- $1; i <- subexp $3; lookupj t i} }
  | Term '[' ']'        { $1 >| childp }
  | '(' Exp ')'         { $2 }
  | '[' Exp ']'         { arrayp $2 }
  | '[' ']' 		{ arrayp (callp "empty" []) }
  | Int                 { constInt $1 }
  | '{' MkDict '}'      { dictp $2 }
  | Ident '(' Exp ')'   { callp $1 [$3] }
  | Ident               { callp $1 [] }
  | '$' Ident		{ getvar $2 }

MkDict
  :                     { [] }
  | MkDictPair          { [$1] }
  | MkDictPair ',' MkDict { $1:$3 }

MkDictPair
  : Ident ':' ExpD      { (constStr $1, $3) }
  | Ident               { (constStr $1, index $1) }
  | String ':' ExpD     { (constStr $1, $3) }
  | '(' Exp ')' ':' ExpD{ ($2, $5) }