{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
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.Set as Set
import qualified Data.List.NonEmpty as NonEmpty

import qualified System.Directory as IO

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

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

import Ubc.Parse.Syntax (Transformer)
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 :: String
        }
        deriving stock (Show)

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

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

parse :: ParsecT String u Transformer Import
parse = do
        UbcLanguage.reserved "import"
        fragments <- importPath
        importAs <- option (NonEmpty.last fragments) importAlias

        -- 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 if there are multiple files
        case existingFiles of
                [] -> fail $ notFoundMessage relFile possiblePaths
                [path] -> parseFile path importAs
                fs@_ -> fail $ multipleFoundMessage relFile fs

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

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

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

parseFile :: Path Abs File -> String -> ParsecT String u Transformer Import
parseFile path importAs = do
        let stringPath = Path.fromAbsFile path
        contents <- liftIO . 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

        -- prepare new state
        Parsec.setInput contents
        Parsec.setPosition newPosition
        importedFile <- File.parse stringPath 

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

        pure $ Import importedFile importAs

parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File)
parseRelPath fragments = do
        name <- Path.parseRelFile $ NonEmpty.last fragments
        dirPath <- mapM Path.parseRelDir . 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