<commit_before>{-# LANGUAGE CPP #-}
module Pkg.Package where

import System.Process
import System.Directory
import System.Exit
import System.IO
import System.FilePath ((</>), addTrailingPathSeparator, takeFileName, takeDirectory, normalise)
import System.Directory (createDirectoryIfMissing, copyFile)

import Util.System

import Control.Monad
import Control.Monad.Trans.State.Strict (execStateT)
import Control.Monad.Error (runErrorT)

import Data.List
import Data.List.Split(splitOn)

import Idris.Core.TT
import Idris.REPL
import Idris.Parser (loadModule)
import Idris.Output (pshow)
import Idris.AbsSyntax
import Idris.IdrisDoc
import Idris.Output

import IRTS.System

import Pkg.PParser

-- To build a package:
-- * read the package description
-- * check all the library dependencies exist
-- * invoke the makefile if there is one
-- * invoke idris on each module, with idris_opts
-- * install everything into datadir/pname, if install flag is set

-- | Run the package through the idris compiler.
buildPkg :: Bool -> (Bool, FilePath) -> IO ()
buildPkg warnonly (install, fp)
     = do pkgdesc <- parseDesc fp
          ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
          when (and ok) $
            do dir <- getCurrentDirectory
               setCurrentDirectory $ dir </> sourcedir pkgdesc
               make (makefile pkgdesc)
               m_ist <- case (execout pkgdesc) of
                   Nothing -> buildMods (NoREPL : Verbose : idris_opts pkgdesc)
                                    (modules pkgdesc)
                   Just o -> do let exec = dir </> o
                                buildMods
                                    (NoREPL : Verbose : Output exec : idris_opts pkgdesc)
                                    [idris_main pkgdesc]
               setCurrentDirectory dir
               case m_ist of
                    Nothing -> exitWith (ExitFailure 1)
                    Just ist -> do
                       -- Quit with error code if there was a problem
                       case errSpan ist of
                            Just _ -> exitWith (ExitFailure 1)
                            _ -> return ()
                       -- Also give up if there are metavariables to solve
                       case (map fst (idris_metavars ist) \\ primDefs) of
                            _ -> when install $ installPkg pkgdesc
--                             ms -> do if install 
--                                         then putStrLn "Can't install: there are undefined metavariables:"
--                                         else putStrLn "There are undefined metavariables:"
--                                      putStrLn $ "\t" ++ show ms 
--                                      exitWith (ExitFailure 1)

-- | Type check packages only
--
-- This differs from build in that executables are not built, if the
-- package contains an executable.
checkPkg :: Bool         -- ^ Show Warnings
            -> Bool      -- ^ quit on failure
            -> FilePath  -- ^ Path to ipkg file.
            -> IO ()
checkPkg warnonly quit fpath
  = do pkgdesc <- parseDesc fpath
       ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
       when (and ok) $
         do dir <- getCurrentDirectory
            setCurrentDirectory $ dir </> sourcedir pkgdesc
            make (makefile pkgdesc)
            res <- buildMods (NoREPL : Verbose : idris_opts pkgdesc)
                             (modules pkgdesc)
            setCurrentDirectory dir
            when quit $ case res of
                          Nothing -> exitWith (ExitFailure 1)
                          Just res' -> do
                            case errSpan res' of
                              Just _ -> exitWith (ExitFailure 1)
                              _ -> return ()

-- | Check a package and start a REPL
replPkg :: FilePath -> Idris ()
replPkg fp = do orig <- getIState
                runIO $ checkPkg False False fp
                pkgdesc <- runIO $ parseDesc fp -- bzzt, repetition!
                let opts = idris_opts pkgdesc
                let mod = idris_main pkgdesc
                let f = toPath (showCG mod)
                putIState orig
                dir <- runIO $ getCurrentDirectory
                runIO $ setCurrentDirectory $ dir </> sourcedir pkgdesc

                if (f /= "")
                   then idrisMain ((Filename f) : opts) 
                   else iputStrLn "Can't start REPL: no main module given"
                runIO $ setCurrentDirectory dir

    where toPath n = foldl1' (</>) $ splitOn "." n

-- | Clean Package build files
cleanPkg :: FilePath -- ^ Path to ipkg file.
         -> IO ()
cleanPkg fp
     = do pkgdesc <- parseDesc fp
          dir <- getCurrentDirectory
          setCurrentDirectory $ dir </> sourcedir pkgdesc
          clean (makefile pkgdesc)
          mapM_ rmIBC (modules pkgdesc)
          case execout pkgdesc of
               Nothing -> return ()
               Just s -> rmFile $ dir </> s

-- | Generate IdrisDoc for package
-- TODO: Handle case where module does not contain a matching namespace
--       E.g. from prelude.ipkg: IO, Prelude.Chars, Builtins
documentPkg :: FilePath -- ^ Path to .ipkg file.
            -> IO ()
documentPkg fp =
  do pkgdesc        <- parseDesc fp
     cd             <- getCurrentDirectory
     let pkgDir      = cd </> takeDirectory fp
         outputDir   = cd </> (pkgname pkgdesc) ++ "_doc"
         opts        = NoREPL : Verbose : idris_opts pkgdesc
         mods        = modules pkgdesc
         fs          = map (foldl1' (</>) . splitOn "." . showCG) mods
     setCurrentDirectory $ pkgDir </> sourcedir pkgdesc
     make (makefile pkgdesc)
     setCurrentDirectory $ pkgDir
     let run l       = runErrorT . (execStateT l)
         load []     = return () 
         load (f:fs) = do loadModule f; load fs
         loader      = do idrisMain opts; load fs
     idrisInstance  <- run loader idrisInit
     setCurrentDirectory cd
     case idrisInstance of
          Left  err -> do putStrLn $ pshow idrisInit err; exitWith (ExitFailure 1)
          Right ist ->
                do docRes <- generateDocs ist mods outputDir
                   case docRes of
                        Right _  -> return ()
                        Left msg -> do putStrLn msg<commit_msg>Added TODO found in Package.hs<commit_after>{-# LANGUAGE CPP #-}
module Pkg.Package where

import System.Process
import System.Directory
import System.Exit
import System.IO
import System.FilePath ((</>), addTrailingPathSeparator, takeFileName, takeDirectory, normalise)
import System.Directory (createDirectoryIfMissing, copyFile)

import Util.System

import Control.Monad
import Control.Monad.Trans.State.Strict (execStateT)
import Control.Monad.Error (runErrorT)

import Data.List
import Data.List.Split(splitOn)

import Idris.Core.TT
import Idris.REPL
import Idris.Parser (loadModule)
import Idris.Output (pshow)
import Idris.AbsSyntax
import Idris.IdrisDoc
import Idris.Output

import IRTS.System

import Pkg.PParser

-- To build a package:
-- * read the package description
-- * check all the library dependencies exist
-- * invoke the makefile if there is one
-- * invoke idris on each module, with idris_opts
-- * install everything into datadir/pname, if install flag is set

-- | Run the package through the idris compiler.
buildPkg :: Bool -> (Bool, FilePath) -> IO ()
buildPkg warnonly (install, fp)
     = do pkgdesc <- parseDesc fp
          ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
          when (and ok) $
            do dir <- getCurrentDirectory
               setCurrentDirectory $ dir </> sourcedir pkgdesc
               make (makefile pkgdesc)
               m_ist <- case (execout pkgdesc) of
                   Nothing -> buildMods (NoREPL : Verbose : idris_opts pkgdesc)
                                    (modules pkgdesc)
                   Just o -> do let exec = dir </> o
                                buildMods
                                    (NoREPL : Verbose : Output exec : idris_opts pkgdesc)
                                    [idris_main pkgdesc]
               setCurrentDirectory dir
               case m_ist of
                    Nothing -> exitWith (ExitFailure 1)
                    Just ist -> do
                       -- Quit with error code if there was a problem
                       case errSpan ist of
                            Just _ -> exitWith (ExitFailure 1)
                            _ -> return ()
                       -- Also give up if there are metavariables to solve
                       case (map fst (idris_metavars ist) \\ primDefs) of
                            _ -> when install $ installPkg pkgdesc
--                             ms -> do if install
--                                         then putStrLn "Can't install: there are undefined metavariables:"
--                                         else putStrLn "There are undefined metavariables:"
--                                      putStrLn $ "\t" ++ show ms
--                                      exitWith (ExitFailure 1)

-- | Type check packages only
--
-- This differs from build in that executables are not built, if the
-- package contains an executable.
checkPkg :: Bool         -- ^ Show Warnings
            -> Bool      -- ^ quit on failure
            -> FilePath  -- ^ Path to ipkg file.
            -> IO ()
checkPkg warnonly quit fpath
  = do pkgdesc <- parseDesc fpath
       ok <- mapM (testLib warnonly (pkgname pkgdesc)) (libdeps pkgdesc)
       when (and ok) $
         do dir <- getCurrentDirectory
            setCurrentDirectory $ dir </> sourcedir pkgdesc
            make (makefile pkgdesc)
            res <- buildMods (NoREPL : Verbose : idris_opts pkgdesc)
                             (modules pkgdesc)
            setCurrentDirectory dir
            when quit $ case res of
                          Nothing -> exitWith (ExitFailure 1)
                          Just res' -> do
                            case errSpan res' of
                              Just _ -> exitWith (ExitFailure 1)
                              _ -> return ()

-- | Check a package and start a REPL
replPkg :: FilePath -> Idris ()
replPkg fp = do orig <- getIState
                runIO $ checkPkg False False fp
                pkgdesc <- runIO $ parseDesc fp -- bzzt, repetition!
                let opts = idris_opts pkgdesc
                let mod = idris_main pkgdesc
                let f = toPath (showCG mod)
                putIState orig
                dir <- runIO $ getCurrentDirectory
                runIO $ setCurrentDirectory $ dir </> sourcedir pkgdesc

                if (f /= "")
                   then idrisMain ((Filename f) : opts)
                   else iputStrLn "Can't start REPL: no main module given"
                runIO $ setCurrentDirectory dir

    where toPath n = foldl1' (</>) $ splitOn "." n

-- | Clean Package build files
cleanPkg :: FilePath -- ^ Path to ipkg file.
         -> IO ()
cleanPkg fp
     = do pkgdesc <- parseDesc fp
          dir <- getCurrentDirectory
          setCurrentDirectory $ dir </> sourcedir pkgdesc
          clean (makefile pkgdesc)
          mapM_ rmIBC (modules pkgdesc)
          case execout pkgdesc of
               Nothing -> return ()
               Just s -> rmFile $ dir </> s

-- | Generate IdrisDoc for package
-- TODO: Handle case where module does not contain a matching namespace
--       E.g. from prelude.ipkg: IO, Prelude.Chars, Builtins
--
-- Issue number #1572 on the issue tracker
--       https://github.com/idris-lang/Idris-dev/issues/1572
documentPkg :: FilePath -- ^ Path to .ipkg file.
            -> IO ()
documentPkg fp =
  do pkgdesc        <- parseDesc fp
     cd             <- getCurrentDirectory
     let pkgDir      = cd </> takeDirectory fp
         outputDir   = cd </> (pkgname pkgdesc) ++ "_doc"
         opts        = NoREPL : Verbose : idris_opts pkgdesc
         mods        = modules pkgdesc
         fs          = map (foldl1' (</>) . splitOn "." . showCG) mods
     setCurrentDirectory $ pkgDir </> sourcedir pkgdesc
     make (makefile pkgdesc)
     setCurrentDirectory $ pkgDir
     let run l       = runErrorT . (execStateT l)
         load []     = return ()
         load (f:fs) = do loadModule f; load fs
         loader      = do idrisMain opts; load fs
     idrisInstance  <- run loader idrisInit
     setCurrentDirectory cd
     case idrisInstance of
          Left  err -> do putStrLn $ pshow idrisInit err; exitWith (ExitFailure 1)
          Right ist ->
                do docRes <- generateDocs ist mods outputDir
                   case docRes of
                        Right _  -> return ()
                        Left msg -> do putStrLn msg
{'fraction_non_alphanumeric': 0.07650187734668336, 'fraction_numerical': 0.0018773466833541927, 'mean_word_length': 1.516732283464567, 'pattern_counts': {'":': 0, '<': 61, '<?xml version=': 0, '>': 79, 'https://': 1, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 18, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7417374', 'n_tokens_mistral': 3500, 'n_tokens_neox': 3260, 'n_words': 1163}