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, 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.Megaparsec.Char as P
import qualified Text.PrettyPrint.ANSI.Leijen as PP
type PParser = Parser PkgDesc
parseDesc :: FilePath -> IO PkgDesc
parseDesc fp = do
when (not $ 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"
filename :: Parsing m => m String
filename = (do
filename <- stringLiteral
<|> show <$> iName []
case filenameErrorMessage filename of
Just errorMessage -> fail errorMessage
Nothing -> return filename)
<?> "filename"
where
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"
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 (\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 identifier) (\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 })