{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedStrings #-}

module Nock.Parse (
    P.runParser

  , parse
  , expr
  ) where

import Nock.Language
import Control.Applicative ((<|>))
import qualified Data.Text as T
import qualified Text.Parsec as P

parse :: T.Text -> Either P.ParseError Expr
parse = P.runParser expr [] "input"

expr :: Monad m => P.ParsecT T.Text u m Expr
expr =
      P.try operator
  <|> fmap Noun noun

operator :: Monad m => P.ParsecT T.Text u m Expr
operator = do
  op <- P.oneOf "?+=/#*"
  case op of
    '?' -> fmap Wut noun
    '+' -> fmap Lus noun
    '=' -> fmap Tis noun
    '/' -> fmap Net noun
    '#' -> fmap Hax noun
    '*' -> fmap Tar noun
    _   -> fail "op: bad token"

noun :: Monad m => P.ParsecT T.Text u m Noun
noun =
      P.try cell
  <|> atom

atom :: Monad m => P.ParsecT T.Text u m Noun
atom = do
  digits <- P.many P.digit
  case digits of
    ('0':t) -> case t of
      [] -> return (Atom 0)
      _  -> fail "atom: bad input"

    (_:_) ->
      let nat = read digits
      in  return (Atom nat)

    [] -> fail "atom: bad input"

cell :: Monad m => P.ParsecT T.Text u m Noun
cell = do
  P.char '['
  P.skipMany P.space
  h <- noun
  P.skipMany P.space
  t <- P.sepBy noun (P.many1 P.space)
  P.skipMany P.space
  P.char ']'

  return (toCell (h : t))

toCell :: [Noun] -> Noun
toCell = loop where
  loop list = case list of
    []     -> error "cell: bad input"
    [_]    -> error "cell: bad input"
    [s, f] -> Cell s f
    (h:t)  -> Cell h (loop t)