Skip to content
This repository was archived by the owner on May 1, 2020. It is now read-only.

Commit 44fdb62

Browse files
ethulethul
committed
Merge pull request #34 from purescript-contrib/topic/issue-31
Topic/issue 31
2 parents a7ffd2b + 20eda91 commit 44fdb62

File tree

3 files changed

+138
-93
lines changed

3 files changed

+138
-93
lines changed

‎src/Options.purs

Lines changed: 91 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -96,7 +96,7 @@ newtype Psc
9696
, output :: NullOrUndefined String
9797
, externs :: NullOrUndefined String
9898
, noPrefix :: NullOrUndefined Boolean
99-
, ffi :: NullOrUndefined [String]
99+
, ffi :: NullOrUndefined PathArray
100100
}
101101

102102
newtype PscMake
@@ -108,14 +108,18 @@ newtype PscMake
108108
, comments :: NullOrUndefined Boolean
109109
, noPrefix :: NullOrUndefined Boolean
110110
, output :: NullOrUndefined String
111-
, ffi :: NullOrUndefined [String]
111+
, ffi :: NullOrUndefined PathArray
112112
}
113113

114114
newtype PscDocs
115115
= PscDocs { format :: NullOrUndefined Format
116-
, docgen :: NullOrUndefined Foreign
116+
, docgen :: NullOrUndefined Docgen
117117
}
118118

119+
newtype Docgen = Docgen Foreign
120+
121+
newtype PathArray = PathArray [String]
122+
119123
data Format = Markdown | ETags | CTags
120124

121125
instance isForeignEither :: (IsForeign a, IsForeign b) => IsForeign (Either a b) where
@@ -181,53 +185,39 @@ instance isForeignPscDocs :: IsForeign PscDocs where
181185
} <$> readProp formatKey obj
182186
<*> readProp docgenOpt obj)
183187

188+
instance isForeignPathArray :: IsForeign PathArray where
189+
read val = PathArray <$> read val
190+
191+
instance isForeignDocgen :: IsForeign Docgen where
192+
read val = Docgen <$> read val
193+
184194
instance isForeignFormat :: IsForeign Format where
185195
read val = read val >>= (\a -> case a of
186196
"markdown" -> Right Markdown
187197
"etags" -> Right ETags
188198
"ctags" -> Right CTags
189199
a -> Left $ TypeMismatch "Format" a)
190200

191-
mkBoolean :: String -> NullOrUndefined Boolean -> [String]
192-
mkBoolean key opt = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined opt)
193-
194-
mkString :: String -> NullOrUndefined String -> [String]
195-
mkString key opt = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined opt)
196-
197-
mkBooleanString :: String -> NullOrUndefined (Either Boolean String) -> [String]
198-
mkBooleanString key opt = maybe [] (either (\a -> mkBoolean key (NullOrUndefined $ Just a))
199-
(\a -> mkString key (NullOrUndefined $ Just a)))
200-
(runNullOrUndefined opt)
201-
202-
mkStringArray :: String -> NullOrUndefined [String] -> [String]
203-
mkStringArray key opt = concat $ mkString key <$> (NullOrUndefined <<< Just)
204-
<$> (fromMaybe [] $ runNullOrUndefined opt)
205-
206-
mkPathArray :: String -> NullOrUndefined [String] -> [String]
207-
mkPathArray key opt = concat $ mkString key <$> (NullOrUndefined <<< Just)
208-
<$> (fromMaybe [] (runNullOrUndefined opt) >>= expandGlob)
201+
class CommandLineOption a where
202+
opt :: String -> NullOrUndefined a -> [String]
209203

210-
mkDocgen :: String -> NullOrUndefined Foreign -> [String]
211-
mkDocgen key opt = concat $ mkString key <$> (NullOrUndefined <<< Just)
212-
<$> (maybe [] parse (runNullOrUndefined opt))
213-
where
214-
parse :: Foreign -> [String]
215-
parse obj = either (const []) id $ parseName obj
216-
<|> parseList obj
217-
<|> parseObj obj
218-
<|> pure []
204+
instance commandLineOptionBoolean :: CommandLineOption Boolean where
205+
opt key val = maybe [] (\a -> if a then ["--" ++ key] else []) (runNullOrUndefined val)
219206

220-
parseName :: Foreign -> F [String]
221-
parseName obj = singleton <$> read obj
207+
instance commandLineOptionString :: CommandLineOption String where
208+
opt key val = maybe [] (\a -> ["--" ++ key ++ "=" ++ a]) (runNullOrUndefined val)
222209

223-
parseList :: Foreign -> F [String]
224-
parseList obj = read obj
210+
instance commandLineOptionEither :: (CommandLineOption a, CommandLineOption b) => CommandLineOption (Either a b) where
211+
opt key val = maybe [] (either (\a -> opt key (NullOrUndefined $ Just a))
212+
(\a -> opt key (NullOrUndefined $ Just a)))
213+
(runNullOrUndefined val)
225214

226-
parseObj :: Foreign -> F [String]
227-
parseObj obj = do
228-
modules <- keys obj
229-
for modules \m -> (\f -> m ++ ":" ++ f) <$> readProp m obj
215+
instance commandLineOptionArray :: (CommandLineOption a) => CommandLineOption [a] where
216+
opt key val = concat $ opt key <$> (NullOrUndefined <<< Just)
217+
<$> (fromMaybe [] $ runNullOrUndefined val)
230218

219+
instance commandLineOptionPathArray :: CommandLineOption PathArray where
220+
opt key val = opt key (NullOrUndefined ((\(PathArray a) -> a >>= expandGlob) <$> (runNullOrUndefined val)))
231221

232222
foreign import expandGlob
233223
"""
@@ -239,55 +229,74 @@ foreign import expandGlob
239229
}());
240230
""" :: String -> [String]
241231

242-
mkFormat :: String -> NullOrUndefined Format -> [String]
243-
mkFormat key opt = mkString key (maybe j (\a -> case a of
244-
Markdown -> i "markdown"
245-
ETags -> i "etags"
246-
CTags -> i "ctags") $ runNullOrUndefined opt)
247-
where i a = NullOrUndefined $ Just a
248-
j = NullOrUndefined Nothing
232+
instance commandLineOptionDocgen :: CommandLineOption Docgen where
233+
opt key val = opt key (NullOrUndefined (parseDocgen <$> (runNullOrUndefined val)))
249234

250-
foldPscOptions :: Psc -> [String]
251-
foldPscOptions (Psc a) = mkBoolean noPreludeOpt a.noPrelude <>
252-
mkBoolean noTcoOpt a.noTco <>
253-
mkBoolean noMagicDoOpt a.noMagicDo <>
254-
mkBooleanString mainOpt a.main <>
255-
mkBoolean noOptsOpt a.noOpts <>
256-
mkBoolean verboseErrorsOpt a.verboseErrors <>
257-
mkBoolean commentsOpt a.comments <>
258-
mkString browserNamespaceOpt a.browserNamespace <>
259-
mkStringArray moduleOpt a."module" <>
260-
mkStringArray codegenOpt a.codegen <>
261-
mkString outputOpt a.output <>
262-
mkString externsOpt a.externs <>
263-
mkBoolean noPrefixOpt a.noPrefix <>
264-
mkPathArray ffiOpt a.ffi
265-
266-
pscOptions :: Foreign -> [String]
267-
pscOptions opts = either (const []) foldPscOptions parsed
268-
where parsed = read opts :: F Psc
235+
parseDocgen :: Docgen -> [String]
236+
parseDocgen (Docgen obj) = either (const []) id $ parseName obj
237+
<|> parseList obj
238+
<|> parseObj obj
239+
<|> pure []
240+
where
241+
parseName :: Foreign -> F [String]
242+
parseName obj = singleton <$> read obj
269243

270-
pscOptionsNoOutput :: Foreign -> Tuple (Maybe String) [String]
271-
pscOptionsNoOutput opts = either (const $ tuple2 Nothing []) fold parsed
244+
parseList :: Foreign -> F [String]
245+
parseList obj = read obj
246+
247+
parseObj :: Foreign -> F [String]
248+
parseObj obj = do
249+
modules <- keys obj
250+
for modules \m -> (\f -> m ++ ":" ++ f) <$> readProp m obj
251+
252+
instance commandLineOptionFormat :: CommandLineOption Format where
253+
opt key val = opt key (maybe (NullOrUndefined Nothing)
254+
(\a -> case a of
255+
Markdown -> NullOrUndefined (Just "markdown")
256+
ETags -> NullOrUndefined (Just "etags")
257+
CTags -> NullOrUndefined (Just "ctags"))
258+
(runNullOrUndefined val))
259+
260+
foldPscOptions :: Psc -> [String]
261+
foldPscOptions (Psc a) = opt noPreludeOpt a.noPrelude <>
262+
opt noTcoOpt a.noTco <>
263+
opt noMagicDoOpt a.noMagicDo <>
264+
opt mainOpt a.main <>
265+
opt noOptsOpt a.noOpts <>
266+
opt verboseErrorsOpt a.verboseErrors <>
267+
opt commentsOpt a.comments <>
268+
opt browserNamespaceOpt a.browserNamespace <>
269+
opt moduleOpt a."module" <>
270+
opt codegenOpt a.codegen <>
271+
opt outputOpt a.output <>
272+
opt externsOpt a.externs <>
273+
opt noPrefixOpt a.noPrefix <>
274+
opt ffiOpt a.ffi
275+
276+
pscOptions :: Foreign -> Either ForeignError [String]
277+
pscOptions opts = foldPscOptions <$> (read opts :: F Psc)
278+
279+
pscOptionsNoOutput :: Foreign -> Either ForeignError (Tuple (Maybe String) [String])
280+
pscOptionsNoOutput opts = fold <$> parsed
272281
where parsed = read opts :: F Psc
273282
fold (Psc a) = tuple2 (runNullOrUndefined a.output)
274283
(foldPscOptions (Psc $ a { output = NullOrUndefined Nothing }))
275284

276-
pscMakeOptions :: Foreign -> [String]
277-
pscMakeOptions opts = either (const []) fold parsed
285+
pscMakeOptions :: Foreign -> Either ForeignError [String]
286+
pscMakeOptions opts = fold <$> parsed
278287
where parsed = read opts :: F PscMake
279-
fold (PscMake a) = mkString outputOpt a.output <>
280-
mkBoolean noPreludeOpt a.noPrelude <>
281-
mkBoolean noTcoOpt a.noTco <>
282-
mkBoolean noMagicDoOpt a.noMagicDo <>
283-
mkBoolean noOptsOpt a.noOpts <>
284-
mkBoolean verboseErrorsOpt a.verboseErrors <>
285-
mkBoolean commentsOpt a.comments <>
286-
mkBoolean noPrefixOpt a.noPrefix <>
287-
mkPathArray ffiOpt a.ffi
288-
289-
pscDocsOptions :: Foreign -> [String]
290-
pscDocsOptions opts = either (const []) fold parsed
288+
fold (PscMake a) = opt outputOpt a.output <>
289+
opt noPreludeOpt a.noPrelude <>
290+
opt noTcoOpt a.noTco <>
291+
opt noMagicDoOpt a.noMagicDo <>
292+
opt noOptsOpt a.noOpts <>
293+
opt verboseErrorsOpt a.verboseErrors <>
294+
opt commentsOpt a.comments <>
295+
opt noPrefixOpt a.noPrefix <>
296+
opt ffiOpt a.ffi
297+
298+
pscDocsOptions :: Foreign -> Either ForeignError [String]
299+
pscDocsOptions opts = fold <$> parsed
291300
where parsed = read opts :: F PscDocs
292-
fold (PscDocs a) = mkFormat formatOpt a.format <>
293-
mkDocgen docgenOpt a.docgen
301+
fold (PscDocs a) = opt formatOpt a.format <>
302+
opt docgenOpt a.docgen

‎src/Plugin.purs

Lines changed: 16 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import Control.Monad.Eff.Class (liftEff)
1212
import Control.Monad.Eff.Exception (Error())
1313
import Control.Monad.Error.Class (catchError, throwError)
1414

15+
import Data.Either (Either(..), either)
1516
import Data.Foreign (Foreign())
1617
import Data.Foreign.Class (IsForeign, read, readProp)
1718
import Data.Maybe (Maybe(Just), maybe, fromMaybe)
@@ -72,8 +73,9 @@ foreign import cwd "var cwd = process.cwd();" :: String
7273

7374
foreign import argv "var argv = process.argv.slice(2);" :: [String]
7475

75-
pluginError :: forall eff. String -> Aff (Effects eff) Error
76-
pluginError msg = liftEff $ flip mkPluginError msg <$> (maybe "" (\(Package a) -> a.name)) <$> package
76+
throwPluginError :: forall eff. String -> Aff (Effects eff) _
77+
throwPluginError msg = liftEff (flip mkPluginError msg <$> (maybe "" (\(Package a) -> a.name))
78+
<$> package) >>= throwError
7779

7880
resolve :: forall eff. String -> [String] -> Aff (Effects eff) (Tuple String [String])
7981
resolve cmd args = catchError primary fallback
@@ -90,9 +92,7 @@ resolve cmd args = catchError primary fallback
9092
fallback _ = (const $ tuple2 cmd args) <$> catchError (which cmd) mapError
9193

9294
mapError :: Error -> Aff (Effects eff) String
93-
mapError _ = pluginError ( "Failed to find " ++ cmd ++ ". " ++
94-
"Please ensure it is available on your system."
95-
) >>= throwError
95+
mapError _ = throwPluginError ("Failed to find " ++ cmd ++ ". " ++ "Please ensure it is available on your system.")
9696

9797
execute :: forall eff. String -> [String] -> Aff (Effects eff) String
9898
execute cmd args = do
@@ -103,30 +103,35 @@ execute cmd args = do
103103
pathsStream :: forall eff. Eff (through2 :: Through2 | eff) (Stream File [String])
104104
pathsStream = accStream run
105105
where run i = if fileIsStream i
106-
then pluginError "Streaming is not supported" >>= throwError
106+
then throwPluginError "Streaming is not supported"
107107
else pure $ filePath i
108108

109109
psc :: forall eff. Foreign -> Eff (Effects eff) (Stream File File)
110110
psc opts = multipipe2 <$> pathsStream <*> objStream run
111111
where run i = case pscOptionsNoOutput opts of
112-
Tuple out opt ->
112+
Left e -> throwPluginError (show e)
113+
Right (Tuple out opt) ->
113114
mkFile (fromMaybe pscOutputDefault out) <$> mkBufferFromString
114115
<$> execute pscCommand (i <> opt)
115116

116117
pscMake :: forall eff. Foreign -> Eff (Effects eff) (Stream File Unit)
117118
pscMake opts = multipipe2 <$> pathsStream <*> objStream run
118-
where run i = do output <- execute pscMakeCommand (i <> pscMakeOptions opts)
119+
where run i = do output <- either (throwPluginError <<< show)
120+
(\a -> execute pscMakeCommand (i <> a))
121+
(pscMakeOptions opts)
119122
if isVerbose
120123
then liftEff $ info $ pscMakeCommand ++ "\n" ++ output
121124
else pure unit
122125

123126
pscDocs :: forall eff. Foreign -> Eff (Effects eff) (Stream File File)
124127
pscDocs opts = multipipe2 <$> pathsStream <*> objStream run
125-
where run i = mkFile "." <$> mkBufferFromString
126-
<$> execute pscDocsCommand (pscDocsOptions opts <> i)
128+
where run i = case pscDocsOptions opts of
129+
Left e -> throwPluginError (show e)
130+
Right a-> mkFile "." <$> mkBufferFromString
131+
<$> execute pscDocsCommand (a <> i)
127132

128133
dotPsci :: forall eff. Eff (Effects eff) (Stream File Unit)
129134
dotPsci = multipipe2 <$> objStream run <*> createWriteStream psciFilename
130135
where run i = if fileIsStream i
131-
then pluginError "Streaming is not supported" >>= throwError
136+
then throwPluginError "Streaming is not supported"
132137
else pure $ psciLoadCommand ++ " " ++ relative cwd (filePath i) ++ "\n"

‎test.js

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22

33
var fs = require('fs');
44

5+
var path = require('path');
6+
57
var test = require('tape');
68

79
var gulp = require('gulp');
@@ -58,6 +60,21 @@ test('psc - failure', function(t){
5860
});
5961
});
6062

63+
test('psc - invalid option type', function(t){
64+
t.plan(2);
65+
66+
var fixture = 'Fixture1.purs';
67+
68+
var moduleName = path.basename(fixture, '.purs');
69+
70+
var stream = purescript.psc({noPrelude: true, module: moduleName});
71+
72+
gulp.src(fixture).pipe(stream).
73+
on('error', function(e){
74+
t.ok(/type mismatch/i.test(e.message), 'should have a failure message');
75+
t.equal('Error', e.name);
76+
});
77+
});
6178

6279
test('psci - basic', function(t){
6380
t.plan(1);
@@ -111,3 +128,17 @@ test('psc-make - error', function(t){
111128
t.equal('Error', e.name);
112129
});
113130
});
131+
132+
test('psc-make - invalid option type', function(t){
133+
t.plan(2);
134+
135+
var stream = purescript.pscMake({noPrelude: 'invalid'});
136+
137+
var fixture = 'Fixture1.purs';
138+
139+
gulp.src(fixture).pipe(stream).
140+
on('error', function(e){
141+
t.ok(/type mismatch/i.test(e.message), 'should have a failure message');
142+
t.equal('Error', e.name);
143+
});
144+
});

0 commit comments

Comments
 (0)