{-# 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"
filename :: Parsing m => m String
filename :: forall (m :: * -> *). Parsing m => m String
filename = (do
String
filename <- forall (m :: * -> *). Parsing m => m String
stringLiteral
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
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 })