import Data.ByteString.Char8 (unpack,pack)
import qualified Data.ByteString.Char8 as BS
import Control.Applicative
import Text.Trifecta
import Text.Trifecta.Indentation as I
import Text.Trifecta.Delta
import Text.Parser.Token.Style
import qualified Data.HashSet as HashSet

type EName = String

data Lit
  = LInt
  | LChar
  | LFloat
  deriving (Show,Eq,Ord)

data PrimFun
  = PAddI
  | PUpper
  | PMulF
  | PShow
  | PRead
  deriving (Show,Eq,Ord)

type Range = (Delta,Delta)
data Exp
  = ELit      Range Lit
  | EPrimFun  Range PrimFun
  | EVar      Range EName
  | EApp      Range Exp Exp
  | ELam      Range EName Exp
  | ELet      Range EName Exp Exp
--  | EFix EName Exp
  deriving (Show,Eq,Ord)


type P a = IndentationParserT Char Parser a

lcIdents = emptyIdents { _styleReserved = HashSet.fromList reservedIdents }
  where
    reservedIdents =
      [ "let"
      , "upper"
      , "in"
      , "add"
      , "show"
      , "read"
      ]

kw w = reserve lcIdents w

op w = reserve haskellOps w

var :: P String
var = ident lcIdents

lit :: P Lit
lit = LFloat <$ try double <|> LInt <$ integer <|> LChar <$ charLiteral

letin :: P Exp
letin = do
  localIndentation Ge $ do
    l <- kw "let" *> (localIndentation Gt $ some $ localAbsoluteIndentation $ def) -- WORKS
    a <- kw "in" *> (localIndentation Gt expr)
    return $ foldr ($) a l

def :: P (Exp -> Exp)
def = (\p1 n d p2 e -> ELet (p1,p2) n d e) <$> position <*> var <* kw "=" <*> expr <*> position

expr :: P Exp
expr = letin <|> lam <|> formula

formula = (\p1 l p2 -> foldl1 (EApp (p1,p2)) l) <$> position <*> some atom <*> position

atom =
  (\p1 f p2 -> EPrimFun (p1,p2) f) <$> position <*> primFun <*> position <|>
  (\p1 l p2 -> ELit (p1,p2) l) <$> position <*> lit <*> position <|>
  (\p1 v p2 -> EVar (p1,p2) v) <$> position <*> var <*> position <|>
  parens expr

primFun = PUpper <$ kw "upper" <|>
          PAddI <$ kw "add" <|>
          PShow <$ kw "show" <|>
          PRead <$ kw "read"

lam :: P Exp
lam = (\p1 n e p2 -> ELam (p1,p2) n e) <$> position <* op "\\" <*> var <* op "->" <*> expr <*> position

indentState = mkIndentationState 1 infIndentation True Gt

src = pack $ unlines
  [ ""
  , ""
  , "let  id = \\x -> x"
  , "     c = ' '"
  , "     i = 1"
  , "     a = id c"
  , "     b = id i"
  , "     inc = \\x -> add 1 x"
  , "in id inc"
  , ""
  , ""
  ]

test :: IO ()
test = do
  case parseByteString (evalIndentationParserT (kw "" *> expr <* eof) indentState) (Directed BS.empty 0 0 0 0) src of
    Failure m -> print m
    Success e -> return ()