Skip to content

Commit bc598f8

Browse files
bergmarkbergmark
committed
Selective hlinting
1 parent a2ebb4c commit bc598f8

File tree

20 files changed

+169
-189
lines changed

20 files changed

+169
-189
lines changed

‎src/Fay.hs‎

Lines changed: 13 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,8 @@ compileFromTo config filein fileout = do
3939
(compileFromToAndGenerateHtml config filein)
4040
fileout
4141
case result of
42-
Right out -> maybe (putStrLn out) (flip writeFile out) fileout
43-
Left err -> error $ showCompileError $ err
42+
Right out -> maybe (putStrLn out) (`writeFile` out) fileout
43+
Left err -> error $ showCompileError err
4444

4545
-- | Compile the given file and write to the output, also generate any HTML.
4646
compileFromToAndGenerateHtml :: CompileConfig -> FilePath -> FilePath -> IO (Either CompileError String)
@@ -54,7 +54,7 @@ compileFromToAndGenerateHtml config filein fileout = do
5454
, "<html>"
5555
, " <head>"
5656
," <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>"
57-
, unlines . map (" "++) . map makeScriptTagSrc $ configHtmlJSLibs config
57+
, unlines . map ((" "++) . makeScriptTagSrc) $ configHtmlJSLibs config
5858
, " " ++ makeScriptTagSrc relativeJsPath
5959
, " </script>"
6060
, " </head>"
@@ -64,14 +64,12 @@ compileFromToAndGenerateHtml config filein fileout = do
6464
return (Right out)
6565
where relativeJsPath = makeRelative (dropFileName fileout) fileout
6666
makeScriptTagSrc :: FilePath -> String
67-
makeScriptTagSrc = \s ->
68-
"<script type=\"text/javascript\" src=\"" ++ s ++ "\"></script>"
67+
makeScriptTagSrc s = "<script type=\"text/javascript\" src=\"" ++ s ++ "\"></script>"
6968
Left err -> return (Left err)
7069

7170
-- | Compile the given file.
7271
compileFile :: CompileConfig -> FilePath -> IO (Either CompileError String)
73-
compileFile config filein = do
74-
either Left (Right . fst) <$> compileFileWithState config filein
72+
compileFile config filein = either Left (Right . fst) <$> compileFileWithState config filein
7573

7674
-- | Compile a file returning the state.
7775
compileFileWithState :: CompileConfig -> FilePath -> IO (Either CompileError (String,CompileState))
@@ -89,16 +87,16 @@ compileToModule :: (Show from,Show to,CompilesTo from to)
8987
-> IO (Either CompileError (String,CompileState))
9088
compileToModule filepath config raw with hscode = do
9189
result <- compileViaStr filepath config with hscode
92-
case result of
93-
Left err -> return (Left err)
94-
Right (PrintState{..},state,_) -> do
95-
return $ Right ( generateWrapped (concat $ reverse psOutput)
96-
(stateModuleName state)
97-
, state
98-
)
90+
return $ case result of
91+
Left err -> Left err
92+
Right (PrintState{..},state,_) ->
93+
Right ( generateWrapped (concat $ reverse psOutput)
94+
(stateModuleName state)
95+
, state
96+
)
9997
where
10098
generateWrapped jscode (ModuleName modulename) =
101-
unlines $ filter (not . null) $
99+
unlines $ filter (not . null)
102100
[if configExportRuntime config then raw else ""
103101
,jscode
104102
,"// Exports"

‎src/Fay/Compiler.hs‎

Lines changed: 9 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,7 @@ compileModuleFromFile fp = io (readFile fp) >>= compileModule fp
103103

104104
-- | Compile a source string.
105105
compileModuleFromContents :: String -> Compile [JsStmt]
106-
compileModuleFromContents contents = compileModule "<interactive>" contents
106+
compileModuleFromContents = compileModule "<interactive>"
107107

108108
-- | Lookup a module from include directories and compile.
109109
compileModuleFromName :: ModuleName -> Compile [JsStmt]
@@ -122,8 +122,7 @@ compileModuleFromName name =
122122
dirs <- configDirectoryIncludePaths <$> config id
123123
(filepath,contents) <- findImport dirs name
124124
modify $ \s -> s { stateImported = (name,filepath) : imported }
125-
res <- importIt filepath contents
126-
return res
125+
importIt filepath contents
127126

128127
-- | Compile given the location and source string.
129128
compileModule :: FilePath -> String -> Compile [JsStmt]
@@ -166,14 +165,14 @@ compileModuleFromAST (Module _ modulename _pragmas Nothing _exports imports decl
166165
exportStdlibOnly <- config configExportStdlibOnly
167166
modulePaths <- createModulePath modulename
168167
extExports <- generateExports
169-
let stmts = (imported ++ modulePaths ++ current ++ extExports)
170-
if exportStdlibOnly
168+
let stmts = imported ++ modulePaths ++ current ++ extExports
169+
return $ if exportStdlibOnly
171170
then if anStdlibModule modulename
172-
then return stmts
173-
else return []
171+
then stmts
172+
else []
174173
else if not exportStdlib && anStdlibModule modulename
175-
then return []
176-
else return stmts
174+
then []
175+
else stmts
177176
compileModuleFromAST mod = throwError (UnsupportedModuleSyntax mod)
178177

179178
instance CompilesTo Module [JsStmt] where compileTo = compileModuleFromAST
@@ -214,7 +213,7 @@ generateExports = do
214213
-- | Is the module a standard module, i.e., one that we'd rather not
215214
-- output code for if we're compiling separate files.
216215
anStdlibModule :: ModuleName -> Bool
217-
anStdlibModule (ModuleName name) = elem name ["Prelude","FFI","Language.Fay.FFI","Data.Data"]
216+
anStdlibModule (ModuleName name) = name `elem` ["Prelude","FFI","Language.Fay.FFI","Data.Data"]
218217

219218
-- | Compile the given import.
220219
compileImport :: ImportDecl -> Compile [JsStmt]

‎src/Fay/Compiler/Config.hs‎

Lines changed: 22 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -38,26 +38,25 @@ addConfigPackages fps cfg = foldl (flip addConfigPackage) cfg fps
3838

3939
-- | Default configuration.
4040
instance Default CompileConfig where
41-
def =
42-
addConfigPackage "fay-base" $
43-
CompileConfig
44-
{ configOptimize = False
45-
, configFlattenApps = False
46-
, configExportBuiltins = True
47-
, configExportRuntime = True
48-
, configExportStdlib = True
49-
, configExportStdlibOnly = False
50-
, configDirectoryIncludes = []
51-
, configPrettyPrint = False
52-
, configHtmlWrapper = False
53-
, configHtmlJSLibs = []
54-
, configLibrary = False
55-
, configWarn = True
56-
, configFilePath = Nothing
57-
, configTypecheck = True
58-
, configWall = False
59-
, configGClosure = False
60-
, configPackageConf = Nothing
61-
, configPackages = []
62-
, configBasePath = Nothing
63-
}
41+
def = addConfigPackage "fay-base"
42+
CompileConfig
43+
{ configOptimize = False
44+
, configFlattenApps = False
45+
, configExportBuiltins = True
46+
, configExportRuntime = True
47+
, configExportStdlib = True
48+
, configExportStdlibOnly = False
49+
, configDirectoryIncludes = []
50+
, configPrettyPrint = False
51+
, configHtmlWrapper = False
52+
, configHtmlJSLibs = []
53+
, configLibrary = False
54+
, configWarn = True
55+
, configFilePath = Nothing
56+
, configTypecheck = True
57+
, configWall = False
58+
, configGClosure = False
59+
, configPackageConf = Nothing
60+
, configPackages = []
61+
, configBasePath = Nothing
62+
}

‎src/Fay/Compiler/Debug.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -57,5 +57,4 @@ printCompile config with from = do
5757
result <- compileViaStr "<interactive>" config { configPrettyPrint = True } with from
5858
case result of
5959
Left err -> print err
60-
Right (PrintState{..},_,_) -> do
61-
putStrLn (concat (reverse (psOutput)))
60+
Right (PrintState{..},_,_) -> putStrLn . concat . reverse $ psOutput

‎src/Fay/Compiler/Decl.hs‎

Lines changed: 7 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ compilePatBind toplevel sig pat =
6767
Just sig -> compileFFI srcloc ident formatstr sig
6868
Nothing -> throwError (FfiNeedsTypeSig pat)
6969
_ -> compileUnguardedRhs srcloc toplevel ident rhs
70-
PatBind srcloc (PVar ident) Nothing (UnGuardedRhs rhs) bdecls -> do
70+
PatBind srcloc (PVar ident) Nothing (UnGuardedRhs rhs) bdecls ->
7171
compileUnguardedRhs srcloc toplevel ident (Let bdecls rhs)
7272
PatBind srcloc pat Nothing (UnGuardedRhs rhs) _bdecls -> do
7373
exp <- compileExp rhs
@@ -94,7 +94,7 @@ compileDataDecl toplevel tyvars constructors =
9494
case condecl of
9595
ConDecl name types -> do
9696
let fields = map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types
97-
fields' = (zip (map return fields) types)
97+
fields' = zip (map return fields) types
9898
cons <- makeConstructor name fields
9999
func <- makeFunc name fields
100100
emitFayToJs name tyvars fields'
@@ -129,7 +129,7 @@ compileDataDecl toplevel tyvars constructors =
129129
qname <- qualify name
130130
return $
131131
JsSetConstructor qname $
132-
JsFun (Just $ JsConstructor $ qname)
132+
JsFun (Just $ JsConstructor qname)
133133
fields
134134
(for fields $ \field -> JsSetProp JsThis field (JsName field))
135135
Nothing
@@ -145,13 +145,11 @@ compileDataDecl toplevel tyvars constructors =
145145
fields
146146
added <- gets (addedModulePath mp)
147147
if added
148-
then do
149-
return $ JsSetQName qname $
150-
JsApp (JsName $ JsBuiltIn "objConcat") [func, JsName $ JsNameVar qname]
148+
then return . JsSetQName qname $ JsApp (JsName $ JsBuiltIn "objConcat")
149+
[func, JsName $ JsNameVar qname]
151150
else do
152151
modify $ addModulePath mp
153-
return $ JsSetQName qname $ func
154-
152+
return $ JsSetQName qname func
155153

156154
-- Creates getters for a RecDecl's values
157155
makeAccessors :: SrcLoc -> [Name] -> Compile [JsStmt]
@@ -183,7 +181,7 @@ compileFunCase toplevel matches@(Match _ name argslen _ _ _:_) = do
183181
isWildCardMatch (Match _ _ pats _ _ _) = all isWildCardPat pats
184182

185183
compileCase :: Match -> Compile [JsStmt]
186-
compileCase match@(Match _ _ pats _ rhs _) = do
184+
compileCase match@(Match _ _ pats _ rhs _) =
187185
withScope $ do
188186
whereDecls' <- whereDecls match
189187
generateScope $ zipWithM (\arg pat -> compilePat (JsName arg) pat []) args pats

‎src/Fay/Compiler/Defaults.hs‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -29,16 +29,16 @@ defaultCompileReader config = do
2929
defaultCompileState :: IO CompileState
3030
defaultCompileState = do
3131
types <- getDataFileName "src/Language/Fay/Types.hs"
32-
return $ CompileState {
33-
_stateExports = M.empty
34-
, stateModuleName = ModuleName "Main"
35-
, stateRecordTypes = []
36-
, stateRecords = []
37-
, stateNewtypes = []
38-
, stateImported = [("Fay.Types",types)]
39-
, stateNameDepth = 1
40-
, stateLocalScope = S.empty
41-
, stateModuleScope = def
42-
, stateModuleScopes = M.empty
43-
, stateJsModulePaths = S.empty
44-
}
32+
return CompileState
33+
{ _stateExports = M.empty
34+
, stateModuleName = ModuleName "Main"
35+
, stateRecordTypes = []
36+
, stateRecords = []
37+
, stateNewtypes = []
38+
, stateImported = [("Fay.Types",types)]
39+
, stateNameDepth = 1
40+
, stateLocalScope = S.empty
41+
, stateModuleScope = def
42+
, stateModuleScopes = M.empty
43+
, stateJsModulePaths = S.empty
44+
}

‎src/Fay/Compiler/Exp.hs‎

Lines changed: 9 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -79,9 +79,9 @@ compileLit lit =
7979

8080
-- | Compile simple application.
8181
compileApp :: Exp -> Exp -> Compile JsExp
82-
compileApp exp1@(Con q) exp2 = do
82+
compileApp exp1@(Con q) exp2 =
8383
maybe (compileApp' exp1 exp2) (const $ compileExp exp2) =<< lookupNewtypeConst q
84-
compileApp exp1@(Var q) exp2 = do
84+
compileApp exp1@(Var q) exp2 =
8585
maybe (compileApp' exp1 exp2) (const $ compileExp exp2) =<< lookupNewtypeDest q
8686
compileApp exp1 exp2 =
8787
compileApp' exp1 exp2
@@ -132,7 +132,7 @@ compileInfixApp exp1 ap exp2 = compileExp (App (App (Var op) exp1) exp2)
132132

133133
-- | Compile a let expression.
134134
compileLet :: [Decl] -> Exp -> Compile JsExp
135-
compileLet decls exp = do
135+
compileLet decls exp =
136136
withScope $ do
137137
generateScope $ mapM compileLetDecl decls
138138
binds <- mapM compileLetDecl decls
@@ -143,12 +143,11 @@ compileLet decls exp = do
143143
compileLetDecl :: Decl -> Compile [JsStmt]
144144
compileLetDecl decl = do
145145
compileDecls <- asks readerCompileDecls
146-
v <- case decl of
146+
case decl of
147147
decl@PatBind{} -> compileDecls False [decl]
148148
decl@FunBind{} -> compileDecls False [decl]
149149
TypeSig{} -> return []
150150
_ -> throwError (UnsupportedLetBinding decl)
151-
return v
152151

153152
-- | Compile a list expression.
154153
compileList :: [Exp] -> Compile JsExp
@@ -200,11 +199,11 @@ compileGuardedAlt alt =
200199
-- | Compile guards
201200
compileGuards :: [GuardedRhs] -> Compile JsStmt
202201
compileGuards ((GuardedRhs _ (Qualifier (Var (UnQual (Ident "otherwise"))):_) exp):_) =
203-
(\e -> JsIf (JsLit (JsBool True)) [JsEarlyReturn e] []) <$> compileExp exp
202+
(\e -> JsIf (JsLit $ JsBool True) [JsEarlyReturn e] []) <$> compileExp exp
204203
compileGuards (GuardedRhs _ (Qualifier guard:_) exp : rest) =
205204
makeIf <$> fmap force (compileExp guard)
206205
<*> compileExp exp
207-
<*> if null rest then (return []) else do
206+
<*> if null rest then return [] else do
208207
gs' <- compileGuards rest
209208
return [gs']
210209
where makeIf gs e gss = JsIf gs [JsEarlyReturn e] gss
@@ -219,10 +218,10 @@ compileDoBlock stmts = do
219218

220219
-- | Compile a lambda.
221220
compileLambda :: [Pat] -> Exp -> Compile JsExp
222-
compileLambda pats exp = do
221+
compileLambda pats exp =
223222
withScope $ do
224223
generateScope $ generateStatements JsNull
225-
exp <- compileExp exp
224+
exp <- compileExp exp
226225
stmts <- generateStatements exp
227226
case stmts of
228227
[JsEarlyReturn fun@JsFun{}] -> return fun
@@ -351,7 +350,7 @@ desugarListComp _ (s : _ ) =
351350

352351
-- | Make a Fay list.
353352
makeList :: [JsExp] -> JsExp
354-
makeList exps = (JsApp (JsName (JsBuiltIn "list")) [JsList exps])
353+
makeList exps = JsApp (JsName $ JsBuiltIn "list") [JsList exps]
355354

356355
-- | Compile a statement of a do block.
357356
compileStmt :: Maybe Exp -> Stmt -> Compile (Maybe Exp)

0 commit comments

Comments
 (0)