{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}



{-# OPTIONS_GHC -Wall #-}

-- {-# OPTIONS_GHC -fno-warn-unused-matches #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}


-- for module' below
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}



-- |
-- Copyright :  (c) Andreas Reuleaux 2015 - 2018 
-- License   :  BSD2
-- Maintainer:  Andreas Reuleaux <rx@a-rx.info>
-- Stability :  experimental
-- Portability: non-portable
-- Tools for working with multiple source files, ported to Pire from Pi-Forall


module OldModules
       (

         module OldModules

       )

       where



import OldSyntax
import OldParser (PiState (..), piInit)
-- import OldParser (parseModuleImports, parseModuleImports_, parseModuleFile, parseModuleFile_, parseModuleFileR)
import OldParser (parseModuleImports, parseModuleImports_, parseModuleFile, parseModuleFile_, parseModuleFileR)



import Control.Applicative
import Control.Monad.Except

import PrettyCommon (pp)

-- for haddock ?
-- import Control.Monad.Error.Class



import Control.Monad.State.Lazy
import System.FilePath
import System.Directory
import qualified Data.Graph as Gr
import Data.List(nub,(\\))


import Data.Text.Prettyprint.Doc (Doc)

import Data.Either.Combinators (fromRight')


-- for the samples (doctests to come)
import System.IO.Silently


import qualified Data.Text as T

import Text.Trifecta

import Text.Trifecta.Indentation

import Control.Lens ((^.))

-- for convenience
-- formerly in ParseUtils
module' 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'




data ModuleInfo =
  ModuleInfo {
    modInfoName     :: String,
    modInfoFilename :: String,
    modInfoImports  :: [ModuleImport T.Text]
    }

  | ModuleInfo_ {
      modInfoName_     :: (Nm T.Text),
      modInfoFilename_ :: String,
      modInfoImports_  :: [ModuleImport T.Text]
      }

  deriving (Show)




{-

examples

(runExceptT $ getModules_ ["samples"] "M") >>= return . pp . last . fromRight'
resp. silently
(silence $ runExceptT $ getModules_ ["samples"] "M") >>= return . pp . last . fromRight'


runExceptT $ getModules ["", "samples/"] "Sample"


(runExceptT $ getModules ["", "samples/"] "Sample") >>= return . fromRight'

(runExceptT $ getModules ["", "samples/"] "Sample") >>= return . nopos . fromRight'

(runExceptT $ getModules ["", "samples/"] "Fac") >>= return . pp . last . fromRight'

(runExceptT $ getModules ["", "samples/"] "Fac") >>= return . nopos . last . fromRight'

(runExceptT $ getModules ["pitestfiles"] "Logic.pi") >>= return . pp . last . fromRight'
resp
(runExceptT $ getModules ["pitestfiles"] "Logic") >>= return . pp . last . fromRight'

dito
(runExceptT $ getModules  ["pitestfiles"] "Nat") >>= return . pp . last . fromRight'
(runExceptT $ getModules_ ["pitestfiles"] "Nat") >>= return . pp . last . fromRight'
etc

all modules
(runExceptT $ getModules_ ["pitestfiles"] "Nat") >>= return . pp . fromRight'

 -}




-- | getModules starts with a top-level module, and gathers all of the module's                            
-- transitive dependency. It returns the list of parsed modules, with all                                  
-- modules appearing after its dependencies.
getModules, getModules_
  :: (MonadError (Doc ann) m
     , MonadIO m
     ) =>
     [FilePath] -> String -> m [Module T.Text T.Text]

getModules prefixes topmod = do
  toParse <- gatherModules prefixes [ModuleImport (T.pack topmod)]
  -- flip evalStateT piInit $ mapM reparse toParse
  evalStateT (mapM reparse toParse) piInit



getModules_ prefixes topmod = do
  toParse <- gatherModules prefixes [ModuleImport_ (ImportTok (T.pack "import") NoWs) (Nm_ (T.pack topmod) NoWs)]
  -- flip evalStateT piInit $ mapM reparse_ toParse
  evalStateT (mapM reparse toParse) piInit



isSuccess :: Result a -> Bool
isSuccess  (Success  _) = True
isSuccess  (Failure _) = False




-- -- -- flip evalStateT piInit $ mapM reparse_ toParse
-- --   evalStateT (mapM (\m -> case reparseR m of {
-- --                        ; s@(Success m') -> s
-- --                        ; f@(Failure xs) -> f
-- --                        }) 
-- --                toParse') piInit
-- --   -- evalStateT (mapM (\m -> do { m' <- reparseR m ; return m' })) toParse piInit





-- debugging
-- -- toparse_
-- --   :: (Functor m
-- --      -- , MonadError ParseError m
-- --      , MonadError Doc m
-- --      , MonadIO m) => 
-- --      [FilePath] -> String -> m [ModuleInfo]
-- -- toparse_ prefixes topmod = do
-- --   toParse <- gatherModules prefixes [ModuleImport_ (ImportTok (T.pack "import") $ Ws "") (Nm_ (T.pack topmod) $ Ws "")]
-- --   return toParse





-- instance Show ModuleInfo
-- instance Show [ModuleInfo]



-- runExceptT $ gatherModules ["", "samples/"] [ModuleImport "Sample.pi"]
-- result?


-- runExceptT $ gatherModules_ ["", "samples/"] [ModuleImport_ (ImportTok $ Ws "") (MName_ "Fac.pi" $ Ws "")]
-- result?


-- gatherModules
--   :: (Functor m
--       -- , MonadError ParseError m
--      , MonadError Doc m
--      , MonadIO m
--      )
--      => [FilePath] -> [ModuleImport t] -> m [ModuleInfo T.Text]


-- file S.pi doesn't exist any more - but that's the idea:
-- -- |
-- -- >>> (Module_ _ _ _ imports _ _) <- parsingModuleImports_ "samples/S.pi"
-- -- [ModuleImport_ (ImportTok (Ws " ")) (Nm_ "N" (Ws "\n\n-- data Nat : Type where\n--   Zero\n--   Succ of (Nat)\n\n"))]


-- let prefixes = ["samples/"]
-- modFileName <- getModuleFileName prefixes "S.pi"
-- (Module _ imports _ _) <- parsingModuleImports modFileName


-- -- gatherModules' 
-- --   :: (Functor m
-- --      , MonadError Doc m
-- --      , MonadIO m
-- --      )
-- --      => [FilePath] -> [ModuleImport T.Text] -> [ModuleInfo] -> m [ModuleInfo]


gatherModules'
  :: (MonadError (Doc ann) m
     , MonadIO m
     )
     => [FilePath] -> [ModuleImport T.Text] -> [ModuleInfo] -> m [ModuleInfo]


gatherModules' _ [] accum = return $ topSort accum

gatherModules' prefixes (ModuleImport m : ms') accum = do
  modFileName <- getModuleFileName prefixes (T.unpack m)
  mimports <- _imports <$> parseModuleImports modFileName
  let accum' = ModuleInfo (T.unpack m) modFileName mimports : accum
  let oldMods = map (ModuleImport . T.pack . modInfoName) accum'
  gatherModules' prefixes (nub (ms' ++ mimports) \\ oldMods) accum'

gatherModules' prefixes (ModuleImport_ itok nm : ms') accum = do
  modFileName <- getModuleFileName prefixes (T.unpack $ getnm nm)
  mimports <- _imports <$> parseModuleImports_ modFileName
  let accum' = ModuleInfo_ nm modFileName mimports : accum
  let oldMods = map (ModuleImport_ itok . modInfoName_) accum'
  gatherModules' prefixes (nub (ms' ++ mimports) \\ oldMods) accum'


-- todo: think about a slightly more liberal version of nub (called nub' eg)
-- for the white space aware case, to avoid reparsing, when there is really no need,
-- just because of differences in white space following names ie.
-- maybe use some function: equal upto white space, or the like




-- -- gatherModules
-- --   :: (Functor m
-- --       -- , MonadError ParseError m
-- --      , MonadError Doc m
-- --      , MonadIO m
-- --      )
-- --      => [FilePath] -> [ModuleImport T.Text] -> m [ModuleInfo]


-- | Build the module dependency graph.
--   This only parses the imports part of each file; later we go back and parse all of it.
gatherModules
  :: (MonadError (Doc ann) m
     , MonadIO m
     )
     => [FilePath] -> [ModuleImport T.Text] -> m [ModuleInfo]


gatherModules prefixes ms = gatherModules' prefixes ms []



-- | Generate a sorted list of modules, with the postcondition that a module
-- will appear _after_ any of its dependencies.
-- topSort :: [Module] -> [Module]
topSort :: [ModuleInfo] -> [ModuleInfo]
topSort [] = []
topSort ms@(ModuleInfo {}:_) = reverse sorted
  where (gr,lu) = Gr.graphFromEdges'
                  [
                    (m,
                     modInfoName m,
                     -- [i | ModuleImport i <- modInfoImports m]
                     [T.unpack i | ModuleImport i <- modInfoImports m]
                    )
                  | m <- ms
                  ]
        lu' v = let (m,_,_) = lu v in m
        sorted = [lu' v | v <- Gr.topSort gr]

topSort ms@(ModuleInfo_ {}:_) = reverse sorted
  where (gr,lu) = Gr.graphFromEdges'
                  [(m,
                    modInfoName_ m,
                    -- [i | ModuleImport_ _ i <- modInfoImports_ m]

                    [(Nm_ (i) (Ws $ ws)) | ModuleImport_ _ (Nm_ i (Ws ws))  <- modInfoImports_ m]

                   )
                  | m <- ms]
        lu' v = let (m,_,_) = lu v in m
        sorted = [lu' v | v <- Gr.topSort gr]



-- instance Error ParseError
-- instance Error Doc
-- instance Except Doc



-- |
-- >>> getModuleFileName ["samples/"] "Sample.pi"
-- "samples/Sample.pi"



-- | Find the file associated with a module.

getModuleFileName :: (MonadIO m)
                  => [FilePath] -> String -> m FilePath
getModuleFileName prefixes modul = do
  let makeFileName prefix = prefix </> mDotTrellys
      -- get M.pi from M or M.pi
      mDotTrellys = if takeExtension s == ".pi"
                    then s
                    else s <.> "pi"
      s = modul
      possibleFiles = map makeFileName prefixes
  files <- liftIO $ filterM doesFileExist possibleFiles
  if null files
     then error $ "Can't locate module: " ++ show modul ++
                "\nTried: " ++ show possibleFiles
     else return $ head files


-- -- |
-- -- >>> getModuleFileName_ ["samples/"] $ Nm_ "Sample.pi" $ Ws ""
-- -- "samples/Sample.pi"

-- getModuleFileName_ :: (MonadIO m)
--                   => [FilePath] -> Nm_ String -> m FilePath
-- getModuleFileName_ prefixes (Nm_ modul  _) = getModuleFileName prefixes modul


-- | Fully parse a module (not just the imports).
reparse :: (
  MonadError (Doc ann) m
  , MonadIO m
  , MonadState PiState m
  ) =>  ModuleInfo -> m (Module T.Text T.Text)


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

reparse (ModuleInfo_ _ fn _) = do
  st <- get
  m <- parseModuleFile_ st fn
  put (st { constr_names = _constrs m})
  return m




reparseR :: (
  MonadIO m
  , MonadState PiState m
  , IndentationParsing m
  ) => ModuleInfo -> m (Result (Module T.Text T.Text))



reparseR (ModuleInfo _ fn _) = do {
  ; st <- get
  ; r <- parseModuleFileR st fn
  ; case r of {
      ; s@(Success m) -> put (st { constr_names = _constrs m}) >> return s
      ; f@(Failure _) -> return f
      }
  }

reparseR (ModuleInfo_ _ fn _) = do {
  ; st <- get
  ; r <- parseModuleFileR st fn
  ; case r of {
    ; s@(Success m)  -> put (st { constr_names = _constrs m}) >> return s
    ; f@(Failure _) -> return f
    }
  }