{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
module Ubc.Parse.Syntax.Import
( parse
, Import(..)
)
where

import Control.Arrow ((>>>))

import Control.Monad (filterM)
import Control.Monad.Catch ( MonadThrow, )
import Control.Monad.Trans (lift, MonadIO (liftIO))
import Control.Monad.Trans.Except ()
import Control.Monad.Trans.Reader (asks, ReaderT)

import Data.Functor ((<&>))

import Data.List.NonEmpty (NonEmpty)
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO

import qualified System.Directory as IO

import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf)
import qualified Text.Parsec as Parsec

import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (</>), fromAbsFile, fromRelFile )

import Ubc.Parse.Syntax (Transformer, Token)
import Ubc.Parse.Syntax.Config (Config)
import qualified Ubc.Parse.Syntax.Config as Config
import qualified Ubc.Parse.Syntax.File as File
import qualified Ubc.Parse.Syntax.Language as UbcLanguage

data Import = Import
        { file :: File.File
        , alias :: Maybe Token
        , list :: [Token]
        }
        deriving stock (Show)

importPath :: Monad m => ParsecT Token u m (NonEmpty Token)
importPath = UbcLanguage.angles (many importChar `sepBy1` char '/')
        <&> NonEmpty.fromList . List.map Text.pack

importChar :: (Monad m) => ParsecT Token u m Char
importChar = choice
        [ char '\\' >> oneOf ">/\\"
        , notFollowedBy (oneOf ">/") >> anyChar
        ]

parse :: ParsecT Token u Transformer Import
parse = do
        UbcLanguage.reserved "import"
        fragments <- importPath

        -- concatenate directory and file parts, also utf-decoding
        relFile <- case parseRelPath fragments of
                        Left err -> fail $ "Failed to decode path:\n" <> show err
                        Right relFile -> pure relFile

        -- appended to all search directories
        possiblePaths <- lift $ constructPaths relFile
        -- only existing files
        existingFiles <- liftIO $ filterInexistent possiblePaths

        -- fail or parse
        importedFile <- case existingFiles of
                [] -> fail . Text.unpack $ notFoundMessage relFile possiblePaths
                [path] -> parseFile path
                fs@_ -> fail . Text.unpack $ multipleFoundMessage relFile fs

        importAs <- Parsec.optionMaybe importAlias

        importList <- UbcLanguage.parens $ UbcLanguage.commaSeparated UbcLanguage.identifier

        return $ Import importedFile importAs importList

importAlias :: Monad m => ParsecT Token u m Token
importAlias = UbcLanguage.reserved "as" 
        *> UbcLanguage.identifier

multipleFoundMessage :: Path Rel File -> [Path Abs File] -> Token
multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Text.pack (Path.fromRelFile relFile) <> "\n"
        <> "Found multiple files in the search path:"
        <> (Text.unlines . List.map (Path.fromAbsFile >>> ('\t':) >>> Text.pack) $ foundFiles)

notFoundMessage :: Path Rel File -> [Path Abs File] -> Token
notFoundMessage relFile searchedLocations = "Could not locate import file <" <> Text.pack (Path.fromRelFile relFile) <> ">\n"
                <> "Searched locations were:\n"
                <> (Text.unlines . List.map (Path.fromAbsFile >>> ('\t':) >>> Text.pack) $ searchedLocations)

parseFile :: Path Abs File -> ParsecT Token u Transformer File.File
parseFile path = do
        let stringPath = Path.fromAbsFile path
        contents <- liftIO . Text.IO.readFile $ stringPath

        -- save old state
        oldInput <- Parsec.getInput
        oldPosition <- Parsec.getPosition

        -- calculate new state
        let newPosition = (flip Parsec.setSourceName) stringPath
                >>> (flip Parsec.setSourceLine) 1
                >>> (flip Parsec.setSourceColumn) 1
                $ oldPosition

        -- disable backtracking (consuming input)
        Parsec.setInput "_" <* Parsec.char '_'

        -- prepare new state
        Parsec.setInput contents
        Parsec.setPosition newPosition

        -- parse the file
        importedFile <- File.parse <* Parsec.eof

        -- restore old state
        Parsec.setInput oldInput
        Parsec.setPosition oldPosition

        pure importedFile 

parseRelPath :: MonadThrow m => NonEmpty Token -> m (Path Rel File)
parseRelPath fragments = do
        name <- Path.parseRelFile . Text.unpack $ NonEmpty.last fragments
        dirPath <- mapM (Path.parseRelDir . Text.unpack) . NonEmpty.init $ fragments
        pure $ constructRelative name dirPath

constructRelative :: Path Rel t -> [Path Rel Dir] -> Path Rel t
constructRelative = foldr (</>)

filterInexistent :: [Path Abs File] -> IO [Path Abs File]
filterInexistent paths = filterM (IO.doesFileExist . Path.fromAbsFile) paths

constructPaths :: Monad m => Path Rel t -> ReaderT Config m [Path Abs t]
constructPaths suffix = do
        paths <- asks Config.includePaths
        Set.toList
                >>> List.map (</> suffix)
                >>> pure
                $ paths