{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE ConstraintKinds  #-}

{-# LANGUAGE FlexibleContexts  #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}


module Parser where




import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.IO as L


import qualified Data.Text as T

import Control.Lens



import Common
import Pire.Syntax

import Pire.Text2String

import Pire.Modules

import Pire.Parser.ParseUtils
import Pire.Parser.Expr



-- Alternative
import Control.Applicative

-- MonadPlus
-- import Control.Monad

import Control.Monad.Trans

import Control.Monad.Except

-- import Control.Lens

-- base...
-- import Numeric.Lens hiding (binary)

-- import Data.Char (isSpace)


import Text.Parser.Token
-- import Text.Parser.Token.Style
import Text.Parser.LookAhead
-- import Text.Parser.Expression


-- import qualified Text.Trifecta as Tri hiding ((:@)) 
import Text.Trifecta hiding ((:@), integer) 

-- import qualified Text.Trifecta as Trifecta

-- import Text.Trifecta.Delta

-- import qualified Data.HashSet as HS

-- import Bound

import Control.Monad.State.Strict hiding (fix)


import Text.PrettyPrint.ANSI.Leijen (Doc)


import Pire.Parser.Parser
import Pire.Parser.Decl

-- import Pire.Modules
import Pire.Parser.Modules




import Pire.Text2String
import Pire.NoPos





-- top :: Parser Binding
top :: (TokenParsing m, DeltaParsing m, LookAheadParsing m, Monad m, MonadState PiState m) => m (Decl N N)
top = do
  x <- decl
  optional semi
  -- return x
  return $ t2s x




modl ::  (TokenParsing m, DeltaParsing m, LookAheadParsing m, Monad m, MonadState PiState m) => m [Decl N N]
modl = many top




meat p = (whiteSpace *> p <* eof)

  



-- cf. emett's either / fromRight'
-- -- fromSuccess :: Result b -> b
-- -- fromSuccess (Success x) = x
-- -- fromSuccess (Failure doc') = error $ show doc'


-- parse :: InnerParser a -> String -> Result a
parseResult p s =
  let

    -- -- -- -- p' = runInnerParser $ p 
    p' = runInnerParser $ evalStateT p piInit

  in
    -- fromSuccess $ parseString p' beginning s
    parseString p' beginning s




-- similar to parseModuleFile in Parser modules, but returns the module in a result
parseModuleFile2 :: (MonadIO m, MonadError Doc m)
                     => PiState -> FilePath -> m (Result (Module T.Text T.Text))
parseModuleFile2 st nm = do
  liftIO $ putStrLn $ "Parsing File " ++ show nm
  parseFromFileEx (runInnerParser $ evalStateT (whiteSpace *> moduleDef) st) nm








parseDecls2 fn = do
  r <- parseModuleFile2 piInit fn
  case r of {
    ; (Success m) -> return $ _decls' m  
    ; Failure xs -> fail $ show xs
    }



-- get contents
parseModuleFile3 :: () => PiState -> String -> Result (Module T.Text T.Text)
parseModuleFile3 st s = do
  parseString (runInnerParser $ evalStateT (whiteSpace *> moduleDef) st) beginning s


parseDecls3 :: L.Text -> Result [Decl N N]
parseDecls3 s  = case (parseModuleFile3 piInit $ L.unpack s) of {
  ; (Success m) -> Success $ t2s $ _decls' m  
  ; Failure xs -> Failure  $ xs
  }


parseExprs :: L.Text -> Result [Expr N N]
parseExprs s  = case (parse' (some expr) $ L.unpack s) of {
  ; (Success e) -> Success $ t2s <$> e  
  ; Failure xs -> Failure  $ xs
  }



-- parseExpr :: L.Text -> Result (Expr N N)
-- parseExpr s  = case (parse' expr $ L.unpack s) of {
--   ; (Success e) -> Success $ t2s $ e  
--   ; Failure xs -> Failure  $ xs
--   }


parseExpr :: L.Text -> Result (Expr N N)
parseExpr s  = t2s <$> (parse' expr $ L.unpack s)


-- --------------------
-- decls
-- just plain decls

parseDecl :: L.Text -> Result (Decl N N)
parseDecl s  = t2s <$> (parse' decl $ L.unpack s)
               


parseDecls :: L.Text -> Result [Decl N N]
parseDecls s  = t2s <$> (parse' (some decl) $ L.unpack s)
               
-- not in a module file

-- parseDecls3 :: Monad m => L.Text -> m [Decl N N]
-- parseDecls3 s  = case (parseModuleFile3 piInit $ L.unpack s) of {
--   ; (Success m) -> return $ t2s $ _decls' m  
--   ; Failure xs -> fail $ show xs
--   }



-- L.readFile "samples/Nat.pi"  >>= \cs -> return $ parseDecls3 cs
-- resp 
-- L.readFile "samples/Nat.pi"  >>= \cs -> return $ (nopos <$>) $ parseDecls3 cs

-- --------------------







-- parseModuleFileAsResult' :: (MonadIO m, MonadError Doc m)
--                      => PiState -> FilePath -> m (Result (Module String String))
-- parseModuleFileAsResult' st nm = do
--   liftIO $ putStrLn $ "Parsing File " ++ show nm
--   parseFromFileEx (runInnerParser $ evalStateT (whiteSpace *> moduleDef) st) nm >>= return . (t2s <$>)


-- parseModuleFileAsResult :: (MonadIO m, MonadError Doc m)
--                      => FilePath -> m (Result (Module String String))
-- parseModuleFileAsResult = parseModuleFileAsResult' piInit





-- parseModule :: (MonadIO m) => PiState -> FilePath -> String -> m (Result [Decl N N])
-- parseModule st _ input = parseFromFileEx (runInnerParser $ evalStateT (meat modl) st) input 



-- -- eg. myParseModule "test.ml"

-- myParseModule :: (MonadIO m) => PiState -> String -> m (Result [Decl N N])
-- myParseModule st input = parseFromFileEx (runInnerParser $ evalStateT (meat modl) st) input 



-- parseModule' :: FilePath -> L.Text -> Result [Decl N N]
-- parseModule' _ input = parseResult (meat modl) $ L.unpack input



-- reparse (ModuleInfo _ fn _) = do
--   st <- get
--   modu <- parseModuleFile st fn
--   put (st { constr_names = _constrs' modu})
--   return modu




reparse2 :: (
  MonadError Doc m
  , MonadIO m
  , MonadState PiState m
  )
  =>  ModuleInfo -> m (Result (Module T.Text T.Text))
           
reparse2 (ModuleInfo _ fn _) = do
  st <- get
  r <- parseModuleFile2 st fn
  case r of {
    ; Success m -> do { put (st { constr_names = _constrs' m})
                      ; return $ Success m
                      }
    ; Failure xs -> return $ Failure xs
    }

           
reparse2 (ModuleInfo_ _ fn _) = do
  st <- get
  r <- parseModuleFile2 st fn
  case r of {
    ; Success m -> do { put (st { constr_names = _constrs' m})
                      ; return $ Success m
                      }
    ; Failure xs -> return $ Failure xs
    }


-- getModules_
--   :: (Functor m
--      -- , MonadError ParseError m
--      , MonadError Doc m
--      , MonadIO m) => 
--      [FilePath] -> String -> m (Result [Module T.Text T.Text])
-- getModules_ prefixes topmod = do
--   toParse <- gatherModules prefixes [ModuleImport_ (ImportTok (T.pack "import") NoWs) (Nm1_ (T.pack topmod) NoWs)]
-- -- flip evalStateT piInit $ mapM reparse_ toParse
--   evalStateT (mapM reparse2 toParse) piInit




-- module2_ path = do
--   -- ( (if quiet then silence else id) $ runExceptT $ getModules_ [dir] $ head fn )
--   (runExceptT $ getModules_ [dir] $ fn) >>= return . last . fromRight'
--   where
--     (dir : fn') = splitPath path
--     fn = head fn'
