Commit 14d43539 authored by Sophie Herold's avatar Sophie Herold 🌼

Hlint cleanup

parent 21c57e3f
Pipeline #805 passed with stage
in 3 minutes and 58 seconds
# HLint configuration file
# https://github.com/ndmitchell/hlint
##########################
# This file contains a template configuration file, which is typically
# placed as .hlint.yaml in the root of your project
# Specify additional command line arguments
#
# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
- arguments: [-XQuasiQuotes]
# Control which extensions/flags/modules/functions can be used
#
# - extensions:
# - default: false # all extension are banned by default
# - name: PatternGuards, ViewPatterns # only these listed extensions can be used
# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
#
# - flags:
# - {name: -w, within: []} # -w is allowed nowhere
#
# - modules:
# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
#
# - functions:
# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
# Add custom hints for this project
#
# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
# - error: {lhs: wibbleMany [x], rhs: wibbleOne x}
# Turn on hints that are off by default
#
# Ban "module X(module X) where", to require a real export list
# - warn: {name: Use explicit module export list}
#
# Replace a $ b $ c with a . b $ c
# - group: {name: dollar, enabled: true}
#
# Generalise map to fmap, ++ to <>
# - group: {name: generalise, enabled: true}
# Ignore some builtin hints
# - ignore: {name: Use let}
# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
- ignore: {name: Use module export list}
- ignore: {name: Use newtype instead of data}
# Define some custom infix operators
# - fixity: infixr 3 ~^#^~
# stylish-haskell configuration file
# ==================================
# The stylish-haskell tool is mainly configured by specifying steps. These steps
# are a list, so they have an order, and one specific step may appear more than
# once (if needed). Each file is processed by these steps in the given order.
steps:
# Convert some ASCII sequences to their Unicode equivalents. This is disabled
# by default.
# - unicode_syntax:
# # In order to make this work, we also need to insert the UnicodeSyntax
# # language pragma. If this flag is set to true, we insert it when it's
# # not already present. You may want to disable it if you configure
# # language extensions using some other method than pragmas. Default:
# # true.
# add_language_pragma: true
# Import cleanup
- imports:
# There are different ways we can align names and lists.
#
# - global: Align the import names and import list throughout the entire
# file.
#
# - file: Like global, but don't add padding when there are no qualified
# imports in the file.
#
# - group: Only align the imports per group (a group is formed by adjacent
# import lines).
#
# - none: Do not perform any alignment.
#
# Default: global.
align: none
# Folowing options affect only import list alignment.
#
# List align has following options:
#
# - after_alias: Import list is aligned with end of import including
# 'as' and 'hiding' keywords.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - with_alias: Import list is aligned with start of alias or hiding.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - new_line: Import list starts always on new line.
#
# > import qualified Data.List as List
# > (concat, foldl, foldr, head, init, last, length)
#
# Default: after alias
list_align: after_alias
# Long list align style takes effect when import is too long. This is
# determined by 'columns' setting.
#
# - inline: This option will put as much specs on same line as possible.
#
# - new_line: Import list will start on new line.
#
# - new_line_multiline: Import list will start on new line when it's
# short enough to fit to single line. Otherwise it'll be multiline.
#
# - multiline: One line per import list entry.
# Type with contructor list acts like single import.
#
# > import qualified Data.Map as M
# > ( empty
# > , singleton
# > , ...
# > , delete
# > )
#
# Default: inline
long_list_align: inline
# List padding determines indentation of import list on lines after import.
# This option affects 'list_align' and 'long_list_align'.
list_padding: 4
# Separate lists option affects formating of import list for type
# or class. The only difference is single space between type and list
# of constructors, selectors and class functions.
#
# - true: There is single space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable (fold, foldl, foldMap))
#
# - false: There is no space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable(fold, foldl, foldMap))
#
# Default: true
separate_lists: true
# Language pragmas
- language_pragmas:
# We can generate different styles of language pragma lists.
#
# - vertical: Vertical-spaced language pragmas, one per line.
#
# - compact: A more compact style.
#
# - compact_line: Similar to compact, but wrap each line with
# `{-#LANGUAGE #-}'.
#
# Default: vertical.
style: vertical
# Align affects alignment of closing pragma brackets.
#
# - true: Brackets are aligned in same collumn.
#
# - false: Brackets are not aligned together. There is only one space
# between actual import and closing bracket.
#
# Default: true
align: true
# stylish-haskell can detect redundancy of some language pragmas. If this
# is set to true, it will remove those redundant pragmas. Default: true.
remove_redundant: true
# Align the types in record declarations
- records: {}
# Replace tabs by spaces. This is disabled by default.
# - tabs:
# # Number of spaces to use for each tab. Default: 8, as specified by the
# # Haskell report.
# spaces: 8
# Remove trailing whitespace
- trailing_whitespace: {}
# A common setting is the number of columns (parts of) code will be wrapped
# to. Different steps take this into account. Default: 80.
columns: 90
# Sometimes, language extensions are specified in a cabal file or from the
# command line instead of using language pragmas in the file. stylish-haskell
# needs to be aware of these, so it can parse the file correctly.
#
# No language extensions are enabled by default.
# language_extensions:
# - TemplateHaskell
# - QuasiQuotes
module Database.HamSql
( module Database.HamSql.Internal.Documentation
, module Database.HamSql.Internal.PostgresCon
, module Database.HamSql.Internal.Load
, module Database.HamSql.Internal.Option
, module Database.HamSql.Internal.DbUtils
, module Database.HamSql.Internal.Stmt
, module Database.HamSql.Internal.Utils
, module Database.HamSql.Internal.Stmt.Create
( module X
) where
import Database.HamSql.Internal.DbUtils
import Database.HamSql.Internal.Documentation
import Database.HamSql.Internal.Load
import Database.HamSql.Internal.Option
import Database.HamSql.Internal.PostgresCon
import Database.HamSql.Internal.Stmt
import Database.HamSql.Internal.Stmt.Create
import Database.HamSql.Internal.Utils
import Database.HamSql.Internal.DbUtils as X
import Database.HamSql.Internal.Documentation as X
import Database.HamSql.Internal.Load as X
import Database.HamSql.Internal.Option as X
import Database.HamSql.Internal.PostgresCon as X
import Database.HamSql.Internal.Stmt as X
import Database.HamSql.Internal.Stmt.Create as X
import Database.HamSql.Internal.Utils as X
......@@ -53,7 +53,7 @@ getConUrl = getConUrlApp "hamsql" . optConnection
getConUrlApp :: String -> String -> URI
getConUrlApp app str = appendQuery ("application_name=" <> app) uri
where
uri = fromJustReason "Not a valid URI" (parseAbsoluteURI $ str)
uri = fromJustReason "Not a valid URI" (parseAbsoluteURI str)
appendQuery v u =
u
{ uriQuery =
......
......@@ -33,7 +33,7 @@ templateCompile str =
docWrite :: OptDoc -> Setup -> IO ()
docWrite optDoc s = do
t <- templateFromFile (optTemplate optDoc)
_ <- mapM (docWriteSchema optDoc t) (fromMaybe [] $ setupSchemaData s)
mapM_ (docWriteSchema optDoc t) (fromMaybe [] $ setupSchemaData s)
return ()
docWriteSchema :: OptDoc -> Template -> Schema -> IO ()
......
......@@ -26,7 +26,7 @@ presetEmpty xs = Just xs
recoverIndexName :: Text -> [Text] -> Text -> Text -> Maybe IndexName
recoverIndexName tbl keys n s =
case stripPrefix (tbl <> "_") n >>= stripSuffix ("_" <> s) of
Nothing -> Just $ IndexNamePrefixed {indexnamePrefixed = SqlName n}
Nothing -> Just IndexNamePrefixed {indexnamePrefixed = SqlName n}
Just unprefixed
| unprefixed == intercalate "_" keys -> Nothing
| otherwise -> Just $ IndexNameUnprefixed (SqlName unprefixed)
......@@ -34,11 +34,11 @@ recoverIndexName tbl keys n s =
deployedSchemas :: SqlT [Schema]
deployedSchemas = do
schemas <- psqlQry_ qry
sequence $ map toSchema schemas
mapM toSchema schemas
where
toSchema (schema, description) = do
tables <- deployedTables schema
return $
return
Schema
{ schemaName = schema
, schemaDescription = description
......@@ -76,14 +76,14 @@ deployedSchemas = do
deployedTables :: SqlName -> SqlT [Table]
deployedTables schema = do
tbls <- psqlQry qry (Only $ toSqlCode schema)
sequence $ map toTable tbls
mapM toTable tbls
where
toTable (table, description) = do
columns <- deployedColumns (schema, table)
pk <- deployedPrimaryKey (schema, table)
fks <- deployedForeignKeys (schema, table)
uniques <- deployedUniqueConstraints (schema, table)
return $
return
Table
{ tableName = table
, tableDescription = description
......@@ -165,11 +165,11 @@ deployedUniqueConstraints tbl@(_, table) = do
in case idx of
Nothing -> ShortForm $ map SqlName keys
index ->
LongForm $
UniqueConstraint
{ uniqueconstraintName = index
, uniqueconstraintColumns = map SqlName keys
}
LongForm
UniqueConstraint
{ uniqueconstraintName = index
, uniqueconstraintColumns = map SqlName keys
}
deployedForeignKeys :: (SqlName, SqlName) -> SqlT [ForeignKey]
deployedForeignKeys tbl@(_, table) = do
......@@ -185,7 +185,7 @@ deployedForeignKeys tbl@(_, table) = do
, foreignkeyColumns = map SqlName cols
, foreignkeyRefTable = SqlName fTbl
, foreignkeyRefColumns =
if (map SqlName cols) == fCols
if map SqlName cols == fCols
then Nothing
else Just fCols
, foreignkeyOnDelete = Nothing
......
......@@ -118,10 +118,10 @@ readSchema md = do
doesDirectoryExist md >>=
errorCheck ("module dir does not exist: " <> tshow md)
schemaData <- readObjectFromFile schemaConfig
domains <- confDirFiles "domains.d" >>= mapM (readObjectFromFile)
types <- confDirFiles "types.d" >>= mapM (readObjectFromFile)
sequences <- confDirFiles "sequences.d" >>= mapM (readObjectFromFile)
tables <- confDirFiles "tables.d" >>= mapM (readObjectFromFile)
domains <- confDirFiles "domains.d" >>= mapM readObjectFromFile
types <- confDirFiles "types.d" >>= mapM readObjectFromFile
sequences <- confDirFiles "sequences.d" >>= mapM readObjectFromFile
tables <- confDirFiles "tables.d" >>= mapM readObjectFromFile
functions <-
let ins x s = x {functionBody = Just s}
in confDirFiles "functions.d" >>= mapM (readFunctionFromFile ins)
......@@ -161,8 +161,7 @@ readFunctionFromFile rpl file = do
_ -> readObject file b
readYamSqlFile :: FilePath -> IO B.ByteString
readYamSqlFile "-" = do
B.hGetContents stdin
readYamSqlFile "-" = B.hGetContents stdin
readYamSqlFile file = do
fileExists <- doesFileExist file
unless fileExists $ err $ "Expected file existance: '" <> tshow file <> "'"
......
......@@ -126,11 +126,11 @@ pgsqlUpdateFragile setup conn stmts =
ToSqlId a
=> SqlStmtType
-> (Connection -> IO [a])
-> (a -> [Maybe SqlStmt])
-> (a -> [Maybe SqlStmt]) -- ^ drop statement generator
-> [SqlStmt]
-> IO [SqlStmt]
correctStmts createType existingInquire dropStmtGenerator =
correctStatements createType (existingInquire conn) dropStmtGenerator
correctStmts createType existingInquire =
correctStatements createType (existingInquire conn)
dropResidual ::
ToSqlId a
=> SqlStmtType
......@@ -138,7 +138,7 @@ pgsqlUpdateFragile setup conn stmts =
-> (a -> [Maybe SqlStmt])
-> [SqlStmt]
-> IO [SqlStmt]
dropResidual t isf f xs = addDropResidual t (isf conn) f xs
dropResidual t isf = addDropResidual t (isf conn)
revokeAllPrivileges ::
Connection
......
......@@ -58,4 +58,4 @@ instance ToSqlStmts (SqlContext Role) where
sqlLogin _ = "NOLOGIN"
sqlPassword Nothing = "PASSWORD NULL"
sqlPassword (Just p) = "ENCRYPTED PASSWORD '" <> p <> "' "
prefix role = prefixedRole setup role
prefix = prefixedRole setup
......@@ -163,7 +163,7 @@ indexName t keys s Nothing = mconcat ([t] ++ keys ++ [s])
indexName t _ s (Just k) =
case k of
(IndexNameUnprefixed n) -> t <> n <> s
(IndexNamePrefixed {indexnamePrefixed = n}) -> n
IndexNamePrefixed {indexnamePrefixed = n} -> n
instance ToSqlStmts (SqlContext (Schema, Table)) where
toSqlStmts SetupContext {setupContextSetup = setup} obj@(SqlContext (s, t)) =
......
......@@ -3,11 +3,9 @@
-- Copyright 2016 by it's authors.
-- Some rights reserved. See COPYING, AUTHORS.
module Database.YamSql
( module Database.YamSql.Internal.Obj.Schema
, module Database.YamSql.Internal.SqlId
, module Database.YamSql.Internal.Commons
( module X
) where
import Database.YamSql.Internal.Commons
import Database.YamSql.Internal.Obj.Schema
import Database.YamSql.Internal.SqlId
import Database.YamSql.Internal.Commons as X
import Database.YamSql.Internal.Obj.Schema as X
import Database.YamSql.Internal.SqlId as X
......@@ -82,7 +82,7 @@ sqlObjId (SqlObj _ y) = y
deriving instance Show (SqlObj a b)
instance Eq (SqlObj a b) where
SqlObj x1 y1 == SqlObj x2 y2 = (typeOf x1) == (typeOf x2) && y1 == y2
SqlObj x1 y1 == SqlObj x2 y2 = typeOf x1 == typeOf x2 && y1 == y2
instance ToSqlCode (SqlObj a b) where
toSqlCode (SqlObj _ x) = toSqlCode x
......
......@@ -80,7 +80,7 @@ parseYamSql :: (Generic r, GFromJSON Zero (Rep r), Data r) => Value -> Parser r
parseYamSql v = do
let used = keysOfValue v
parsed <- genericParseJSON myOpt v
let known = keysOfData $ parsed
let known = keysOfData parsed
let diff = used \\ known
return $
if null diff
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment