├── .codeclimate.yml ├── .gitignore ├── LICENSE ├── README.md ├── _config.yml ├── bin ├── linux │ └── needit └── win │ └── needit.exe ├── image.png └── src ├── DEPENDENCIES ├── Main.hs └── NeedIt.hs /.codeclimate.yml: -------------------------------------------------------------------------------- 1 | engines: 2 | duplication: 3 | enabled: true 4 | config: 5 | languages: 6 | - haskell 7 | 8 | ratings: 9 | paths: 10 | - "**.hs" 11 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | advpl_modules/ 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 NG Informática 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # NeedIt 2 | 3 | > The awesome package manager for AdvPL! 4 | 5 | NeedIt is a fast and simple and concise package manager for TOTVS AdvPL written in Haskell with support for submodules. It is made to run concurrently with a big focus on performance. Transform your applications in libraries and host them on Github. Import them and compile on your environment! 6 | 7 | ## Usage 8 | 9 | `needit` 10 | 11 | It'll look for a `DEPENDENCIES` file on your root and install its packages 12 | 13 | ![Example](./image.png) 14 | 15 | ## Meta-syntax 16 | 17 | NeedIt provides a small DSL to create your packages, like: 18 | 19 | ```haskell 20 | PACKAGE example 21 | FROM https://github.com/ 22 | 23 | NEEDS nginformatica/prelude-advpl 24 | NEEDS nginformatica/advpl-string-builder 25 | NEEDS nginformatica/json-advpl 26 | ``` 27 | 28 | You can also use the module `NeedIt.hs` to write your own integration. 29 | -------------------------------------------------------------------------------- /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-merlot -------------------------------------------------------------------------------- /bin/linux/needit: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nginformatica/needit/d22524ccbe3a997430237f5b2feb46f6fa5b2813/bin/linux/needit -------------------------------------------------------------------------------- /bin/win/needit.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nginformatica/needit/d22524ccbe3a997430237f5b2feb46f6fa5b2813/bin/win/needit.exe -------------------------------------------------------------------------------- /image.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nginformatica/needit/d22524ccbe3a997430237f5b2feb46f6fa5b2813/image.png -------------------------------------------------------------------------------- /src/DEPENDENCIES: -------------------------------------------------------------------------------- 1 | PACKAGE needit 2 | 3 | FROM https://github.com/ 4 | 5 | NEEDS nginformatica/prelude-advpl 6 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | import NeedIt 3 | import System.Console.ANSI 4 | import Control.Concurrent.Async (mapConcurrently) 5 | import System.FilePath 6 | import System.Directory 7 | 8 | data Msg = Info String 9 | | Success String 10 | | Error String 11 | 12 | cfg :: Configuration 13 | cfg = Configuration { basepath = "./", 14 | repository = Self } 15 | 16 | nop :: IO () 17 | nop = return () 18 | 19 | printColored :: Color -> String -> IO () 20 | printColored c msg = setSGR [SetColor Foreground Vivid c] 21 | >> putStrLn (" · " ++ msg) 22 | >> setSGR [Reset] 23 | 24 | withMessage :: IO a -> Msg -> IO () 25 | withMessage io (Info info) = io >> printColored Blue info 26 | withMessage io (Success msg) = io >> printColored Green msg 27 | withMessage io (Error err) = io >> printColored Red err 28 | 29 | intro :: IO () 30 | intro = setSGR [SetColor Foreground Vivid Magenta] 31 | >> renderLogo 32 | >> setSGR [SetColor Foreground Vivid Cyan] 33 | >> putStrLn "NeedIt AdvPL v0.1" 34 | >> setSGR [Reset] 35 | 36 | main = intro >> existDepsFolder cfg >>= \existance -> case existance of 37 | True -> clearDeps cfg `withMessage` (Info "Cleaning advpl_modules...") 38 | False -> nop 39 | >> createDepsFolder cfg `withMessage` (Info "Creating dependencies folder...") 40 | >> existDepsFile cfg >>= \existance -> case existance of 41 | True -> parseAndInstall cfg `withMessage` (Info "DONE") 42 | False -> clearDeps cfg 43 | >> nop `withMessage` (Error "DEPENDENCIES file not found") 44 | 45 | parseAndInstall cfg = putStrLn (show cfg) >> readDeps cfg >>= \src -> case linesToTuples src of 46 | Left (msg, line) -> nop `withMessage` (Error $ msg ++ " on line " ++ (show line)) 47 | Right tuples -> case catchSemanticErrors tuples of 48 | Just err -> nop `withMessage` (Error err) 49 | Nothing -> nop `withMessage` (Success "DEPENDENCIES file seems to be CORRECT") 50 | >> (putStr . show) depContent 51 | >> nop `withMessage` (Info "Fetching and installing packages concurrently...") 52 | >> (mapConcurrently download depList >> nop) 53 | where depContent = tuplesToDepContent tuples 54 | depList = listDependencies depContent 55 | download dep@(pkg, url, file) = 56 | (downloadDep dep >> nop `withMessage` (Success $ "Downloaded " ++ pkg)) 57 | >> return Configuration { basepath = "./advpl_modules", repository = External file } 58 | >>= \cfg -> do 59 | let filepath = getPathFor cfg 60 | unzipFile filepath 61 | let basename = joinPath ["./", "advpl_modules/", tail (dropWhile (/= '/') pkg) ++ "-master"] 62 | let newCfg = Configuration { basepath = basename, repository = repository cfg } 63 | nop `withMessage` (Info $ "Looking for subrepositories for " ++ pkg) 64 | hasSub <- existDepsFile newCfg 65 | nop `withMessage` (Info $ "Has subrepositories? " ++ (show hasSub)) 66 | nop `withMessage` (Success $ "Installed " ++ pkg) 67 | if hasSub then (parseAndInstall newCfg `withMessage` (Success $ "Installed subpackages for " ++ pkg)) 68 | else nop 69 | return () 70 | >> dropModule file 71 | >> nop `withMessage` (Success "Successfully installed all packages") 72 | 73 | dropModule :: String -> IO () 74 | dropModule name = removeFile $ joinPath ["advpl_modules", name] 75 | 76 | renderLogo :: IO () 77 | renderLogo = mapM_ putStrLn [ " _ _ _ ___ _ " 78 | , "| \\ | | ___ ___ __| |_ _| |_ " 79 | , "| \\| |/ _ \\/ _ \\/ _` || || __|" 80 | , "| |\\ | __/ __/ (_| || || |_ " 81 | , "|_| \\_|\\___|\\___|\\__,_|___|\\__|" ] 82 | -------------------------------------------------------------------------------- /src/NeedIt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module NeedIt ( 3 | catchSyntaxErrors, 4 | catchSemanticErrors, 5 | clearDeps, 6 | createDepsFolder, 7 | downloadDep, 8 | existDepsFile, 9 | existDepsFolder, 10 | getDepsFile, 11 | getModulesFolder, 12 | getPathFor, 13 | linesToTuples, 14 | listDependencies, 15 | readDeps, 16 | tuplesToDepContent, 17 | unzipFile, 18 | Configuration (..), 19 | DepContent (..), 20 | Repository (..) 21 | ) where 22 | import System.IO 23 | import Data.List (isInfixOf) 24 | import Data.Char (isSpace) 25 | import Data.Conduit.Binary (sinkFile) 26 | import Network.HTTP.Conduit 27 | import qualified Data.Conduit as C 28 | import Control.Monad.Trans.Resource (runResourceT) 29 | import Codec.Archive.Zip 30 | import qualified Data.ByteString.Lazy as B 31 | import Control.Applicative ((<$>), liftA2) 32 | import System.Directory (createDirectory, removeFile, doesFileExist, doesDirectoryExist, removeDirectoryRecursive) 33 | import System.FilePath (joinPath) 34 | import qualified Data.Text as T 35 | import Network.URI (parseURI) 36 | import Data.Maybe (isJust) 37 | import Debug.Trace 38 | 39 | data Repository = Self | External String 40 | 41 | data Configuration = Configuration { basepath :: FilePath, repository :: Repository } 42 | 43 | data DepContent = DepContent { package :: String, source :: String, deps :: [String] } 44 | 45 | instance Show Configuration where 46 | show cfg = foldl1 (++) ["Configuration:\n", " · Path: ", basepath cfg, "\n", 47 | " · Repository: ", show $ repository cfg] 48 | 49 | instance Show Repository where 50 | show Self = "self" 51 | show (External r) = take ((length r) - 4) r 52 | 53 | instance Show DepContent where 54 | show ct = "From " ++ (source ct) ++ ", package `" ++ (package ct) ++ "' needs\n" ++ depList 55 | where depList = foldl (++) "" (map mountLn $ deps ct) 56 | mountLn dep = " · " ++ dep ++ "\n" 57 | 58 | infixl 0 |> 59 | (|>) :: a -> (a -> b) -> b 60 | (|>) x f = f x 61 | 62 | clearDeps :: Configuration -> IO () 63 | clearDeps = removeDirectoryRecursive . getModulesFolder 64 | 65 | createDepsFolder :: Configuration -> IO () 66 | createDepsFolder = createDirectory . getModulesFolder 67 | 68 | existDepsFile :: Configuration -> IO Bool 69 | existDepsFile = doesFileExist . getDepsFile 70 | 71 | existDepsFolder :: Configuration -> IO Bool 72 | existDepsFolder = doesDirectoryExist . getModulesFolder 73 | 74 | getDepsFile :: Configuration -> FilePath 75 | getDepsFile cfg = joinPath [basepath cfg, "DEPENDENCIES"] 76 | 77 | getPathFor :: Configuration -> FilePath 78 | getPathFor cfg = joinPath $ [basepath cfg] ++ case repository cfg of 79 | Self -> [] 80 | External r -> [r] 81 | 82 | getModulesFolder :: Configuration -> FilePath 83 | getModulesFolder cfg = joinPath [basepath cfg, "advpl_modules"] 84 | 85 | readDeps :: Configuration -> IO [String] 86 | readDeps cfg = getDepsFile cfg 87 | |> \filename -> openFile filename ReadMode 88 | >>= hGetContents 89 | >>= return . lines 90 | 91 | validWords :: String -> Bool 92 | validWords = (liftA2 (||) (== 2) (== 0)) . length . words 93 | 94 | validDeclaration :: String -> Bool 95 | validDeclaration = (liftA2 (||) 96 | (\c -> (length c) == 0) 97 | (\c -> (c !! 0) `elem` ["PACKAGE", "FROM", "NEEDS"])) . words 98 | 99 | validNeeds :: String -> Bool 100 | validNeeds x = 101 | (command /= "NEEDS") || -- Not a NEEDS directive 102 | ("/" `isInfixOf` x) 103 | where (command, value) = listToPair . words $ x 104 | 105 | validSource :: String -> Bool 106 | validSource x = 107 | (command /= "FROM") || -- Not a FROM directive 108 | (isJust $ parseURI value) 109 | where (command, value) = listToPair . words $ x 110 | 111 | short :: String -> String 112 | short str | length str < 10 = str 113 | | otherwise = (++ "...") $ take 7 str 114 | 115 | countBy :: (a -> Bool) -> [a] -> Int 116 | countBy pred = length . filter pred 117 | 118 | listToPair :: [String] -> (String, String) 119 | listToPair (a:b:_) = (a, b) 120 | listToPair _ = ("", "") 121 | 122 | getFileName :: String -> String 123 | getFileName name = (reverse $ takeWhile (/= '/') (reverse name)) ++ ".zip" 124 | 125 | catchSyntaxErrors :: [String] -> Maybe (String, Int) 126 | catchSyntaxErrors = catchErrors' 1 127 | where catchErrors' n [] = Nothing 128 | catchErrors' n (x:xs) | (not . validWords) x = Just ("Wrong size declaration", n) 129 | | (not . validDeclaration) x = Just ("Unknown declaration `" ++ (short x) ++ "'", n) 130 | | (not . validNeeds) x = Just ("Invalid repository passed for NEEDS", n) 131 | | (not . validSource) x = Just ("Invalid source base", n) 132 | | otherwise = catchErrors' (n + 1) xs 133 | 134 | catchSemanticErrors :: [(String, String)] -> Maybe String 135 | catchSemanticErrors xss | nPackages == 0 = Just "No package name provided" 136 | | nPackages > 1 = Just "Too many package names provided" 137 | | nSources == 0 = Just "No source base provided" 138 | | nSources > 1 = Just "Too many source bases provided" 139 | | otherwise = Nothing 140 | where countByCommand cmd = countBy (\pair -> (fst pair) == cmd) $ xss 141 | nPackages = countByCommand "PACKAGE" 142 | nSources = countByCommand "FROM" 143 | 144 | linesToTuples :: [String] -> Either (String, Int) [(String, String)] 145 | linesToTuples xss = case catchSyntaxErrors xss of 146 | Nothing -> Right (xss |> map words 147 | |> filter (\l -> length l == 2) 148 | |> map listToPair) 149 | Just err -> Left err 150 | 151 | tuplesToDepContent :: [(String, String)] -> DepContent 152 | tuplesToDepContent tuples = DepContent { package = (getByCommand "PACKAGE") !! 0 153 | , source = (getByCommand "FROM") !! 0 154 | , deps = (getByCommand "NEEDS") } 155 | where getByCommand cmd = map snd $ filter (\pair -> (fst pair) == cmd) tuples 156 | 157 | listDependencies :: DepContent -> [(String, String, String)] 158 | listDependencies ct = map toPairWithLink $ deps ct 159 | where baseUrl = source ct 160 | toPairWithLink dep = (dep, baseUrl ++ dep ++ "/archive/master.zip", getFileName dep) 161 | 162 | downloadDep :: (String, String, String) -> IO () 163 | downloadDep (repository, url, filename) = parseUrl url 164 | >>= \request -> newManager tlsManagerSettings 165 | >>= \manager -> runResourceT (http request manager 166 | >>= \response -> responseBody response C.$$+- sinkFile $ joinPath ["advpl_modules/", filename]) 167 | 168 | unzipFile :: FilePath -> IO () 169 | unzipFile f = toArchive <$> B.readFile f 170 | >>= extractFilesFromArchive [OptVerbose, OptRecursive, OptDestination "./advpl_modules"] 171 | 172 | --------------------------------------------------------------------------------