{-|
Module      : Idris.Package.Parser
Description : `iPKG` file parser and package description information.

License     : BSD3
Maintainer  : The Idris Community.
-}
{-# LANGUAGE FlexibleContexts #-}
module Idris.Package.Parser where

import Idris.CmdOptions
import Idris.Imports
import Idris.Options (Opt)
import Idris.Package.Common
import Idris.Parser (moduleName)
import Idris.Parser.Helpers (Parser, Parsing, eol, iName, identifier,
                             identifierWithExtraChars, isEol, lchar,
                             packageName, parseErrorDoc, reserved, runparser,
                             someSpace, stringLiteral)

import Control.Applicative
import Control.Monad.State.Strict
import Data.List (union)
import qualified Options.Applicative as Opts
import System.Directory (doesFileExist)
import System.Exit
import System.FilePath (isValid, takeExtension, takeFileName)
import Text.Megaparsec ((<?>))
import qualified Text.Megaparsec as P
import qualified Text.PrettyPrint.ANSI.Leijen as PP

type PParser = Parser PkgDesc

parseDesc :: FilePath -> IO PkgDesc
parseDesc fp = do
    unless (takeExtension fp == ".ipkg") $ do
        putStrLn $ unwords ["The presented iPKG file does not have a '.ipkg' extension:", show fp]
        exitWith (ExitFailure 1)
    res <- doesFileExist fp
    if res
      then do
        p <- readFile fp
        case runparser pPkg defaultPkg fp p of
          Left err -> fail (show $ PP.plain $ parseErrorDoc err)
          Right x -> return x
      else do
        putStrLn $ unwords [ "The presented iPKG file does not exist:", show fp]
        exitWith (ExitFailure 1)

pPkg :: PParser PkgDesc
pPkg = do
    reserved "package"
    p <- pPkgName
    someSpace
    modify $ \st -> st { pkgname = p }
    some pClause
    st <- get
    P.eof
    return st

pPkgName :: PParser PkgName
pPkgName = (either fail pure . pkgName =<< packageName) <?> "PkgName"

-- | Parses a filename.
-- |
-- | Treated for now as an identifier or a double-quoted string.
filename :: Parsing m => m String
filename = (do
                -- Treat a double-quoted string as a filename to support spaces.
                -- This also moves away from tying filenames to identifiers, so
                -- it will also accept hyphens
                -- (https://github.com/idris-lang/Idris-dev/issues/2721)
    filename <- stringLiteral
                -- Through at least version 0.9.19.1, IPKG executable values were
                -- possibly namespaced identifiers, like foo.bar.baz.
            <|> show <$> iName []
    case filenameErrorMessage filename of
      Just errorMessage -> fail errorMessage
      Nothing -> return filename)
    <?> "filename"
    where
        -- TODO: Report failing span better! We could lookAhead,
        -- or do something with DeltaParsing?
        filenameErrorMessage :: FilePath -> Maybe String
        filenameErrorMessage path = either Just (const Nothing) $ do
            checkEmpty path
            checkValid path
            checkNoDirectoryComponent path
            where
                checkThat ok message =
                    if ok then Right () else Left message

                checkEmpty path =
                    checkThat (path /= "") "filename must not be empty"

                checkValid path =
                    checkThat (System.FilePath.isValid path)
                        "filename must contain only valid characters"

                checkNoDirectoryComponent path =
                    checkThat (path == takeFileName path)
                        "filename must contain no directory component"

textUntilEol :: Parsing m => m String
textUntilEol = many (P.satisfy (not . isEol)) <* eol <* someSpace

clause          :: String -> PParser a -> (PkgDesc -> a -> PkgDesc) -> PParser ()
clause name p f = do value <- reserved name *> lchar '=' *> p <* someSpace
                     modify $ \st -> f st value

commaSep   :: Parsing m => m a -> m [a]
commaSep p = P.sepBy1 p (lchar ',')

pOptions :: PParser [Opt]
pOptions = do
  str <- stringLiteral
  case execArgParserPure (words str) of
    Opts.Success a -> return a
    Opts.Failure e -> fail $ fst $ Opts.renderFailure e ""
    _              -> fail "Unexpected error"

libIdentifier :: Parsing m => m String
libIdentifier = identifierWithExtraChars "_'-."

pClause :: PParser ()
pClause = clause "executable" filename (\st v -> st { execout = Just v })
      <|> clause "main" (iName []) (\st v -> st { idris_main = Just v })
      <|> clause "sourcedir" (identifier <|> stringLiteral) (\st v -> st { sourcedir = v })
      <|> clause "opts" pOptions (\st v -> st { idris_opts = v ++ idris_opts st })
      <|> clause "pkgs" (commaSep (pPkgName <* someSpace)) (\st ps ->
             let pkgs = pureArgParser $ concatMap (\x -> ["-p", show x]) ps
             in st { pkgdeps    = ps `union` pkgdeps st
                   , idris_opts = pkgs ++ idris_opts st })
      <|> clause "modules" (commaSep moduleName) (\st v -> st { modules = modules st ++ v })
      <|> clause "libs" (commaSep libIdentifier) (\st v -> st { libdeps = libdeps st ++ v })
      <|> clause "objs" (commaSep identifier) (\st v -> st { objs = objs st ++ v })
      <|> clause "makefile" (iName []) (\st v -> st { makefile = Just (show v) })
      <|> clause "tests" (commaSep (iName [])) (\st v -> st { idris_tests = idris_tests st ++ v })
      <|> clause "version" textUntilEol (\st v -> st { pkgversion = Just v })
      <|> clause "readme" textUntilEol (\st v -> st { pkgreadme = Just v })
      <|> clause "license" textUntilEol (\st v -> st { pkglicense = Just v })
      <|> clause "homepage" textUntilEol (\st v -> st { pkghomepage = Just v })
      <|> clause "sourceloc" textUntilEol (\st v -> st { pkgsourceloc = Just v })
      <|> clause "bugtracker" textUntilEol (\st v -> st { pkgbugtracker = Just v })
      <|> clause "brief" stringLiteral (\st v -> st { pkgbrief = Just v })
      <|> clause "author" textUntilEol (\st v -> st { pkgauthor = Just v })
      <|> clause "maintainer" textUntilEol (\st v -> st { pkgmaintainer = Just v })