1
1
mirror of https://github.com/aelve/guide.git synced 2024-11-23 04:07:14 +03:00

Fix some lints

This commit is contained in:
Aaron Friel 2017-01-23 18:09:24 +00:00
parent 30426c0fc6
commit f54658160f
10 changed files with 53 additions and 78 deletions

View File

@ -1,7 +1,4 @@
{-# LANGUAGE {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
module Cache module Cache
( (

View File

@ -1,7 +1,5 @@
{-# LANGUAGE {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
module Config module Config
@ -69,7 +67,7 @@ readConfig :: IO Config
readConfig = do readConfig = do
let filename = "config.json" let filename = "config.json"
exists <- doesFileExist filename exists <- doesFileExist filename
when (not exists) $ do unless exists $ do
putStrLn "config.json doesn't exist, creating it" putStrLn "config.json doesn't exist, creating it"
BSL.writeFile filename (Aeson.encodePretty (def :: Config)) BSL.writeFile filename (Aeson.encodePretty (def :: Config))
contents <- BSL.fromStrict <$> BS.readFile filename contents <- BSL.fromStrict <$> BS.readFile filename

View File

@ -1,12 +1,9 @@
{-# LANGUAGE {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE ScopedTypeVariables #-}
ScopedTypeVariables, {-# LANGUAGE TypeFamilies #-}
TypeFamilies, {-# LANGUAGE DataKinds #-}
DataKinds, {-# LANGUAGE FlexibleContexts #-}
FlexibleContexts, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
module Guide module Guide
( (

View File

@ -1,12 +1,9 @@
{-# LANGUAGE {-# LANGUAGE FlexibleInstances #-}
FlexibleInstances, {-# LANGUAGE GeneralizedNewtypeDeriving #-}
GeneralizedNewtypeDeriving, {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE QuasiQuotes #-}
QuasiQuotes, {-# LANGUAGE BangPatterns #-}
BangPatterns, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
-- TODO: try to make it more type-safe somehow? -- TODO: try to make it more type-safe somehow?

View File

@ -1,10 +1,7 @@
{-# LANGUAGE {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE FlexibleInstances #-}
FlexibleInstances, {-# LANGUAGE FlexibleContexts #-}
FlexibleContexts, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
module Markdown module Markdown
( (

View File

@ -1,7 +1,5 @@
{-# LANGUAGE {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
module Merge module Merge
@ -36,7 +34,7 @@ merge orig a b = T.concat . V.toList $ PV.apply (pa <> pb') orig'
V.fromList . consolidate . map T.toStrict . break' . T.toString V.fromList . consolidate . map T.toStrict . break' . T.toString
pa = PV.diff orig' a' pa = PV.diff orig' a'
pb = PV.diff orig' b' pb = PV.diff orig' b'
(_, pb') = PV.transformWith PV.ours pa pb (_, pb') = PV.transformWith PV.ours pa pb
-- | Break a string into words, spaces, and special characters. -- | Break a string into words, spaces, and special characters.
break' :: String -> [String] break' :: String -> [String]

View File

@ -1,6 +1,4 @@
{-# LANGUAGE {-# LANGUAGE CPP #-}
CPP
#-}
-- Hack for bug in older Cabal versions -- Hack for bug in older Cabal versions
@ -38,7 +36,7 @@ internalDeriveSafeCopySorted versionId kindName tyName = do
internalDeriveSafeCopySorted' versionId kindName tyName info internalDeriveSafeCopySorted' versionId kindName tyName info
internalDeriveSafeCopySorted' :: Version a -> Name -> Name -> Info -> Q [Dec] internalDeriveSafeCopySorted' :: Version a -> Name -> Name -> Info -> Q [Dec]
internalDeriveSafeCopySorted' versionId kindName tyName info = do internalDeriveSafeCopySorted' versionId kindName tyName info =
case info of case info of
#if MIN_VERSION_template_haskell(2,11,0) #if MIN_VERSION_template_haskell(2,11,0)
TyConI (DataD context _name tyvars _kind cons _derivs) TyConI (DataD context _name tyvars _kind cons _derivs)

View File

@ -1,11 +1,9 @@
{-# LANGUAGE {-# LANGUAGE QuasiQuotes #-}
QuasiQuotes, {-# LANGUAGE FlexibleContexts #-}
FlexibleContexts, {-# LANGUAGE FlexibleInstances #-}
FlexibleInstances, {-# LANGUAGE TypeFamilies #-}
TypeFamilies, {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
@ -935,7 +933,7 @@ setItemGroup itemId newGroup = do
-- is moved to a different group. Note that this is done after adding a new -- is moved to a different group. Note that this is done after adding a new
-- group because we also want the color to change. So, if the item was the -- group because we also want the color to change. So, if the item was the
-- only item in its group, the sequence of actions is as follows: -- only item in its group, the sequence of actions is as follows:
-- --
-- * new group is added (and hence a new color is assigned) -- * new group is added (and hence a new color is assigned)
-- * old group is deleted (and now the old color is unused) -- * old group is deleted (and now the old color is unused)
oldGroup <- use (itemLens.group_) oldGroup <- use (itemLens.group_)

View File

@ -1,13 +1,11 @@
{-# LANGUAGE {-# LANGUAGE ScopedTypeVariables #-}
ScopedTypeVariables, {-# LANGUAGE QuasiQuotes #-}
QuasiQuotes, {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE GeneralizedNewtypeDeriving #-}
GeneralizedNewtypeDeriving, {-# LANGUAGE FlexibleContexts #-}
FlexibleContexts, {-# LANGUAGE FlexibleInstances #-}
FlexibleInstances, {-# LANGUAGE TypeFamilies #-}
TypeFamilies, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
@ -32,7 +30,7 @@ module Utils
-- * IP -- * IP
sockAddrToIP, sockAddrToIP,
-- * UID -- * UID
Uid(..), Uid(..),
Node, Node,
@ -114,12 +112,12 @@ import Data.Generics.Uniplate.Data (transform)
-- | Move the -1st element that satisfies the predicate- up. -- | Move the -1st element that satisfies the predicate- up.
moveUp :: (a -> Bool) -> [a] -> [a] moveUp :: (a -> Bool) -> [a] -> [a]
moveUp p (x:y:xs) = if p y then (y:x:xs) else x : moveUp p (y:xs) moveUp p (x:y:xs) = if p y then y : x : xs else x : moveUp p (y:xs)
moveUp _ xs = xs moveUp _ xs = xs
-- | Move the -1st element that satisfies the predicate- down. -- | Move the -1st element that satisfies the predicate- down.
moveDown :: (a -> Bool) -> [a] -> [a] moveDown :: (a -> Bool) -> [a] -> [a]
moveDown p (x:y:xs) = if p x then (y:x:xs) else x : moveDown p (y:xs) moveDown p (x:y:xs) = if p x then y : x : xs else x : moveDown p (y:xs)
moveDown _ xs = xs moveDown _ xs = xs
deleteFirst :: (a -> Bool) -> [a] -> [a] deleteFirst :: (a -> Bool) -> [a] -> [a]
@ -386,11 +384,11 @@ changelog bareTyName (newVer, Past oldVer) changes = do
_ -> fail "changelog: the type must be a record" _ -> fail "changelog: the type must be a record"
-- Check that all 'Added' fields are actually present in the new type -- Check that all 'Added' fields are actually present in the new type
-- and that all 'Removed' fields aren't there -- and that all 'Removed' fields aren't there
for_ (M.keys added) $ \n -> do for_ (M.keys added) $ \n ->
unless (n `elem` map fst fields) $ fail $ unless (n `elem` map fst fields) $ fail $
printf "changelog: field %s isn't present in %s" printf "changelog: field %s isn't present in %s"
(show (mkNew n)) (show newTyName) (show (mkNew n)) (show newTyName)
for_ (M.keys removed) $ \n -> do for_ (M.keys removed) $ \n ->
when (n `elem` map fst fields) $ fail $ when (n `elem` map fst fields) $ fail $
printf "changelog: field %s is present in %s \ printf "changelog: field %s is present in %s \
\but was supposed to be removed" \but was supposed to be removed"
@ -491,7 +489,7 @@ genVer tyName ver constructors = do
(bangType bangNotStrict (conT fType)) (bangType bangNotStrict (conT fType))
| (fName, fType) <- fields] | (fName, fType) <- fields]
cons' <- for constructors $ \genCons -> do cons' <- for constructors $ \genCons ->
case genCons of case genCons of
Copy conName -> copyConstructor conName Copy conName -> copyConstructor conName
Custom conName fields -> customConstructor conName fields Custom conName fields -> customConstructor conName fields
@ -546,7 +544,7 @@ migrateVer tyName ver constructors = do
(normalB res) (normalB res)
[] []
branches' <- for constructors $ \genCons -> do branches' <- for constructors $ \genCons ->
case genCons of case genCons of
CopyM conName -> copyConstructor conName CopyM conName -> copyConstructor conName
CustomM conName res -> customConstructor conName res CustomM conName res -> customConstructor conName res

View File

@ -1,10 +1,7 @@
{-# LANGUAGE {-# LANGUAGE QuasiQuotes #-}
QuasiQuotes, {-# LANGUAGE OverloadedStrings #-}
OverloadedStrings, {-# LANGUAGE FlexibleContexts #-}
FlexibleContexts, {-# LANGUAGE NoImplicitPrelude #-}
NoImplicitPrelude
#-}
module View module View
( (
@ -1258,7 +1255,7 @@ markdownEditor attr (view mdText -> s) submit cancel instr = do
cancel cancel
emptySpan "6px" emptySpan "6px"
span_ [class_ "edit-field-instruction"] (toHtml instr) span_ [class_ "edit-field-instruction"] (toHtml instr)
a_ [href_ "/markdown", target_ "_blank"] $ a_ [href_ "/markdown", target_ "_blank"] $
img_ [src_ "/markdown.svg", alt_ "markdown supported", class_ " markdown-supported "] img_ [src_ "/markdown.svg", alt_ "markdown supported", class_ " markdown-supported "]
smallMarkdownEditor smallMarkdownEditor
@ -1284,7 +1281,7 @@ smallMarkdownEditor attr (view mdText -> s) submit mbCancel instr = do
cancel cancel
span_ [style_ "float:right"] $ do span_ [style_ "float:right"] $ do
span_ [class_ "edit-field-instruction"] (toHtml instr) span_ [class_ "edit-field-instruction"] (toHtml instr)
a_ [href_ "/markdown", target_ "_blank"] $ a_ [href_ "/markdown", target_ "_blank"] $
img_ [src_ "/markdown.svg", alt_ "markdown supported", class_ " markdown-supported "] img_ [src_ "/markdown.svg", alt_ "markdown supported", class_ " markdown-supported "]
thisNode :: MonadIO m => HtmlT m JQuerySelector thisNode :: MonadIO m => HtmlT m JQuerySelector