diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -100,6 +100,9 @@ `app/modules/`, that they would be concatenated/compiled into the respective output files (i.e. `index.html`, `index.css`, or `index.js`). +This repo is checked with [git-vogue](https://github.com/anchor/git-vogue). +It's highly recommended that you use it for duplo development as well. + ## Testing diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/duplo.cabal b/duplo.cabal --- a/duplo.cabal +++ b/duplo.cabal @@ -1,5 +1,5 @@ name: duplo -version: 1.6.18 +version: 1.6.19 synopsis: Frontend development build tool description: Intuitive, simple building blocks for building composable, completely self-managed web applications license: MIT @@ -41,25 +41,24 @@ build-depends : base == 4.7.* , aeson == 0.8.* , aeson-pretty == 0.7.* - , ansi-terminal == 0.5.* + , ansi-terminal == 0.6.* , bytestring == 0.10.* , containers == 0.5.* , directory == 1.2.* , executable-path == 0.0.* , filepath == 1.3.* - , filepather == 0.3.* , fsnotify == 0.1.* , http-types == 0.8.* , language-javascript == 0.5.* - , lens == 4.5.* - , mtl == 2.2.* + , lens == 4.6.* + , mtl == 2.1.* , regex-compat == 0.95.* , scotty == 0.9.* , shake == 0.14.* , system-fileio == 0.3.* - , text == 1.1.* + , text == 1.2.* , text-format == 0.3.* - , transformers == 0.4.* + , transformers == 0.3.* , unordered-containers == 0.2.* , utf8-string == 0.3.* , wai == 3.0.* @@ -76,27 +75,26 @@ , aeson == 0.8.* , aeson == 0.8.* , aeson-pretty == 0.7.* - , ansi-terminal == 0.5.* + , ansi-terminal == 0.6.* , base64-bytestring == 1.0.* , bytestring == 0.10.* , containers == 0.5.* , directory == 1.2.* , duplo , filepath == 1.3.* - , filepather == 0.3.* , fsnotify == 0.1.* , http-types == 0.8.* , language-javascript == 0.5.* - , lens == 4.5.* - , mtl == 2.2.* + , lens == 4.6.* + , mtl == 2.1.* , process == 1.2.* , regex-compat == 0.95.* , scotty == 0.9.* , shake == 0.14.* , system-filepath == 0.4.* - , text == 1.1.* + , text == 1.2.* , text-format == 0.3.* - , transformers == 0.4.* + , transformers == 0.3.* , unordered-containers == 0.2.* , wai == 3.0.* , warp == 3.0.* @@ -110,6 +108,9 @@ type : exitcode-stdio-1.0 build-depends : base , duplo - , hspec == 2.1.* + , HUnit == 1.2.5.2 , MissingH == 1.3.* , QuickCheck == 2.7.* + , tasty == 0.10.1 + , tasty-hunit == 0.9.0.1 + , tasty-quickcheck == 0.8.3.2 diff --git a/src/CLI.hs b/src/CLI.hs --- a/src/CLI.hs +++ b/src/CLI.hs @@ -2,35 +2,40 @@ module Main where -import Control.Applicative ((<$>)) -import Control.Exception (catch, handle, throw, Exception) -import Control.Lens.Operators -import Control.Monad (void, when, unless) -import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) -import Data.ByteString.Base64 (decode) -import Data.ByteString.Char8 (pack, unpack) -import Data.Maybe (fromMaybe) -import Development.Duplo (build) -import Development.Duplo.Server (serve) -import Development.Duplo.Utilities (logStatus, errorPrintSetter) -import Development.Duplo.Watcher (watch) -import Development.Shake (cmd, ShakeException(..)) -import Development.Shake.FilePath (()) -import GHC.Conc (forkIO) -import System.Console.GetOpt (getOpt, OptDescr(..), ArgDescr(..), ArgOrder(..)) -import System.Directory (getCurrentDirectory, createDirectoryIfMissing, doesFileExist) -import System.Environment (lookupEnv, getArgs, getExecutablePath) -import System.FilePath.Posix (takeDirectory) -import System.Process (proc, createProcess, waitForProcess) -import qualified Control.Lens -import qualified Development.Duplo.Component as CM +import Control.Applicative ((<$>)) +import Control.Exception (Exception, catch, handle, + throw) +import qualified Control.Lens as LS +import Control.Lens.Operators +import Control.Monad (unless, void, when) +import Data.ByteString.Base64 (decode) +import Data.ByteString.Char8 (pack, unpack) +import Data.List.Utils (replace) +import Data.Maybe (fromMaybe) +import Development.Duplo (build) +import qualified Development.Duplo.Component as CM +import Development.Duplo.Server (serve) import qualified Development.Duplo.Types.AppInfo as AI import qualified Development.Duplo.Types.Builder as TB -import qualified Development.Duplo.Types.Config as TC +import qualified Development.Duplo.Types.Config as TC import qualified Development.Duplo.Types.Options as OP +import Development.Duplo.Utilities (errorPrintSetter, logStatus) +import Development.Duplo.Watcher (watch) +import Development.Shake (ShakeException (..), cmd) +import Development.Shake.FilePath (()) import qualified Filesystem.Path +import GHC.Conc (forkIO) import qualified GHC.IO -import Data.List.Utils (replace) +import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), + OptDescr (..), getOpt) +import System.Directory (createDirectoryIfMissing, + doesFileExist, + getCurrentDirectory) +import System.Environment (getArgs, getExecutablePath, + lookupEnv) +import System.FilePath.Posix (takeDirectory) +import System.Process (createProcess, proc, + waitForProcess) main :: IO () main = do diff --git a/src/Development/Duplo.hs b/src/Development/Duplo.hs --- a/src/Development/Duplo.hs +++ b/src/Development/Duplo.hs @@ -1,25 +1,27 @@ module Development.Duplo where -import Control.Exception (throw) -import Control.Lens hiding (Action) -import Control.Monad (void, when, unless) -import Control.Monad.Except (runExceptT) -import Development.Duplo.Git as Git -import Development.Duplo.Markups as Markups -import Development.Duplo.Scripts as Scripts -import Development.Duplo.Static as Static -import Development.Duplo.Styles as Styles -import Development.Duplo.Utilities (logStatus, headerPrintSetter, successPrintSetter, createStdEnv) -import Development.Shake -import Development.Shake.FilePath (()) -import System.Console.GetOpt (OptDescr(..), ArgDescr(..)) -import System.IO (readFile) -import qualified Development.Duplo.Component as CM +import Control.Exception (throw) +import Control.Lens hiding (Action) +import Control.Monad (unless, void, when) +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Development.Duplo.Component as CM +import Development.Duplo.Git as Git +import Development.Duplo.Markups as Markups +import Development.Duplo.Scripts as Scripts +import Development.Duplo.Static as Static +import Development.Duplo.Styles as Styles import qualified Development.Duplo.Types.AppInfo as AI import qualified Development.Duplo.Types.Builder as BD -import qualified Development.Duplo.Types.Config as TC +import qualified Development.Duplo.Types.Config as TC import qualified Development.Duplo.Types.Options as OP -import qualified Development.Shake as DS +import Development.Duplo.Utilities (createStdEnv, + headerPrintSetter, logStatus, + successPrintSetter) +import Development.Shake +import qualified Development.Shake as DS +import Development.Shake.FilePath (()) +import System.Console.GetOpt (ArgDescr (..), OptDescr (..)) +import System.IO (readFile) shakeOpts = shakeOptions { shakeThreads = 4 } @@ -43,9 +45,9 @@ let targetScript = targetPath "index.js" let targetStyle = targetPath "index.css" let targetMarkup = targetPath "index.html" - targetScript *> (void . runExceptT . Scripts.build config) - targetStyle *> (void . runExceptT . Styles.build config) - targetMarkup *> (void . runExceptT . Markups.build config) + targetScript *> (void . runMaybeT . Scripts.build config) + targetStyle *> (void . runMaybeT . Styles.build config) + targetMarkup *> (void . runMaybeT . Markups.build config) -- Manually bootstrap Shake action $ do diff --git a/src/Development/Duplo/Component.hs b/src/Development/Duplo/Component.hs --- a/src/Development/Duplo/Component.hs +++ b/src/Development/Duplo/Component.hs @@ -2,35 +2,38 @@ module Development.Duplo.Component where -import Control.Applicative ((<$>), (<*>)) -import Control.Exception (throw) -import Control.Monad (when, liftM) -import Control.Monad.Trans.Class (lift) -import Data.Aeson (encode, decode) -import Data.Aeson.Encode.Pretty (encodePretty) -import Data.ByteString.Lazy.Char8 (ByteString) -import Data.HashMap.Lazy (empty, keys, lookup) -import Data.List (isPrefixOf) -import Data.Map (fromList) -import Data.Maybe (fromJust, fromMaybe) -import Data.Text (breakOn) -import Development.Duplo.Types.AppInfo (AppInfo(..)) -import Development.Shake hiding (doesFileExist, getDirectoryContents, doesDirectoryExist) -import Development.Shake.FilePath (()) -import Prelude hiding (lookup) -import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents, getCurrentDirectory) -import System.FilePath.FilePather.FilterPredicate (filterPredicate) -import System.FilePath.FilePather.Find (findp) -import System.FilePath.FilePather.RecursePredicate (recursePredicate) -import System.FilePath.Posix (makeRelative, dropExtension, splitDirectories, equalFilePath, takeFileName, dropTrailingPathSeparator) -import qualified Data.ByteString.Lazy.Char8 as BS (unpack, pack) -import qualified Data.Text as T (unpack, pack) +import Control.Exception (throw) +import Control.Lens.Operators +import Control.Monad (liftM) +import Data.Aeson (decode, encode) +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Lazy.Char8 as BS (pack, unpack) +import Data.HashMap.Lazy (lookup) +import Data.List (isPrefixOf) +import Data.Map (fromList) +import Data.Maybe (fromMaybe) +import Data.Text (breakOn) +import qualified Data.Text as T (pack, unpack) +import Development.Duplo.Types.AppInfo (AppInfo (..)) import qualified Development.Duplo.Types.AppInfo as AI import qualified Development.Duplo.Types.Builder as BD +import qualified Development.Duplo.Types.Config as TC +import Development.Shake hiding (doesDirectoryExist, + doesFileExist, + getDirectoryContents) +import Development.Shake.FilePath (()) +import Prelude hiding (lookup) +import System.Directory (doesDirectoryExist, + doesFileExist, + getCurrentDirectory, + getDirectoryContents) +import System.FilePath.Posix (splitDirectories) type Version = (String, String) -- | Each application must have a `component.json` +manifestName :: FilePath manifestName = "component.json" readManifest :: IO AppInfo @@ -66,22 +69,24 @@ -- constituents parseComponentId :: String -> Either String (String, String) parseComponentId cId - | repoL > 0 = Right (T.unpack user, T.unpack repo) + | repoL > 0 = Right (T.unpack user, T.unpack userRepo) | otherwise = Left $ "No component ID found with " ++ cId where - (user, repo) = breakOn (T.pack "-") (T.pack cId) - repoL = length $ T.unpack repo + (user, userRepo) = breakOn (T.pack "-") (T.pack cId) + repoL = length $ T.unpack userRepo -- | Given a path, find all the `component.json` and return a JSON string -extractCompVersions :: FilePath -> IO String -extractCompVersions path = do +extractCompVersions :: TC.BuildConfig -> Action String +extractCompVersions config = do + let path = config ^. TC.cwd + let utilPath = config ^. TC.utilPath -- Get all the relevant paths - paths <- getAllManifestPaths path + paths <- getAllManifestPaths utilPath path -- Construct the pipeline - let toVersion path = appInfoToVersion . decodeManifest path . BS.pack - let takeVersion path = liftM (toVersion path) (readFile path) + let toVersion path' = appInfoToVersion . decodeManifest path' . BS.pack + let takeVersion path' = liftM (toVersion path') (readFile path') -- Go through it - manifests <- mapM takeVersion paths + manifests <- mapM (liftIO . takeVersion) paths -- Marshalling return $ BS.unpack $ encode $ fromList manifests @@ -97,19 +102,10 @@ appInfoToVersion appInfo = (AI.name appInfo, AI.version appInfo) -- | Given a path, find all the `component.json`s -getAllManifestPaths :: FilePath -> IO [FilePath] -getAllManifestPaths root = allPaths - where - -- Filter for `component.json`. - matchName path t = takeFileName path == takeFileName manifestName - filterP = filterPredicate matchName - -- We only care about the root directory and the `components/` directory. - componentsPath = dropTrailingPathSeparator $ root "components/" - proceed absPath = equalFilePath root absPath - || componentsPath `isPrefixOf` absPath - recurseP = recursePredicate proceed - -- Collect the paths here. - allPaths = findp filterP recurseP root +getAllManifestPaths :: FilePath -> FilePath -> Action [FilePath] +getAllManifestPaths utilPath root = do + Stdout out <- command [] (utilPath "find.sh") [root, manifestName] + return $ lines out -- | Get the component dependency list by providing a mode, or not. getDependencies :: Maybe String -> IO [FilePath] @@ -136,9 +132,9 @@ -- dependency list, all modes, and the target mode to select the list by. getDependencies' :: AI.Dependencies -> Maybe [String] -> IO [FilePath] -- If somehow there isn't a mode defined, switch over to `Nothing`. -getDependencies' deps Nothing = getDependencies Nothing +getDependencies' _ Nothing = getDependencies Nothing -- If there is something, fetch only those dependencies. -getDependencies' deps (Just modeDeps) = return modeDeps +getDependencies' _ (Just modeDeps) = return modeDeps -- | Regular file != *nix-style hidden file isRegularFile :: FilePath -> Bool diff --git a/src/Development/Duplo/FileList.hs b/src/Development/Duplo/FileList.hs --- a/src/Development/Duplo/FileList.hs +++ b/src/Development/Duplo/FileList.hs @@ -2,13 +2,13 @@ module Development.Duplo.FileList where -import Control.Lens hiding (Action) -import Control.Lens.TH (makeLenses) -import Control.Monad (liftM, msum) -import Data.Maybe (Maybe(..), catMaybes) -import Development.Shake -import Development.Shake.FilePath (()) -import System.FilePath.Posix (makeRelative) +import Control.Lens hiding (Action) +import Control.Lens.TH (makeLenses) +import Control.Monad (liftM, msum) +import Data.Maybe (Maybe (..), catMaybes) +import Development.Shake +import Development.Shake.FilePath (()) +import System.FilePath.Posix (makeRelative) data File = File { _filePath :: FilePath , _fileBase :: FilePath diff --git a/src/Development/Duplo/Files.hs b/src/Development/Duplo/Files.hs --- a/src/Development/Duplo/Files.hs +++ b/src/Development/Duplo/Files.hs @@ -2,19 +2,14 @@ module Development.Duplo.Files where -import Control.Exception (throw) -import Control.Lens hiding (Action) -import Control.Lens.TH (makeLenses) -import Control.Monad.Except (ExceptT(..), runExceptT) -import Control.Monad.Trans.Class (lift) -import Data.List (intercalate) -import Data.Text (split, pack, unpack) -import Development.Duplo.Component (appId) -import Development.Shake hiding (readFile) -import Prelude hiding (readFile) -import System.FilePath.Posix (makeRelative, splitDirectories, joinPath) +import Control.Lens hiding (Action) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (..)) +import Development.Duplo.Component (appId) import qualified Development.Duplo.Component as CM -import qualified Development.Duplo.Types.Builder as BD +import Development.Shake (Action, liftIO, readFile') +import System.FilePath.Posix (joinPath, makeRelative, + splitDirectories) type FileName = String type FileContent = String @@ -28,6 +23,7 @@ , _isRoot :: Bool } deriving (Show) +pseudoFile :: File pseudoFile = File { _filePath = "" , _fileDir = "" , _fileName = "" @@ -38,24 +34,24 @@ makeLenses ''File -readFile :: FilePath -> FilePath -> ExceptT String Action File +readFile :: FilePath -> FilePath -> MaybeT Action File readFile cwd path = do - let (fileDir, fileName) = parseFilePath path - fileContent <- lift $ readFile' path - appInfo <- liftIO CM.readManifest - let appId' = appId appInfo - let componentId = parseComponentId cwd appId' fileDir - let isRoot = componentId == appId' - return $ File path fileDir fileName componentId fileContent isRoot + let (fDir, fName) = parseFilePath path + fContent <- lift $ readFile' path + appInfo <- liftIO CM.readManifest + let appId' = appId appInfo + let cId = parseComponentId cwd appId' fDir + let isRoot' = cId == appId' + return $ File path fDir fName cId fContent isRoot' parseFilePath :: FilePath -> (FilePath, FileName) -parseFilePath path = (fileDir, fileName) +parseFilePath path = (fDir, fName) where segments = splitDirectories path segLength = length segments dirLength = segLength - 1 - fileDir = joinPath $ take dirLength segments - fileName = segments !! dirLength + fDir = joinPath $ take dirLength segments + fName = segments !! dirLength -- | Given a default component ID (usually the ID of the project on which -- duplo is run) and the file path, deduce the component ID of a particular @@ -67,5 +63,5 @@ segments = splitDirectories relPath in case segments of - ("components" : appId : xs) -> appId - _ -> defaultId + ("components" : aId : _) -> aId + _ -> defaultId diff --git a/src/Development/Duplo/Git.hs b/src/Development/Duplo/Git.hs --- a/src/Development/Duplo/Git.hs +++ b/src/Development/Duplo/Git.hs @@ -1,16 +1,15 @@ module Development.Duplo.Git where -import Control.Applicative ((<$>)) -import Control.Lens hiding (Action, Level) -import Control.Monad.Except (runExceptT) -import Data.List (intercalate, filter) -import Data.Text (unpack, pack, splitOn) -import Development.Shake -import Development.Shake.FilePath (()) -import System.FilePath.Posix (makeRelative) -import qualified Development.Duplo.Component as CM +import Control.Applicative ((<$>)) +import Control.Lens hiding (Action, Level) +import Data.List (filter, intercalate) +import Data.Text (pack, splitOn, unpack) +import qualified Development.Duplo.Component as CM import qualified Development.Duplo.Types.AppInfo as AI -import qualified Development.Duplo.Types.Config as TC +import qualified Development.Duplo.Types.Config as TC +import Development.Shake +import Development.Shake.FilePath (()) +import System.FilePath.Posix (makeRelative) type Level = String type Version = String diff --git a/src/Development/Duplo/JavaScript/Order.hs b/src/Development/Duplo/JavaScript/Order.hs --- a/src/Development/Duplo/JavaScript/Order.hs +++ b/src/Development/Duplo/JavaScript/Order.hs @@ -2,19 +2,24 @@ module Development.Duplo.JavaScript.Order where -import Control.Applicative ((<$>)) -import Control.Exception (throw) -import Control.Lens (makeLenses, ix) -import Control.Lens.Operators -import Control.Monad (liftM, when, void) -import Control.Monad.State.Lazy (get, put, state, execState) -import Control.Monad.Writer.Lazy (Writer, tell, runWriter) -import Data.Function (on) -import Data.List (findIndex, sortBy, nubBy) -import Data.Maybe (isJust, fromJust, fromMaybe) -import Development.Duplo.Types.JavaScript -import Language.JavaScript.Parser (JSNode(..), Node(..), TokenPosn(..)) +import Control.Applicative ((<$>)) +import Control.Exception (throw) +import Control.Lens (ix, makeLenses) +import Control.Lens.Operators +import Control.Monad (liftM, void, when) +import Control.Monad.State.Lazy (execState, get, put, state) +import Control.Monad.Writer.Lazy (Writer, runWriter, tell) +import Data.Function (on) +import Data.List (findIndex, nubBy, sortBy) +import Data.Maybe (fromJust, fromMaybe, + isJust) +import Development.Duplo.Types.JavaScript +import Language.JavaScript.Parser (JSNode (..), Node (..), + TokenPosn (..)) +import Debug.Trace +trace' a = trace (show a) a + makeLenses ''Module -- | Reorder modules within the root node. @@ -68,11 +73,15 @@ (nameNT:_:depsNT:_) = argNTs -- Extract the name, always first argument. (NT (JSStringLiteral _ moduleName) _ _) = nameNT - -- Extract the module dependencies, always the third argument (second - -- being the comma separator). - (NN (JSArrayLiteral _ depsNodes _)) = depsNT + -- Extract the module dependencies. The dependency list is always the + -- third argument; otherwise, there's an issue. + (NN (JSArrayLiteral _ depsNodes _)) = matchDependencies moduleName depsNT -- Only take the strings. deps = map fromJust $ filter isJust $ map stringLiteralNT depsNodes + +matchDependencies :: String -> JSNode -> JSNode +matchDependencies _ node@(NN (JSArrayLiteral _ depsNodes _)) = node +matchDependencies moduleName _ = throw $ MissingDependencies moduleName -- | Given a JSNode, return just the string literal, or nothing stringLiteralNT :: JSNode -> Maybe String diff --git a/src/Development/Duplo/Markups.hs b/src/Development/Duplo/Markups.hs --- a/src/Development/Duplo/Markups.hs +++ b/src/Development/Duplo/Markups.hs @@ -1,22 +1,29 @@ module Development.Duplo.Markups where -import Control.Applicative ((<$>)) -import Control.Exception (throw) -import Control.Lens hiding (Action) -import Control.Monad.Trans.Class (lift) -import Data.Maybe (fromMaybe) -import Development.Duplo.Component (parseComponentId) -import Development.Duplo.FileList (collapseFileList, makeFile) -import Development.Duplo.Files (File(..), filePath, fileDir, fileName, componentId, fileContent, isRoot, ComponentId) -import Development.Duplo.Utilities (logStatus, headerPrintSetter, expandPaths, compile, createIntermediaryDirectories, CompiledContent, expandDeps) -import Development.Shake -import Development.Shake.FilePath (()) -import System.Directory (findFile) -import System.FilePath.Posix (makeRelative, splitDirectories, joinPath) -import qualified Development.Duplo.FileList as FileList (filePath) +import Control.Applicative ((<$>)) +import Control.Exception (throw) +import Control.Lens hiding (Action) +import Control.Monad.Trans.Class (lift) +import Data.List.Utils (replace) +import Data.Maybe (fromMaybe) +import Development.Duplo.Component (parseComponentId) +import Development.Duplo.FileList (collapseFileList, makeFile) +import qualified Development.Duplo.FileList as FileList (filePath) +import Development.Duplo.Files (ComponentId, File (..), + componentId, fileContent, + fileDir, fileName, filePath, + isRoot) import qualified Development.Duplo.Types.Builder as BD -import qualified Development.Duplo.Types.Config as TC -import Data.List.Utils (replace) +import qualified Development.Duplo.Types.Config as TC +import Development.Duplo.Utilities (CompiledContent, compile, + createIntermediaryDirectories, + expandDeps, expandPaths, + headerPrintSetter, logStatus) +import Development.Shake +import Development.Shake.FilePath (()) +import System.Directory (findFile) +import System.FilePath.Posix (joinPath, makeRelative, + splitDirectories) build :: TC.BuildConfig -> FilePath @@ -93,7 +100,7 @@ ] let buildScriptTag path = "" - let scriptsTags = concat $ map buildScriptTag scriptsPaths + let scriptsTags = concatMap buildScriptTag scriptsPaths let indexWithTestRefs = if inTest then replace "" (refTagsInTest ++ scriptsTags ++ "") indexWithRefs else indexWithRefs diff --git a/src/Development/Duplo/Scripts.hs b/src/Development/Duplo/Scripts.hs --- a/src/Development/Duplo/Scripts.hs +++ b/src/Development/Duplo/Scripts.hs @@ -2,28 +2,36 @@ module Development.Duplo.Scripts where -import Control.Applicative ((<*>), (<$>)) -import Control.Exception (throw, SomeException(..)) -import Control.Lens hiding (Action) -import Control.Monad (filterM) -import Control.Monad.Trans.Class (lift) -import Data.Function (on) -import Data.List (intercalate, nubBy) -import Data.Text.Format (left) -import Data.Text.Lazy (Text, pack, unpack, replace, splitOn) -import Data.Text.Lazy.Builder (toLazyText) -import Development.Duplo.Component (extractCompVersions) -import Development.Duplo.Files (File(..), pseudoFile) -import Development.Duplo.JavaScript.Order (order) -import Development.Duplo.Types.JavaScript -import Development.Duplo.Utilities (logStatus, headerPrintSetter, expandPaths, compile, createIntermediaryDirectories, CompiledContent, expandDeps) -import Development.Shake -import Development.Shake.FilePath (()) -import Language.JavaScript.Parser.SrcLocation (TokenPosn(..)) -import Text.Regex (mkRegex, matchRegex) -import qualified Development.Duplo.Component as CM -import qualified Development.Duplo.Types.Config as TC -import qualified Language.JavaScript.Parser as JS +import Control.Applicative ((<$>), (<*>)) +import Control.Exception (SomeException (..), + throw) +import Control.Lens hiding (Action) +import Control.Monad (filterM) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (..)) +import Data.Function (on) +import Data.List (intercalate, nubBy) +import Data.Text.Format (left) +import Data.Text.Lazy (Text, pack, replace, + splitOn, unpack) +import Data.Text.Lazy.Builder (toLazyText) +import Development.Duplo.Component (extractCompVersions) +import qualified Development.Duplo.Component as CM +import Development.Duplo.Files (File (..), pseudoFile) +import Development.Duplo.JavaScript.Order (order) +import qualified Development.Duplo.Types.Config as TC +import Development.Duplo.Types.JavaScript +import Development.Duplo.Utilities (CompiledContent, + compile, createIntermediaryDirectories, + expandDeps, + expandPaths, + headerPrintSetter, + logStatus) +import Development.Shake +import Development.Shake.FilePath (()) +import qualified Language.JavaScript.Parser as JS +import Language.JavaScript.Parser.SrcLocation (TokenPosn (..)) +import Text.Regex (matchRegex, mkRegex) -- | How many lines to display around the source of error (both ways). errorDisplayRange :: Int @@ -87,7 +95,7 @@ let duploIn = if not (null input) then input else "" -- Figure out each component's version - compVers <- liftIO $ extractCompVersions cwd + compVers <- lift $ extractCompVersions config -- Inject global/environment variables let envVars = "var DUPLO_ENV = '" ++ env ++ "';\n" diff --git a/src/Development/Duplo/Server.hs b/src/Development/Duplo/Server.hs --- a/src/Development/Duplo/Server.hs +++ b/src/Development/Duplo/Server.hs @@ -1,18 +1,18 @@ module Development.Duplo.Server where -import Control.Monad.Trans (liftIO) -import Data.List (intercalate) -import Data.Text (Text) -import Data.Text.Lazy (Text) -import Network.HTTP.Types (status200) -import Network.Wai (pathInfo) -import Network.Wai.Handler.Warp (Port) -import System.Directory (doesFileExist) -import System.Environment (getArgs) -import System.FilePath.Posix (takeExtension) -import Web.Scotty -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT +import Control.Monad.Trans (liftIO) +import Data.List (intercalate) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy as LT +import Network.HTTP.Types (status200) +import Network.Wai (pathInfo) +import Network.Wai.Handler.Warp (Port) +import System.Directory (doesFileExist) +import System.Environment (getArgs) +import System.FilePath.Posix (takeExtension) +import Web.Scotty serve :: Port -> IO () serve port = do diff --git a/src/Development/Duplo/Static.hs b/src/Development/Duplo/Static.hs --- a/src/Development/Duplo/Static.hs +++ b/src/Development/Duplo/Static.hs @@ -1,16 +1,21 @@ module Development.Duplo.Static where -import Control.Applicative ((<$>)) -import Control.Lens hiding (Action) -import Control.Monad (zipWithM_, filterM) -import Data.List (transpose, nub) -import Development.Duplo.FileList (makeFile, makeFiles, toCopies, collapseFileLists, Copy) -import Development.Duplo.Utilities (logStatus, headerPrintSetter, createIntermediaryDirectories, createPathDirectories, getDirectoryFiles) -import Development.Shake hiding (getDirectoryFiles) -import Development.Shake.FilePath (()) -import System.FilePath.Posix (splitExtension, splitDirectories, makeRelative) -import qualified Development.Duplo.FileList as FileList (filePath) +import Control.Applicative ((<$>)) +import Control.Lens hiding (Action) +import Control.Monad (filterM, zipWithM_) +import Data.List (nub, transpose) +import Development.Duplo.FileList (Copy, collapseFileLists, + makeFile, makeFiles, toCopies) +import qualified Development.Duplo.FileList as FileList (filePath) import qualified Development.Duplo.Types.Config as TC +import Development.Duplo.Utilities (createIntermediaryDirectories, + createPathDirectories, + getDirectoryFiles, + headerPrintSetter, logStatus) +import Development.Shake hiding (getDirectoryFiles) +import Development.Shake.FilePath (()) +import System.FilePath.Posix (makeRelative, splitDirectories, + splitExtension) build :: TC.BuildConfig -> [FilePath] diff --git a/src/Development/Duplo/Styles.hs b/src/Development/Duplo/Styles.hs --- a/src/Development/Duplo/Styles.hs +++ b/src/Development/Duplo/Styles.hs @@ -1,11 +1,14 @@ module Development.Duplo.Styles where -import Control.Lens hiding (Action) -import Control.Monad.Trans.Class (lift) -import Development.Duplo.Utilities (logStatus, headerPrintSetter, expandPaths, compile, createIntermediaryDirectories, CompiledContent, expandDeps) -import Development.Shake -import Development.Shake.FilePath (()) +import Control.Lens hiding (Action) +import Control.Monad.Trans.Class (lift) import qualified Development.Duplo.Types.Config as TC +import Development.Duplo.Utilities (CompiledContent, compile, + createIntermediaryDirectories, + expandDeps, expandPaths, + headerPrintSetter, logStatus) +import Development.Shake +import Development.Shake.FilePath (()) build :: TC.BuildConfig -> FilePath diff --git a/src/Development/Duplo/Types/AppInfo.hs b/src/Development/Duplo/Types/AppInfo.hs --- a/src/Development/Duplo/Types/AppInfo.hs +++ b/src/Development/Duplo/Types/AppInfo.hs @@ -2,9 +2,9 @@ module Development.Duplo.Types.AppInfo where -import Data.Aeson (FromJSON, ToJSON) -import Data.HashMap.Strict (HashMap, empty) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.HashMap.Strict (HashMap, empty) +import GHC.Generics (Generic) type Dependencies = HashMap String String type Modes = HashMap String [String] diff --git a/src/Development/Duplo/Types/Builder.hs b/src/Development/Duplo/Types/Builder.hs --- a/src/Development/Duplo/Types/Builder.hs +++ b/src/Development/Duplo/Types/Builder.hs @@ -2,8 +2,8 @@ module Development.Duplo.Types.Builder where -import Control.Exception (Exception) -import Data.Typeable (Typeable) +import Control.Exception (Exception) +import Data.Typeable (Typeable) data BuilderException = MissingGithubUserException | MissingGithubRepoException diff --git a/src/Development/Duplo/Types/Config.hs b/src/Development/Duplo/Types/Config.hs --- a/src/Development/Duplo/Types/Config.hs +++ b/src/Development/Duplo/Types/Config.hs @@ -2,10 +2,10 @@ module Development.Duplo.Types.Config where -import Control.Lens hiding (Action) -import Control.Lens.TH (makeLenses) -import Development.Shake -import Network.Wai.Handler.Warp (Port) +import Control.Lens hiding (Action) +import Control.Lens.TH (makeLenses) +import Development.Shake +import Network.Wai.Handler.Warp (Port) data BuildConfig = BuildConfig { _appName :: String , _appVersion :: String diff --git a/src/Development/Duplo/Types/JavaScript.hs b/src/Development/Duplo/Types/JavaScript.hs --- a/src/Development/Duplo/Types/JavaScript.hs +++ b/src/Development/Duplo/Types/JavaScript.hs @@ -2,15 +2,16 @@ module Development.Duplo.Types.JavaScript where -import Control.Exception (Exception) -import Control.Monad.State.Lazy (State) -import Data.List (intercalate) -import Data.Typeable (Typeable) -import Language.JavaScript.Parser (JSNode(..)) +import Control.Exception (Exception) +import Control.Monad.State.Lazy (State) +import Data.List (intercalate) +import Data.Typeable (Typeable) +import Language.JavaScript.Parser (JSNode (..)) data JSCompilerException = ModuleNotFoundException ModuleName | CircularDependencyException [ModuleName] | ParseException [String] + | MissingDependencies String -- When the compiler itself is buggy | InternalParserException String -- When language-javascript somehow produces @@ -31,6 +32,8 @@ "Uh oh. The parser itself is misbehaving: " ++ e show (LanguageJavaScriptException element) = "language-javascript is not parsing the file correctly:\n" ++ show element + show (MissingDependencies name) = + "Module `" ++ name ++ "` is missing a dependency array in its `define()`." type LineNumber = Int type ModuleName = String diff --git a/src/Development/Duplo/Types/Options.hs b/src/Development/Duplo/Types/Options.hs --- a/src/Development/Duplo/Types/Options.hs +++ b/src/Development/Duplo/Types/Options.hs @@ -1,6 +1,6 @@ module Development.Duplo.Types.Options where -import System.Console.GetOpt (OptDescr(..), ArgDescr(..)) +import System.Console.GetOpt (ArgDescr (..), OptDescr (..)) data Options = Options { optVerbose :: Bool , optVersion :: Bool diff --git a/src/Development/Duplo/Utilities.hs b/src/Development/Duplo/Utilities.hs --- a/src/Development/Duplo/Utilities.hs +++ b/src/Development/Duplo/Utilities.hs @@ -1,25 +1,26 @@ module Development.Duplo.Utilities where -import Control.Applicative ((<$>)) -import Control.Lens.Operators -import Control.Monad (filterM, zipWithM) -import Control.Monad.Except (ExceptT(..), runExceptT) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Class (lift) -import Data.List (intercalate, isSuffixOf) -import Development.Duplo.Files (readFile, File(..), fileContent) -import Development.Shake (CmdOption(..)) -import Development.Shake.FilePath (()) -import Prelude hiding (readFile) -import System.Console.ANSI (setSGR, SGR(..), ConsoleLayer(..), ColorIntensity(..), Color(..)) -import System.FilePath.Posix (joinPath, splitPath) -import qualified Control.Lens as CL -import qualified Development.Duplo.Component as CM -import qualified Development.Duplo.Types.AppInfo as AI +import Control.Applicative ((<$>)) +import Control.Lens.Operators +import Control.Monad (filterM, zipWithM) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Maybe (MaybeT (..)) +import Data.List (intercalate) +import Development.Duplo.Files (File (..), fileContent, + readFile) import qualified Development.Duplo.Types.Config as TC -import qualified Development.Shake as DS +import Development.Shake (CmdOption (..)) +import qualified Development.Shake as DS +import Development.Shake.FilePath (()) +import Prelude hiding (readFile) +import System.Console.ANSI (Color (..), + ColorIntensity (..), + ConsoleLayer (..), SGR (..), + setSGR) +import System.FilePath.Posix (joinPath, splitPath) -type CompiledContent = ExceptT String DS.Action +type CompiledContent = MaybeT DS.Action type FileProcessor = [File] -> CompiledContent [File] type StringProcessor = String -> CompiledContent String @@ -40,12 +41,12 @@ -- for a list of file patterns. makeFilePatterns :: [FilePath] -> [String] -> DS.Action [DS.FilePattern] makeFilePatterns bases exts = do - patternList <- zipWithM makeValidPattern bases exts - let concat = foldl1 (++) + patternList <- zipWithM makeValidPattern bases exts + let conc = foldl1 (++) -- Avoid infinite list. let patterns = if null patternList then return [] - else concat patternList + else conc patternList return patterns -- | Given a working directory and a list of patterns, expand all the diff --git a/src/Development/Duplo/Watcher.hs b/src/Development/Duplo/Watcher.hs --- a/src/Development/Duplo/Watcher.hs +++ b/src/Development/Duplo/Watcher.hs @@ -1,15 +1,20 @@ module Development.Duplo.Watcher where -import Control.Concurrent (threadDelay, forkIO, forkFinally, ThreadId(..), killThread) -import Control.Concurrent.Chan (Chan, newChan, readChan, getChanContents) -import Control.Exception (try) -import Control.Monad (forever, void, when, unless) -import Data.Foldable (forM_) -import Data.IORef (newIORef, readIORef, writeIORef, IORef) -import Data.Maybe (isJust, fromJust) -import Data.String (fromString) -import System.FSNotify (withManagerConf, watchTreeChan, WatchConfig(..), Debounce(..), Action, Event) -import System.FilePath.Posix (FilePath) +import Control.Concurrent (ThreadId (..), forkFinally, forkIO, + killThread, threadDelay) +import Control.Concurrent.Chan (Chan, getChanContents, newChan, + readChan) +import Control.Exception (try) +import Control.Monad (forever, unless, void, when) +import Data.Foldable (forM_) +import Data.IORef (IORef, newIORef, readIORef, + writeIORef) +import Data.Maybe (fromJust, isJust) +import Data.String (fromString) +import System.FilePath.Posix (FilePath) +import System.FSNotify (Action, Debounce (..), Event, + WatchConfig (..), watchTreeChan, + withManagerConf) -- | Given some paths to watch and something to do, watch every 100ms -- without debouncing but would interrupt the action when there is a new diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,30 +1,43 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import Development.Duplo.Types.AppInfo -import Test.Hspec -import Test.QuickCheck -import qualified Development.Duplo.Component as DC -import Data.Functor (fmap) +import qualified Development.Duplo.Component as DC +import Development.Duplo.Types.AppInfo +import Test.HUnit () +import Test.QuickCheck () -runTests = $verboseCheckAll +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as QC main :: IO () -main = do - -- First QuickCheck - verboseCheck prop_slashToDash +main = defaultMain tests - -- Then HSpec - hspec $ - describe "Component support" $ do - it "extracts component ID" $ do - let appInfo = defaultAppInfo { repo = "pixbi/duplo" } - let appId = DC.appId appInfo - appId `shouldBe` "pixbi-duplo" +tests :: TestTree +tests = testGroup "Tests" + [ testGroup "Component support" + [ QC.testProperty "slash is transformed into dash" $ \appInfo -> + let + value = DC.appId appInfo + repo' = repo appInfo + onlyOneSlash = (== 1) . length . filter (== '/') + in + not (null repo') ==> + (head repo' /= '/') ==> + (last repo' /= '/') ==> + onlyOneSlash repo' ==> + value == replaceFirst '/' '-' repo' - return () + , testCase "extracts component ID" $ do + let appInfo = defaultAppInfo { repo = "pixbi/duplo" } + let appId = DC.appId appInfo + appId @?= "pixbi-duplo" + ] + ] + + newtype NameString = NameString { unwrapNameString :: String } deriving Show @@ -32,24 +45,13 @@ instance Arbitrary NameString where arbitrary = fmap NameString $ listOf $ elements $ ['a'..'z'] ++ ['A'..'Z'] - ++ ['/', '-'] + ++ "/-" instance Arbitrary AppInfo where arbitrary = do nameString <- arbitrary :: Gen NameString let string = unwrapNameString nameString return defaultAppInfo { repo = string } - -prop_slashToDash appInfo = - (not (null repo')) ==> - (head repo' /= '/') ==> - (last repo' /= '/') ==> - (onlyOneSlash repo') ==> - value == replaceFirst '/' '-' repo' - where - value = DC.appId appInfo - repo' = repo appInfo - onlyOneSlash = (== 1) . length . filter (== '/') -- | Replace the first occurence of a character in a string. replaceFirst :: Char -> Char -> String -> String