{-|
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 :: String -> IO PkgDesc
parseDesc String
fp = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> String
takeExtension String
fp forall a. Eq a => a -> a -> Bool
== String
".ipkg") forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"The presented iPKG file does not have a '.ipkg' extension:", forall a. Show a => a -> String
show String
fp]
        forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
    Bool
res <- String -> IO Bool
doesFileExist String
fp
    if Bool
res
      then do
        String
p <- String -> IO String
readFile String
fp
        case forall st res.
Parser st res -> st -> String -> String -> Either ParseError res
runparser PParser PkgDesc
pPkg PkgDesc
defaultPkg String
fp String
p of
          Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Doc -> Doc
PP.plain forall a b. (a -> b) -> a -> b
$ ParseError -> Doc
parseErrorDoc ParseError
err)
          Right PkgDesc
x -> forall (m :: * -> *) a. Monad m => a -> m a
return PkgDesc
x
      else do
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [ String
"The presented iPKG file does not exist:", forall a. Show a => a -> String
show String
fp]
        forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)

pPkg :: PParser PkgDesc
pPkg :: PParser PkgDesc
pPkg = do
    forall (m :: * -> *). Parsing m => String -> m ()
reserved String
"package"
    PkgName
p <- PParser PkgName
pPkgName
    forall (m :: * -> *). Parsing m => m ()
someSpace
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PkgDesc
st -> PkgDesc
st { pkgname :: PkgName
pkgname = PkgName
p }
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
some StateT PkgDesc (WriterT FC (Parsec Void String)) ()
pClause
    PkgDesc
st <- forall s (m :: * -> *). MonadState s m => m s
get
    forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
    forall (m :: * -> *) a. Monad m => a -> m a
return PkgDesc
st

pPkgName :: PParser PkgName
pPkgName :: PParser PkgName
pPkgName = (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String PkgName
pkgName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Parsing m => m String
packageName) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"PkgName"

-- | Parses a filename.
-- |
-- | Treated for now as an identifier or a double-quoted string.
filename :: Parsing m => m String
filename :: forall (m :: * -> *). 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)
    String
filename <- forall (m :: * -> *). Parsing m => m String
stringLiteral
                -- Through at least version 0.9.19.1, IPKG executable values were
                -- possibly namespaced identifiers, like foo.bar.baz.
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Parsing m => [String] -> m Name
iName []
    case String -> Maybe String
filenameErrorMessage String
filename of
      Just String
errorMessage -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMessage
      Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return String
filename)
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"filename"
    where
        -- TODO: Report failing span better! We could lookAhead,
        -- or do something with DeltaParsing?
        filenameErrorMessage :: FilePath -> Maybe String
        filenameErrorMessage :: String -> Maybe String
filenameErrorMessage String
path = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ do
            String -> Either String ()
checkEmpty String
path
            String -> Either String ()
checkValid String
path
            String -> Either String ()
checkNoDirectoryComponent String
path
            where
                checkThat :: Bool -> a -> Either a ()
checkThat Bool
ok a
message =
                    if Bool
ok then forall a b. b -> Either a b
Right () else forall a b. a -> Either a b
Left a
message

                checkEmpty :: String -> Either String ()
checkEmpty String
path =
                    forall {a}. Bool -> a -> Either a ()
checkThat (String
path forall a. Eq a => a -> a -> Bool
/= String
"") String
"filename must not be empty"

                checkValid :: String -> Either String ()
checkValid String
path =
                    forall {a}. Bool -> a -> Either a ()
checkThat (String -> Bool
System.FilePath.isValid String
path)
                        String
"filename must contain only valid characters"

                checkNoDirectoryComponent :: String -> Either String ()
checkNoDirectoryComponent String
path =
                    forall {a}. Bool -> a -> Either a ()
checkThat (String
path forall a. Eq a => a -> a -> Bool
== String -> String
takeFileName String
path)
                        String
"filename must contain no directory component"

textUntilEol :: Parsing m => m String
textUntilEol :: forall (m :: * -> *). Parsing m => m String
textUntilEol = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEol)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
eol forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
someSpace

clause          :: String -> PParser a -> (PkgDesc -> a -> PkgDesc) -> PParser ()
clause :: forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
name PParser a
p PkgDesc -> a -> PkgDesc
f = do a
value <- forall (m :: * -> *). Parsing m => String -> m ()
reserved String
name forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). Parsing m => Char -> m Char
lchar Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PParser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
someSpace
                     forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \PkgDesc
st -> PkgDesc -> a -> PkgDesc
f PkgDesc
st a
value

commaSep   :: Parsing m => m a -> m [a]
commaSep :: forall (m :: * -> *) a. Parsing m => m a -> m [a]
commaSep m a
p = forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 m a
p (forall (m :: * -> *). Parsing m => Char -> m Char
lchar Char
',')

pOptions :: PParser [Opt]
pOptions :: PParser [Opt]
pOptions = do
  String
str <- forall (m :: * -> *). Parsing m => m String
stringLiteral
  case [String] -> ParserResult [Opt]
execArgParserPure (String -> [String]
words String
str) of
    Opts.Success [Opt]
a -> forall (m :: * -> *) a. Monad m => a -> m a
return [Opt]
a
    Opts.Failure ParserFailure ParserHelp
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ParserFailure ParserHelp -> String -> (String, ExitCode)
Opts.renderFailure ParserFailure ParserHelp
e String
""
    ParserResult [Opt]
_              -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected error"

libIdentifier :: Parsing m => m String
libIdentifier :: forall (m :: * -> *). Parsing m => m String
libIdentifier = forall (m :: * -> *). Parsing m => String -> m String
identifierWithExtraChars String
"_'-."

pClause :: PParser ()
pClause :: StateT PkgDesc (WriterT FC (Parsec Void String)) ()
pClause = forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"executable" forall (m :: * -> *). Parsing m => m String
filename (\PkgDesc
st String
v -> PkgDesc
st { execout :: Maybe String
execout = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"main" (forall (m :: * -> *). Parsing m => [String] -> m Name
iName []) (\PkgDesc
st Name
v -> PkgDesc
st { idris_main :: Maybe Name
idris_main = forall a. a -> Maybe a
Just Name
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"sourcedir" (forall (m :: * -> *). Parsing m => m String
identifier forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). Parsing m => m String
stringLiteral) (\PkgDesc
st String
v -> PkgDesc
st { sourcedir :: String
sourcedir = String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"opts" PParser [Opt]
pOptions (\PkgDesc
st [Opt]
v -> PkgDesc
st { idris_opts :: [Opt]
idris_opts = [Opt]
v forall a. [a] -> [a] -> [a]
++ PkgDesc -> [Opt]
idris_opts PkgDesc
st })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"pkgs" (forall (m :: * -> *) a. Parsing m => m a -> m [a]
commaSep (PParser PkgName
pPkgName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). Parsing m => m ()
someSpace)) (\PkgDesc
st [PkgName]
ps ->
             let pkgs :: [Opt]
pkgs = [String] -> [Opt]
pureArgParser forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\PkgName
x -> [String
"-p", forall a. Show a => a -> String
show PkgName
x]) [PkgName]
ps
             in PkgDesc
st { pkgdeps :: [PkgName]
pkgdeps    = [PkgName]
ps forall a. Eq a => [a] -> [a] -> [a]
`union` PkgDesc -> [PkgName]
pkgdeps PkgDesc
st
                   , idris_opts :: [Opt]
idris_opts = [Opt]
pkgs forall a. [a] -> [a] -> [a]
++ PkgDesc -> [Opt]
idris_opts PkgDesc
st })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"modules" (forall (m :: * -> *) a. Parsing m => m a -> m [a]
commaSep forall (m :: * -> *). Parsing m => m Name
moduleName) (\PkgDesc
st [Name]
v -> PkgDesc
st { modules :: [Name]
modules = PkgDesc -> [Name]
modules PkgDesc
st forall a. [a] -> [a] -> [a]
++ [Name]
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"libs" (forall (m :: * -> *) a. Parsing m => m a -> m [a]
commaSep forall (m :: * -> *). Parsing m => m String
libIdentifier) (\PkgDesc
st [String]
v -> PkgDesc
st { libdeps :: [String]
libdeps = PkgDesc -> [String]
libdeps PkgDesc
st forall a. [a] -> [a] -> [a]
++ [String]
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"objs" (forall (m :: * -> *) a. Parsing m => m a -> m [a]
commaSep forall (m :: * -> *). Parsing m => m String
identifier) (\PkgDesc
st [String]
v -> PkgDesc
st { objs :: [String]
objs = PkgDesc -> [String]
objs PkgDesc
st forall a. [a] -> [a] -> [a]
++ [String]
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"makefile" (forall (m :: * -> *). Parsing m => [String] -> m Name
iName []) (\PkgDesc
st Name
v -> PkgDesc
st { makefile :: Maybe String
makefile = forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show Name
v) })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"tests" (forall (m :: * -> *) a. Parsing m => m a -> m [a]
commaSep (forall (m :: * -> *). Parsing m => [String] -> m Name
iName [])) (\PkgDesc
st [Name]
v -> PkgDesc
st { idris_tests :: [Name]
idris_tests = PkgDesc -> [Name]
idris_tests PkgDesc
st forall a. [a] -> [a] -> [a]
++ [Name]
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"version" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkgversion :: Maybe String
pkgversion = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"readme" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkgreadme :: Maybe String
pkgreadme = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"license" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkglicense :: Maybe String
pkglicense = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"homepage" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkghomepage :: Maybe String
pkghomepage = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"sourceloc" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkgsourceloc :: Maybe String
pkgsourceloc = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"bugtracker" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkgbugtracker :: Maybe String
pkgbugtracker = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"brief" forall (m :: * -> *). Parsing m => m String
stringLiteral (\PkgDesc
st String
v -> PkgDesc
st { pkgbrief :: Maybe String
pkgbrief = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"author" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkgauthor :: Maybe String
pkgauthor = forall a. a -> Maybe a
Just String
v })
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a.
String
-> PParser a
-> (PkgDesc -> a -> PkgDesc)
-> StateT PkgDesc (WriterT FC (Parsec Void String)) ()
clause String
"maintainer" forall (m :: * -> *). Parsing m => m String
textUntilEol (\PkgDesc
st String
v -> PkgDesc
st { pkgmaintainer :: Maybe String
pkgmaintainer = forall a. a -> Maybe a
Just String
v })