{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : HsLua.Module.Path
Copyright   : © 2021-2026 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Lua module to work with file paths.
-}
module HsLua.Module.Path (
  -- * Module
    documentedModule

  -- * Fields
  , separator
  , search_path_separator

  -- * Path manipulation
  , add_extension
  , combine
  , directory
  , filename
  , is_absolute
  , is_relative
  , join
  , make_relative
  , normalize
  , split
  , split_extension
  , split_search_path
  , treat_strings_as_paths
  )
where

import Data.Text (Text)
import Data.Version (Version, makeVersion)
import HsLua.Core
  ( LuaError, getglobal, getmetatable, nth, pop, rawset, remove, top )
import HsLua.Marshalling
  ( Peeker, peekList, peekString, pushList, pushName, pushString )
import HsLua.Packaging

import qualified Data.Text as T
import qualified System.FilePath as Path

-- | The @path@ module specification.
documentedModule :: LuaError e => Module e
documentedModule = defmodule "path"
  `withDescription` "Module for file path manipulations."
  `withFields` fields
  `withFunctions` functions

--
-- Fields
--

-- | Exported fields.
fields :: [Field e]
fields =
  [ separator
  , search_path_separator
  ]

-- | Wrapper for @'Path.pathSeparator'@.
separator :: Field e
separator = deffield "separator"
  `withType` "string"
  `withDescription` "The character that separates directories."
  `withValue` pushString [Path.pathSeparator]

-- | Wrapper for @'Path.searchPathSeparator'@.
search_path_separator :: Field e
search_path_separator = deffield "search_path_separator"
  `withType` "string"
  `withDescription`
    "The character that is used to separate the entries in " <>
    "the `PATH` environment variable."
  `withValue` pushString [Path.searchPathSeparator]

--
-- Functions
--

functions :: LuaError e => [DocumentedFunction e]
functions =
  [ directory
  , filename
  , is_absolute
  , is_relative
  , join
  , make_relative
  , normalize
  , split
  , split_extension
  , split_search_path
  , treat_strings_as_paths
  ]

-- | See @Path.takeDirectory@
directory :: DocumentedFunction e
directory = defun "directory"
  ### liftPure Path.takeDirectory
  <#> filepathParam
  =#> filepathResult "The filepath up to the last directory separator."
  #? ("Gets the directory name, i.e., removes the last directory " <>
      "separator and everything after from the given path.")
  `since` initialVersion

-- | See @Path.takeFilename@
filename :: DocumentedFunction e
filename = defun "filename"
  ### liftPure Path.takeFileName
  <#> filepathParam
  =#> filepathResult "File name part of the input path."
  #? "Get the file name."
  `since` initialVersion

-- | See @Path.isAbsolute@
is_absolute :: DocumentedFunction e
is_absolute = defun "is_absolute"
  ### liftPure Path.isAbsolute
  <#> filepathParam
  =#> boolResult ("`true` iff `filepath` is an absolute path, " <>
                  "`false` otherwise.")
  #? "Checks whether a path is absolute, i.e. not fixed to a root."
  `since` initialVersion

-- | See @Path.isRelative@
is_relative :: DocumentedFunction e
is_relative = defun "is_relative"
  ### liftPure Path.isRelative
  <#> filepathParam
  =#> boolResult ("`true` iff `filepath` is a relative path, " <>
                  "`false` otherwise.")
  #? "Checks whether a path is relative or fixed to a root."
  `since` initialVersion

-- | See @Path.joinPath@
join :: LuaError e => DocumentedFunction e
join = defun "join"
  ### liftPure Path.joinPath
  <#> parameter (peekList peekFilePath) "{string,...}"
         "filepaths" "path components"
  =#> filepathResult "The joined path."
  #? "Join path elements back together by the directory separator."
  `since` initialVersion

make_relative :: DocumentedFunction e
make_relative = defun "make_relative"
  ### liftPure3 makeRelative
  <#> parameter
        peekFilePath
        "string"
        "path"
        "path to be made relative"
  <#> parameter
        peekFilePath
        "string"
        "root"
        "root path"
  <#> opt (boolParam "unsafe" "whether to allow `..` in the result.")
  =#> filepathResult "contracted filename"
  #? mconcat
     [ "Contract a filename, based on a relative path. Note that the "
     , "resulting path will never introduce `..` paths, as the "
     , "presence of symlinks means `../b` may not reach `a/b` if it "
     , "starts from `a/c`. For a worked example see "
     , "[this blog post](http://neilmitchell.blogspot.co.uk"
     , "/2015/10/filepaths-are-subtle-symlinks-are-hard.html)."
     ]
  `since` initialVersion

-- | See @Path.normalise@
normalize :: DocumentedFunction e
normalize = defun "normalize"
  ### liftPure Path.normalise
  <#> filepathParam
  =#> filepathResult "The normalized path."
  #? T.unlines
     [ "Normalizes a path."
     , ""
     , " - `//` makes sense only as part of a (Windows) network drive;"
     , "   elsewhere, multiple slashes are reduced to a single"
     , "   `path.separator` (platform dependent)."
     , " - `/` becomes `path.separator` (platform dependent)."
     , " - `./` is removed."
     , " - an empty path becomes `.`"
     ]
  `since` initialVersion

-- | See @Path.splitDirectories@.
--
-- Note that this does /not/ wrap @'Path.splitPath'@, as that function
-- adds trailing slashes to each directory, which is often inconvenient.
split :: LuaError e => DocumentedFunction e
split = defun "split"
  ### liftPure Path.splitDirectories
  <#> filepathParam
  =#> filepathListResult "List of all path components."
  #? "Splits a path by the directory separator."
  `since` initialVersion

-- | See @Path.splitExtension@
split_extension :: DocumentedFunction e
split_extension = defun "split_extension"
  ### liftPure Path.splitExtension
  <#> filepathParam
  =#> (functionResult (pushString . fst) "string" "filepath without extension"
       ++
       functionResult (pushString . snd) "string" "extension or empty string")
  #? ("Splits the last extension from a file path and returns the parts. "
      <> "The extension, if present, includes the leading separator; "
      <> "if the path has no extension, then the empty string is returned "
      <> "as the extension.")
  `since` initialVersion

-- | Wraps function @'Path.splitSearchPath'@.
split_search_path :: LuaError e => DocumentedFunction e
split_search_path = defun "split_search_path"
  ### liftPure Path.splitSearchPath
  <#> Parameter
      { parameterPeeker = peekString
      , parameterDoc = ParameterDoc
        { parameterName = "search_path"
        , parameterType = "string"
        , parameterDescription = "platform-specific search path"
        , parameterIsOptional = False
        }
      }
  =#> filepathListResult "list of directories in search path"
  #? ("Takes a string and splits it on the `search_path_separator` "
      <> "character. Blank items are ignored on Windows, "
      <> "and converted to `.` on Posix. "
      <> "On Windows path elements are stripped of quotes.")
  `since` initialVersion

-- | Join two paths with a directory separator. Wraps @'Path.combine'@.
combine :: DocumentedFunction e
combine = defun "combine"
  ### liftPure2 Path.combine
  <#> filepathParam
  <#> filepathParam
  =#> filepathResult "combined paths"
  #? "Combine two paths with a path separator."

-- | Adds an extension to a file path. Wraps @'Path.addExtension'@.
add_extension :: DocumentedFunction e
add_extension = defun "add_extension"
  ### liftPure2 Path.addExtension
  <#> filepathParam
  <#> Parameter
      { parameterPeeker = peekString
      , parameterDoc = ParameterDoc
        { parameterName = "extension"
        , parameterType = "string"
        , parameterDescription = "an extension, with or without separator dot"
        , parameterIsOptional = False
        }
      }
  =#> filepathResult "filepath with extension"
  #? "Adds an extension, even if there is already one."
  `since` initialVersion

stringAugmentationFunctions :: LuaError e => [DocumentedFunction e]
stringAugmentationFunctions =
  [ directory
  , filename
  , is_absolute
  , is_relative
  , normalize
  , split
  , split_extension
  , split_search_path
  ]

treat_strings_as_paths :: LuaError e => DocumentedFunction e
treat_strings_as_paths = defun "treat_strings_as_paths"
  ### do let addFunction fn = do
                 pushName (functionName fn)
                 pushDocumentedFunction fn
                 rawset (nth 3)
         -- for some reason we can't just dump all functions into the
         -- string metatable, but have to use the string module for
         -- non-metamethods.
         pushString "" *> getmetatable top *> remove (nth 2)
         mapM_ addFunction
           [ setName add_extension "__add", setName combine "__div"]
         pop 1  -- string metatable

         _ <- getglobal "string"
         mapM_ addFunction stringAugmentationFunctions
         pop 1 -- string module
  =#> []
  #? ("Augment the string module such that strings can be used as "
      <> "path objects.")
  `since` initialVersion

--
-- Parameters
--

-- | Retrieves a file path from the stack.
peekFilePath :: Peeker e FilePath
peekFilePath = peekString

-- | Filepath function parameter.
filepathParam :: Parameter e FilePath
filepathParam = parameter peekFilePath "string" "filepath" "path"

-- | Result of a function returning a file path.
filepathResult :: Text -- ^ Description
               -> FunctionResults e FilePath
filepathResult = stringResult

-- | List of filepaths function result.
filepathListResult :: LuaError e
                   => Text -- ^ Description
                   -> FunctionResults e [FilePath]
filepathListResult = functionResult (pushList pushString) "{string,...}"

--
-- Helpers
--

-- | Alternative version of @'Path.makeRelative'@, which introduces @..@
-- paths if desired.
makeRelative :: FilePath      -- ^ path to be made relative
             -> FilePath      -- ^ root directory from which to start
             -> Maybe Bool    -- ^ whether to use unsafe relative paths.
             -> FilePath
makeRelative path root (Just True)
 | Path.equalFilePath root path = "."
 | Path.takeDrive root /= Path.takeDrive path = path
 | otherwise =
   let toParts = Path.splitDirectories . Path.normalise
       go (pp:pps) (rp:rps)
         | pp == rp = go pps rps
       go pps rps
         = Path.joinPath $ replicate (length rps) ".." ++ pps
   in go (toParts path) (toParts root)
makeRelative path root _unsafe = Path.makeRelative root path

-- | First published version of this library.
initialVersion :: Version
initialVersion = makeVersion [0,1,0]
