Topic/issue 31

src/Options.purs

@@ -96,7 +96,7 @@ newtype Psc
         , output :: NullOrUndefined String
         , externs :: NullOrUndefined String
         , noPrefix :: NullOrUndefined Boolean
-        , ffi :: NullOrUndefined [String]
+        , ffi :: NullOrUndefined PathArray
         }
 
 newtype PscMake
@@ -108,14 +108,18 @@ newtype PscMake
             , comments :: NullOrUndefined Boolean
             , noPrefix :: NullOrUndefined Boolean
             , output :: NullOrUndefined String
-            , ffi :: NullOrUndefined [String]
+            , ffi :: NullOrUndefined PathArray
             }
 
 newtype PscDocs
   = PscDocs { format :: NullOrUndefined Format
-            , docgen :: NullOrUndefined Foreign
+            , docgen :: NullOrUndefined Docgen
             }
 
+newtype Docgen = Docgen Foreign
+
+newtype PathArray = PathArray [String]
+
 data Format = Markdown | ETags | CTags
 
 instance isForeignEither :: (IsForeign a, IsForeign b) => IsForeign (Either a b) where
@@ -181,53 +185,39 @@ instance isForeignPscDocs :: IsForeign PscDocs where
                  } <$> readProp formatKey obj
                    <*> readProp docgenOpt obj)
 
+instance isForeignPathArray :: IsForeign PathArray where
+  read val = PathArray <$> read val
+
+instance isForeignDocgen :: IsForeign Docgen where
+  read val = Docgen <$> read val
+
 instance isForeignFormat :: IsForeign Format where
   read val = read val >>= (\a -> case a of
                                       "markdown" -> Right Markdown
                                       "etags" -> Right ETags
                                       "ctags" -> Right CTags
                                       a -> Left $ TypeMismatch "Format" a)
 
-mkBoolean :: String -> NullOrUndefined Boolean -> [String]
-mkBoolean key opt = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined opt)
-
-mkString :: String -> NullOrUndefined String -> [String]
-mkString key opt = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined opt)
-
-mkBooleanString :: String -> NullOrUndefined (Either Boolean String) -> [String]
-mkBooleanString key opt = maybe [] (either (\a -> mkBoolean key (NullOrUndefined $ Just a))
-                                           (\a -> mkString key (NullOrUndefined $ Just a)))
-                                   (runNullOrUndefined opt)
-
-mkStringArray :: String -> NullOrUndefined [String] -> [String]
-mkStringArray key opt = concat $ mkString key <$> (NullOrUndefined <<< Just)
-                                              <$> (fromMaybe [] $ runNullOrUndefined opt)
-
-mkPathArray :: String -> NullOrUndefined [String] -> [String]
-mkPathArray key opt = concat $ mkString key <$> (NullOrUndefined <<< Just)
-                                            <$> (fromMaybe [] (runNullOrUndefined opt) >>= expandGlob)
+class CommandLineOption a where
+  opt :: String -> NullOrUndefined a -> [String]
 
-mkDocgen :: String -> NullOrUndefined Foreign -> [String]
-mkDocgen key opt = concat $ mkString key <$> (NullOrUndefined <<< Just)
-                                         <$> (maybe [] parse (runNullOrUndefined opt))
-  where
-  parse :: Foreign -> [String]
-  parse obj = either (const []) id $ parseName obj
-                                 <|> parseList obj
-                                 <|> parseObj obj
-                                 <|> pure []
+instance commandLineOptionBoolean :: CommandLineOption Boolean where
+  opt key val = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined val)
 
-  parseName :: Foreign -> F [String]
-  parseName obj = singleton <$> read obj
+instance commandLineOptionString :: CommandLineOption String where
+  opt key val = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined val)
 
-  parseList :: Foreign -> F [String]
-  parseList obj = read obj
+instance commandLineOptionEither :: (CommandLineOption a, CommandLineOption b) => CommandLineOption (Either a b) where
+  opt key val = maybe [] (either (\a -> opt key (NullOrUndefined $ Just a))
+                                 (\a -> opt key (NullOrUndefined $ Just a)))
+                      (runNullOrUndefined val)
 
-  parseObj :: Foreign -> F [String]
-  parseObj obj = do
-    modules <- keys obj
-    for modules \m -> (\f -> m ++ ":" ++ f) <$> readProp m obj
+instance commandLineOptionArray :: (CommandLineOption a) => CommandLineOption [a] where
+  opt key val = concat $ opt key <$> (NullOrUndefined <<< Just)
+                                 <$> (fromMaybe [] $ runNullOrUndefined val)
 
+instance commandLineOptionPathArray :: CommandLineOption PathArray where
+  opt key val =  opt key (NullOrUndefined ((\(PathArray a) -> a >>= expandGlob) <$> (runNullOrUndefined val)))
 
 foreign import expandGlob
   """
@@ -239,55 +229,74 @@ foreign import expandGlob
   }());
   """ :: String -> [String]
 
-mkFormat :: String -> NullOrUndefined Format -> [String]
-mkFormat key opt = mkString key (maybe j (\a -> case a of
-                                                     Markdown -> i "markdown"
-                                                     ETags -> i "etags"
-                                                     CTags -> i "ctags") $ runNullOrUndefined opt)
-  where i a = NullOrUndefined $ Just a
-        j = NullOrUndefined Nothing
+instance commandLineOptionDocgen :: CommandLineOption Docgen where
+  opt key val =  opt key (NullOrUndefined (parseDocgen <$> (runNullOrUndefined val)))
 
-foldPscOptions :: Psc -> [String]
-foldPscOptions (Psc a) = mkBoolean noPreludeOpt a.noPrelude <>
-                         mkBoolean noTcoOpt a.noTco <>
-                         mkBoolean noMagicDoOpt a.noMagicDo <>
-                         mkBooleanString mainOpt a.main <>
-                         mkBoolean noOptsOpt a.noOpts <>
-                         mkBoolean verboseErrorsOpt a.verboseErrors <>
-                         mkBoolean commentsOpt a.comments <>
-                         mkString browserNamespaceOpt a.browserNamespace <>
-                         mkStringArray moduleOpt a."module" <>
-                         mkStringArray codegenOpt a.codegen <>
-                         mkString outputOpt a.output <>
-                         mkString externsOpt a.externs <>
-                         mkBoolean noPrefixOpt a.noPrefix <>
-                         mkPathArray ffiOpt a.ffi
-
-pscOptions :: Foreign -> [String]
-pscOptions opts = either (const []) foldPscOptions parsed
-  where parsed = read opts :: F Psc
+parseDocgen :: Docgen -> [String]
+parseDocgen (Docgen obj) = either (const []) id $ parseName obj
+                                              <|> parseList obj
+                                              <|> parseObj obj
+                                              <|> pure []
+  where
+    parseName :: Foreign -> F [String]
+    parseName obj = singleton <$> read obj
 
-pscOptionsNoOutput :: Foreign -> Tuple (Maybe String) [String]
-pscOptionsNoOutput opts = either (const $ tuple2 Nothing []) fold parsed
+    parseList :: Foreign -> F [String]
+    parseList obj = read obj
+
+    parseObj :: Foreign -> F [String]
+    parseObj obj = do
+      modules <- keys obj
+      for modules \m -> (\f -> m ++ ":" ++ f) <$> readProp m obj
+
+instance commandLineOptionFormat :: CommandLineOption Format where
+  opt key val = opt key (maybe (NullOrUndefined Nothing)
+                               (\a -> case a of
+                                           Markdown -> NullOrUndefined (Just "markdown")
+                                           ETags -> NullOrUndefined (Just "etags")
+                                           CTags -> NullOrUndefined (Just "ctags"))
+                               (runNullOrUndefined val))
+
+foldPscOptions :: Psc -> [String]
+foldPscOptions (Psc a) = opt noPreludeOpt a.noPrelude <>
+                         opt noTcoOpt a.noTco <>
+                         opt noMagicDoOpt a.noMagicDo <>
+                         opt mainOpt a.main <>
+                         opt noOptsOpt a.noOpts <>
+                         opt verboseErrorsOpt a.verboseErrors <>
+                         opt commentsOpt a.comments <>
+                         opt browserNamespaceOpt a.browserNamespace <>
+                         opt moduleOpt a."module" <>
+                         opt codegenOpt a.codegen <>
+                         opt outputOpt a.output <>
+                         opt externsOpt a.externs <>
+                         opt noPrefixOpt a.noPrefix <>
+                         opt ffiOpt a.ffi
+
+pscOptions :: Foreign -> Either ForeignError [String]
+pscOptions opts = foldPscOptions <$> (read opts :: F Psc)
+
+pscOptionsNoOutput :: Foreign -> Either ForeignError (Tuple (Maybe String) [String])
+pscOptionsNoOutput opts = fold <$> parsed
   where parsed = read opts :: F Psc
         fold (Psc a) = tuple2 (runNullOrUndefined a.output)
                               (foldPscOptions (Psc $ a { output = NullOrUndefined Nothing }))
 
-pscMakeOptions :: Foreign -> [String]
-pscMakeOptions opts = either (const []) fold parsed
+pscMakeOptions :: Foreign -> Either ForeignError [String]
+pscMakeOptions opts = fold <$> parsed
   where parsed = read opts :: F PscMake
-        fold (PscMake a) = mkString outputOpt a.output <>
-                           mkBoolean noPreludeOpt a.noPrelude <>
-                           mkBoolean noTcoOpt a.noTco <>
-                           mkBoolean noMagicDoOpt a.noMagicDo <>
-                           mkBoolean noOptsOpt a.noOpts <>
-                           mkBoolean verboseErrorsOpt a.verboseErrors <>
-                           mkBoolean commentsOpt a.comments <>
-                           mkBoolean noPrefixOpt a.noPrefix <>
-                           mkPathArray ffiOpt a.ffi
-
-pscDocsOptions :: Foreign -> [String]
-pscDocsOptions opts = either (const []) fold parsed
+        fold (PscMake a) = opt outputOpt a.output <>
+                           opt noPreludeOpt a.noPrelude <>
+                           opt noTcoOpt a.noTco <>
+                           opt noMagicDoOpt a.noMagicDo <>
+                           opt noOptsOpt a.noOpts <>
+                           opt verboseErrorsOpt a.verboseErrors <>
+                           opt commentsOpt a.comments <>
+                           opt noPrefixOpt a.noPrefix <>
+                           opt ffiOpt a.ffi
+
+pscDocsOptions :: Foreign -> Either ForeignError [String]
+pscDocsOptions opts = fold <$> parsed
   where parsed = read opts :: F PscDocs
-        fold (PscDocs a) = mkFormat formatOpt a.format <>
-                           mkDocgen docgenOpt a.docgen
+        fold (PscDocs a) = opt formatOpt a.format <>
+                           opt docgenOpt a.docgen

src/Plugin.purs

@@ -12,6 +12,7 @@ import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Exception (Error())
 import Control.Monad.Error.Class (catchError, throwError)
 
+import Data.Either (Either(..), either)
 import Data.Foreign (Foreign())
 import Data.Foreign.Class (IsForeign, read, readProp)
 import Data.Maybe (Maybe(Just), maybe, fromMaybe)
@@ -72,8 +73,9 @@ foreign import cwd "var cwd = process.cwd();" :: String
 
 foreign import argv "var argv = process.argv.slice(2);" :: [String]
 
-pluginError :: forall eff. String -> Aff (Effects eff) Error
-pluginError msg = liftEff $ flip mkPluginError msg <$> (maybe "" (\(Package a) -> a.name)) <$> package
+throwPluginError :: forall eff. String -> Aff (Effects eff) _
+throwPluginError msg = liftEff (flip mkPluginError msg <$> (maybe "" (\(Package a) -> a.name))
+                                                       <$> package) >>= throwError
 
 resolve :: forall eff. String -> [String] -> Aff (Effects eff) (Tuple String [String])
 resolve cmd args = catchError primary fallback
@@ -90,9 +92,7 @@ resolve cmd args = catchError primary fallback
     fallback _ = (const $ tuple2 cmd args) <$> catchError (which cmd) mapError
 
     mapError :: Error -> Aff (Effects eff) String
-    mapError _ = pluginError ( "Failed to find " ++ cmd ++ ". " ++
-                               "Please ensure it is available on your system."
-                             ) >>= throwError
+    mapError _ = throwPluginError ("Failed to find " ++ cmd ++ ". " ++ "Please ensure it is available on your system.")
 
 execute :: forall eff. String -> [String] -> Aff (Effects eff) String
 execute cmd args = do
@@ -103,30 +103,35 @@ execute cmd args = do
 pathsStream :: forall eff. Eff (through2 :: Through2 | eff) (Stream File [String])
 pathsStream = accStream run
   where run i = if fileIsStream i
-                   then pluginError "Streaming is not supported" >>= throwError
+                   then throwPluginError "Streaming is not supported"
                    else pure $ filePath i
 
 psc :: forall eff. Foreign -> Eff (Effects eff) (Stream File File)
 psc opts = multipipe2 <$> pathsStream <*> objStream run
   where run i = case pscOptionsNoOutput opts of
-                     Tuple out opt ->
+                     Left e -> throwPluginError (show e)
+                     Right (Tuple out opt) ->
                      mkFile (fromMaybe pscOutputDefault out) <$> mkBufferFromString
                                                              <$> execute pscCommand (i <> opt)
 
 pscMake :: forall eff. Foreign -> Eff (Effects eff) (Stream File Unit)
 pscMake opts = multipipe2 <$> pathsStream <*> objStream run
-  where run i = do output <- execute pscMakeCommand (i <> pscMakeOptions opts)
+  where run i = do output <- either (throwPluginError <<< show)
+                                    (\a -> execute pscMakeCommand (i <> a))
+                                    (pscMakeOptions opts)
                    if isVerbose
                       then liftEff $ info $ pscMakeCommand ++ "\n" ++ output
                       else pure unit
 
 pscDocs :: forall eff. Foreign -> Eff (Effects eff) (Stream File File)
 pscDocs opts = multipipe2 <$> pathsStream <*> objStream run
-  where run i = mkFile "." <$> mkBufferFromString
-                           <$> execute pscDocsCommand (pscDocsOptions opts <> i)
+  where run i = case pscDocsOptions opts of
+                     Left e -> throwPluginError (show e)
+                     Right a-> mkFile "." <$> mkBufferFromString
+                                          <$> execute pscDocsCommand (a <> i)
 
 dotPsci :: forall eff. Eff (Effects eff) (Stream File Unit)
 dotPsci = multipipe2 <$> objStream run <*> createWriteStream psciFilename
   where run i = if fileIsStream i
-                   then pluginError "Streaming is not supported" >>= throwError
+                   then throwPluginError "Streaming is not supported"
                    else pure $ psciLoadCommand ++ " " ++ relative cwd (filePath i) ++ "\n"

test.js

@@ -2,6 +2,8 @@
 
 var fs = require('fs');
 
+var path = require('path');
+
 var test = require('tape');
 
 var gulp = require('gulp');
@@ -58,6 +60,21 @@ test('psc - failure', function(t){
   });
 });
 
+test('psc - invalid option type', function(t){
+  t.plan(2);
+
+  var fixture = 'Fixture1.purs';
+
+  var moduleName = path.basename(fixture, '.purs');
+
+  var stream  = purescript.psc({noPrelude: true, module: moduleName});
+
+  gulp.src(fixture).pipe(stream).
+                    on('error', function(e){
+    t.ok(/type mismatch/i.test(e.message), 'should have a failure message');
+    t.equal('Error', e.name);
+  });
+});
 
 test('psci - basic', function(t){
   t.plan(1);
@@ -111,3 +128,17 @@ test('psc-make - error', function(t){
     t.equal('Error', e.name);
   });
 });
+
+test('psc-make - invalid option type', function(t){
+  t.plan(2);
+
+  var stream = purescript.pscMake({noPrelude: 'invalid'});
+
+  var fixture = 'Fixture1.purs';
+
+  gulp.src(fixture).pipe(stream).
+                    on('error', function(e){
+    t.ok(/type mismatch/i.test(e.message), 'should have a failure message');
+    t.equal('Error', e.name);
+  });
+});