Commit 21c57e3f authored by Sophie Herold's avatar Sophie Herold 🌼

hindent 5.2.4.1

parent c66d3ed4
Pipeline #804 passed with stage
in 4 minutes and 18 seconds
......@@ -30,7 +30,7 @@ install:
dev-format-code: $(HS)
$(HS):
-@./.cabal-sandbox/bin/hindent $@
-@../hindent/.cabal-sandbox/bin/hindent $@
# ununsual options
......
......@@ -25,16 +25,12 @@ import Database.YamSql
type SqlT = ReaderT Connection IO
psqlQry
:: (ToRow q, FromRow r)
=> Query -> q -> SqlT [r]
psqlQry :: (ToRow q, FromRow r) => Query -> q -> SqlT [r]
psqlQry template qs = do
conn <- ask
lift $ query conn template qs
psqlQry_
:: (FromRow r)
=> Query -> SqlT [r]
psqlQry_ :: (FromRow r) => Query -> SqlT [r]
psqlQry_ que = do
conn <- ask
lift $ query_ conn que
......
......@@ -14,9 +14,7 @@ import Database.HamSql.Internal.Utils
import Database.HamSql.Setup
import Database.YamSql
preset
:: Eq a
=> a -> a -> Maybe a
preset :: Eq a => a -> a -> Maybe a
preset d x
| d == x = Nothing
| otherwise = Just x
......@@ -155,8 +153,8 @@ deployedPrimaryKey tbl = do
-- TODO: do not ignore name
toPrimaryKey (_, keys) = fromPGArray keys
deployedUniqueConstraints :: (SqlName, SqlName)
-> SqlT [Abbr [SqlName] UniqueConstraint]
deployedUniqueConstraints ::
(SqlName, SqlName) -> SqlT [Abbr [SqlName] UniqueConstraint]
deployedUniqueConstraints tbl@(_, table) = do
res <- psqlQry keyQuery (toSqlCode tbl, True, False)
return $ map toUniqueConstraint res
......@@ -233,8 +231,8 @@ sqlManageSchemaJoin schemaid =
" NOT n.nspname LIKE 'pg_%' AND " <\>
" n.nspname NOT IN ('information_schema') "
deployedTableConstrIds :: Connection
-> IO [SqlObj SQL_TABLE_CONSTRAINT (SqlName, SqlName, SqlName)]
deployedTableConstrIds ::
Connection -> IO [SqlObj SQL_TABLE_CONSTRAINT (SqlName, SqlName, SqlName)]
deployedTableConstrIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, table, constraint) =
......@@ -246,8 +244,8 @@ deployedTableConstrIds conn = map toSqlCodeId <$> query_ conn qry
" ON c.conrelid = t.oid" <->
sqlManageSchemaJoin "c.connamespace"
deployedDomainConstrIds :: Connection
-> IO [SqlObj SQL_DOMAIN_CONSTRAINT (SqlName, SqlName)]
deployedDomainConstrIds ::
Connection -> IO [SqlObj SQL_DOMAIN_CONSTRAINT (SqlName, SqlName)]
deployedDomainConstrIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, table, constraint) =
......@@ -292,8 +290,8 @@ deployedTableIds conn = do
toSqlCodeId (s, t) = SqlObj SQL_TABLE (s <.> t)
-- | List TABLE COLUMN
deployedTableColumnIds :: Connection
-> IO [SqlObj SQL_COLUMN (SqlName, SqlName)]
deployedTableColumnIds ::
Connection -> IO [SqlObj SQL_COLUMN (SqlName, SqlName)]
deployedTableColumnIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (s, t, u) = SqlObj SQL_COLUMN (s <.> t, u)
......@@ -327,9 +325,8 @@ deployedRoleIds setup conn =
stripPrefix prefix
toSqlCodeId (Only role) = SqlObj SQL_ROLE (SqlName $ unprefixed role)
deployedRoleMemberIds :: Setup
-> Connection
-> IO [SqlObj SQL_ROLE_MEMBERSHIP (SqlName, SqlName)]
deployedRoleMemberIds ::
Setup -> Connection -> IO [SqlObj SQL_ROLE_MEMBERSHIP (SqlName, SqlName)]
deployedRoleMemberIds setup conn =
map toSqlCodeId <$> query conn qry (prefix <> "%", prefix <> "%")
where
......@@ -358,8 +355,8 @@ deployedDomainIds conn = map toSqlCodeId <$> query_ conn qry
"SELECT domain_schema, domain_name" <\> " FROM information_schema.domains" <\>
" WHERE domain_schema NOT IN ('information_schema', 'pg_catalog')"
deployedFunctionIds :: Connection
-> IO [SqlObj SQL_FUNCTION (SqlName, [SqlType])]
deployedFunctionIds ::
Connection -> IO [SqlObj SQL_FUNCTION (SqlName, [SqlType])]
deployedFunctionIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, function, args) =
......
......@@ -15,7 +15,10 @@ import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Yaml
import System.Directory
(doesDirectoryExist, doesFileExist, getDirectoryContents)
( doesDirectoryExist
, doesFileExist
, getDirectoryContents
)
import System.FilePath.Posix (combine, dropFileName, takeFileName)
import System.IO (stdin)
......@@ -75,9 +78,7 @@ findSchemaPath schema search = findDir search
then return dir
else findDir ds
catchErrors
:: ToJSON a
=> FilePath -> a -> IO a
catchErrors :: ToJSON a => FilePath -> a -> IO a
catchErrors filePath x = do
y <- try (forceToJson x)
return $
......@@ -137,25 +138,20 @@ readSchema md = do
schemaConfig = combine md "schema.yml"
confDirFiles confDir = selectFilesInDir isConfigDirFile (combine md confDir)
readObjectFromFile
:: (FromJSON a, ToJSON a)
=> FilePath -> IO a
readObjectFromFile :: (FromJSON a, ToJSON a) => FilePath -> IO a
readObjectFromFile file = do
b <- readYamSqlFile file
readObject file b
readObject
:: (FromJSON a, ToJSON a)
=> FilePath -> B.ByteString -> IO a
readObject :: (FromJSON a, ToJSON a) => FilePath -> B.ByteString -> IO a
readObject file b =
catchErrors file $
case decodeEither' b of
Left errMsg -> err $ "in yaml-file: " <> tshow file <> ": " <> tshow errMsg
Right obj -> obj
readFunctionFromFile
:: (FromJSON a, ToJSON a)
=> (a -> Text -> a) -> FilePath -> IO a
readFunctionFromFile ::
(FromJSON a, ToJSON a) => (a -> Text -> a) -> FilePath -> IO a
readFunctionFromFile rpl file = do
b <- readYamSqlFile file
case parseFrontmatter b of
......
......@@ -14,9 +14,7 @@ import Options.Applicative.Types
boolFlag :: Mod FlagFields Bool -> Parser Bool
boolFlag = flag False True
val
:: (HasMetavar f, HasValue f)
=> String -> Mod f String
val :: (HasMetavar f, HasValue f) => String -> Mod f String
val xs = value xs <> metavar ("\"" ++ xs ++ "\"")
-- Global
......
......@@ -122,8 +122,8 @@ pgsqlUpdateFragile setup conn stmts =
dropResidual SqlCreateFunction deployedFunctionIds stmtsDropFunction >>=
revokeAllPrivileges conn setup (deployedRoleIds setup conn)
where
correctStmts
:: ToSqlId a
correctStmts ::
ToSqlId a
=> SqlStmtType
-> (Connection -> IO [a])
-> (a -> [Maybe SqlStmt])
......@@ -131,8 +131,8 @@ pgsqlUpdateFragile setup conn stmts =
-> IO [SqlStmt]
correctStmts createType existingInquire dropStmtGenerator =
correctStatements createType (existingInquire conn) dropStmtGenerator
dropResidual
:: ToSqlId a
dropResidual ::
ToSqlId a
=> SqlStmtType
-> (Connection -> IO [a])
-> (a -> [Maybe SqlStmt])
......@@ -140,11 +140,12 @@ pgsqlUpdateFragile setup conn stmts =
-> IO [SqlStmt]
dropResidual t isf f xs = addDropResidual t (isf conn) f xs
revokeAllPrivileges :: Connection
-> Setup
-> IO [SqlObj SQL_ROLE SqlName]
-> [SqlStmt]
-> IO [SqlStmt]
revokeAllPrivileges ::
Connection
-> Setup
-> IO [SqlObj SQL_ROLE SqlName]
-> [SqlStmt]
-> IO [SqlStmt]
revokeAllPrivileges conn setup roles stmts = do
schemas <- map (\(SqlObj SQL_SCHEMA x) -> x) <$> deployedSchemaIds conn
((++ stmts) <$> catMaybes) . concatMap (stmtsDropAllPrivileges setup schemas) <$>
......@@ -171,8 +172,8 @@ pgsqlExecAndRollback opt url stmts = do
conn <- pgsqlExecIntern opt PgSqlWithTransaction url stmts
rollback conn
pgsqlExecStmtList
:: OptCommonDb
pgsqlExecStmtList ::
OptCommonDb
-> Status
-> [SqlStmt] -- ^ Statements that still need to be executed
-> [SqlStmt] -- ^ Statements that have failed during execution
......@@ -230,8 +231,8 @@ pgsqlExecIntern opt mode connUrl xs = do
when (mode == PgSqlWithoutTransaction) $ mapM_ (pgsqlExecStmtHandled conn) xs
return conn
addSqlStmtType
:: ToSqlId a
addSqlStmtType ::
ToSqlId a
=> SqlStmtType -- ^ statment
-> [a] -- ^ SQL ids that should become a "SqlStmtId" type to use
-> [SqlStmtId]
......@@ -240,16 +241,16 @@ addSqlStmtType t = map (SqlStmtId t . sqlId)
filterSqlStmtType :: SqlStmtType -> [SqlStmt] -> [SqlStmt]
filterSqlStmtType t xs = [x | x <- xs, stmtIdType x == t]
filterStmtsMatchingIds
:: [SqlStmtId] -- ^ Statement ids to remove
filterStmtsMatchingIds ::
[SqlStmtId] -- ^ Statement ids to remove
-> [SqlStmt]
-> [SqlStmt]
filterStmtsMatchingIds ids = filter (\x -> stmtId x `notMember` ids')
where
ids' = fromList ids
filterSqlIdBySqlStmts
:: ToSqlId a
filterSqlIdBySqlStmts ::
ToSqlId a
=> SqlStmtType -- ^ stmts to be considered by stmt type
-> [SqlStmt] -- ^ stmts that have the forbidden ids
-> [a] -- elements that get filtered
......@@ -259,8 +260,8 @@ filterSqlIdBySqlStmts t xs = filter (\x -> sqlId x `notMember` ids)
ids = fromList . map sqlId $ filterSqlStmtType t xs
-- target set of sql ids
correctStatements
:: ToSqlId a
correctStatements ::
ToSqlId a
=> SqlStmtType -- ^ install statements and the stmt type of interest
-> IO [a] -- ^ deployed (existing) elements
-> (a -> [Maybe SqlStmt]) -- ^ drop statment generator
......@@ -271,8 +272,8 @@ correctStatements t iois f xs = do
xs' <- addDropResidual t iois f xs
return $ filterStmtsMatchingIds (addSqlStmtType t is) xs'
addDropResidual
:: ToSqlId a
addDropResidual ::
ToSqlId a
=> SqlStmtType
-> IO [a]
-> (a -> [Maybe SqlStmt])
......
......@@ -46,14 +46,10 @@ instance Ord SqlStmt where
instance ToSqlId SqlStmt where
sqlId = stmtSqlId . stmtId
newSqlStmtId
:: (ToSqlId a)
=> SqlStmtType -> a -> SqlStmtId
newSqlStmtId :: (ToSqlId a) => SqlStmtType -> a -> SqlStmtId
newSqlStmtId x y = SqlStmtId x (sqlId y)
newSqlStmt
:: (ToSqlId a)
=> SqlStmtType -> a -> Text -> Maybe SqlStmt
newSqlStmt :: (ToSqlId a) => SqlStmtType -> a -> Text -> Maybe SqlStmt
newSqlStmt t o b = Just $ SqlStmt (newSqlStmtId t o) b
sqlPrinter :: [SqlStmt] -> Text
......
......@@ -9,9 +9,7 @@ import Database.HamSql.Internal.Utils
import Database.HamSql.Setup
import Database.YamSql
stmtCommentOn
:: (ToSqlId a)
=> a -> Text -> Maybe SqlStmt
stmtCommentOn :: (ToSqlId a) => a -> Text -> Maybe SqlStmt
stmtCommentOn obj comment =
newSqlStmt SqlComment obj $
"COMMENT ON " <> sqlIdTypeCode (sqlId obj) <> " " <> sqlIdCode obj <> " IS " <>
......
......@@ -11,8 +11,8 @@ import Database.HamSql.Internal.Stmt.Basic
stmtsDropDomain :: SqlObj SQL_DOMAIN SqlName -> [Maybe SqlStmt]
stmtsDropDomain x = [newSqlStmt SqlDropDomain x $ "DROP DOMAIN" <-> toSqlCode x]
stmtsDropDomainConstr :: SqlObj SQL_DOMAIN_CONSTRAINT (SqlName, SqlName)
-> [Maybe SqlStmt]
stmtsDropDomainConstr ::
SqlObj SQL_DOMAIN_CONSTRAINT (SqlName, SqlName) -> [Maybe SqlStmt]
stmtsDropDomainConstr obj@(SqlObj _ (d, c)) =
[ newSqlStmt SqlDropDomainConstr obj $
"ALTER DOMAIN" <-> toSqlCode d <-> "DROP CONSTRAINT" <-> toSqlCode c
......
......@@ -14,10 +14,8 @@ stmtsDropRole :: Setup -> SqlObj SQL_ROLE SqlName -> [Maybe SqlStmt]
stmtsDropRole setup role@(SqlObj _ roleSqlName) =
[newSqlStmt SqlDropRole role $ "DROP ROLE " <> prefixedRole setup roleSqlName]
stmtsDropAllPrivileges :: Setup
-> [SqlName]
-> SqlObj SQL_ROLE SqlName
-> [Maybe SqlStmt]
stmtsDropAllPrivileges ::
Setup -> [SqlName] -> SqlObj SQL_ROLE SqlName -> [Maybe SqlStmt]
stmtsDropAllPrivileges setup schemas x@(SqlObj _ n)
| null schemas = [Nothing]
| otherwise =
......@@ -29,9 +27,8 @@ stmtsDropAllPrivileges setup schemas x@(SqlObj _ n)
| objType <- ["TABLES", "SEQUENCES", "FUNCTIONS"]
]
stmtRevokeMembership :: Setup
-> SqlObj SQL_ROLE_MEMBERSHIP (SqlName, SqlName)
-> [Maybe SqlStmt]
stmtRevokeMembership ::
Setup -> SqlObj SQL_ROLE_MEMBERSHIP (SqlName, SqlName) -> [Maybe SqlStmt]
stmtRevokeMembership setup x@(SqlObj _ (role, member)) =
[ newSqlStmt SqlRevokeMembership x $
"REVOKE" <-> prefixedRole setup role <-> "FROM" <->
......
......@@ -17,8 +17,8 @@ import Database.HamSql.Internal.Stmt.Sequence ()
-- | Assuming that CASCADE will only cause other constraints to be deleted.
-- | Required since foreign keys may depend on other keys.
stmtsDropTableConstr :: SqlObj SQL_TABLE_CONSTRAINT (SqlName, SqlName, SqlName)
-> [Maybe SqlStmt]
stmtsDropTableConstr ::
SqlObj SQL_TABLE_CONSTRAINT (SqlName, SqlName, SqlName) -> [Maybe SqlStmt]
stmtsDropTableConstr x@(SqlObj _ (s, t, c)) =
[ newSqlStmt SqlDropTableConstr x $
"ALTER TABLE" <-> toSqlCode (s <.> t) <-> "DROP CONSTRAINT IF EXISTS" <->
......@@ -35,17 +35,15 @@ stmtsDropTableColumn x@(SqlObj _ (t, c)) =
"ALTER TABLE" <-> toSqlCode t <-> "DROP COLUMN" <-> toSqlCode c
]
constrId
:: Schema
constrId ::
Schema
-> Table
-> SqlName
-> SqlObj SQL_TABLE_CONSTRAINT (SqlName, SqlName, SqlName)
constrId s t c = SqlObj SQL_TABLE_CONSTRAINT (schemaName s, tableName t, c)
-- TODO: prefix with table name
stmtCheck
:: ToSqlId a
=> a -> Check -> Maybe SqlStmt
stmtCheck :: ToSqlId a => a -> Check -> Maybe SqlStmt
stmtCheck obj c =
newSqlStmt SqlCreateCheckConstr obj $
"ALTER TABLE " <> sqlIdCode obj <> " ADD CONSTRAINT " <>
......
......@@ -54,9 +54,7 @@ debug opts xs
| optDebug opts = msg "debug" xs
| otherwise = id
removeDuplicates
:: (Ord a)
=> [a] -> [a]
removeDuplicates :: (Ord a) => [a] -> [a]
removeDuplicates = map head . group . sort
--- Maybe Utils
......@@ -93,9 +91,7 @@ maybeHead :: [a] -> Maybe a
maybeHead [] = Nothing
maybeHead (x:_) = Just x
tr
:: Show a
=> a -> a
tr :: Show a => a -> a
tr x = trace (show x <> "\n") x
(<->) :: Text -> Text -> Text
......
......@@ -23,13 +23,14 @@ data SetupContext = SetupContext
}
data SetupElement where
SetupElement :: (ToSqlStmts a) => a -> SetupElement
SetupElement :: (ToSqlStmts a) => a -> SetupElement
instance ToSqlStmts SetupElement where
toSqlStmts x (SetupElement y) = toSqlStmts x y
class Typeable a =>
ToSqlStmts a where
ToSqlStmts a
where
toSqlStmts :: SetupContext -> a -> [Maybe SqlStmt]
-- | Setup
......@@ -69,9 +70,11 @@ instance WithName (WithSchema FunctionTpl) where
withoutSchema :: WithSchema a -> a
withoutSchema (WithSchema _ t) = t
selectTemplates
:: (ToSqlCode a, WithName (WithSchema t))
=> Maybe [a] -> [WithSchema t] -> [t]
selectTemplates ::
(ToSqlCode a, WithName (WithSchema t))
=> Maybe [a]
-> [WithSchema t]
-> [t]
selectTemplates ns ts
-- TODO: error handling here should be done using exceptions
=
......@@ -81,9 +84,8 @@ selectTemplates ns ts
| n <- maybeMap toSqlCode ns
]
selectTemplate
:: (ToSqlCode a1, WithName (WithSchema a))
=> a1 -> [WithSchema a] -> a
selectTemplate ::
(ToSqlCode a1, WithName (WithSchema a)) => a1 -> [WithSchema a] -> a
selectTemplate x ts =
head' $ map withoutSchema $ filter (\y -> name y == toSqlCode x) ts
where
......
......@@ -41,7 +41,6 @@ data Abbr a b
| LongForm b
deriving (Data, Generic, Show)
instance (FromJSON a, FromJSON b) =>
FromJSON (Abbr a b) where
instance (FromJSON a, FromJSON b) => FromJSON (Abbr a b) where
parseJSON x@(Object _) = LongForm <$> parseJSON x
parseJSON x = ShortForm <$> parseJSON x
......@@ -33,8 +33,7 @@ data SQL_TABLE =
instance ToSqlCode SQL_TABLE where
toSqlCode = const "TABLE"
instance (ToJSON a, ToJSON b) =>
ToJSON (Abbr a b) where
instance (ToJSON a, ToJSON b) => ToJSON (Abbr a b) where
toJSON = toYamSqlJson
data TableTpl = TableTpl
......@@ -97,7 +96,7 @@ applyTableTpl tpl t =
data IndexName
= IndexNameUnprefixed SqlName
| IndexNamePrefixed { indexnamePrefixed :: SqlName}
| IndexNamePrefixed { indexnamePrefixed :: SqlName }
deriving (Generic, Show, Data)
instance FromJSON IndexName where
......
......@@ -19,7 +19,8 @@ import Database.YamSql.Parser
-- | Idable
class Show a =>
ToSqlId a where
ToSqlId a
where
sqlId :: a -> SqlId
sqlIdCode :: a -> Text
sqlIdCode = toSqlCode . sqlId
......@@ -27,9 +28,10 @@ class Show a =>
class (Typeable a, ToSqlCode a, Eq a, Show a) =>
SqlIdContent a
-- | SqlId
data SqlId where
SqlId :: (SqlObjType a, SqlIdContent b) => SqlObj a b -> SqlId
SqlId :: (SqlObjType a, SqlIdContent b) => SqlObj a b -> SqlId
sqlIdShowType :: SqlId -> Text
sqlIdShowType (SqlId x) = tshow $ sqlObjType x
......@@ -61,15 +63,15 @@ data SqlContext a =
instance Show (SqlContext a) where
show = const ""
instance (SqlObjType a, SqlIdContent b) =>
ToSqlId (SqlObj a b) where
instance (SqlObjType a, SqlIdContent b) => ToSqlId (SqlObj a b) where
sqlId = SqlId
class (Typeable a, ToSqlCode a, Show a) =>
SqlObjType a
data SqlObj a b where
SqlObj :: (SqlObjType a, SqlIdContent b) => a -> b -> SqlObj a b
SqlObj :: (SqlObjType a, SqlIdContent b) => a -> b -> SqlObj a b
sqlObjType :: SqlObj a b -> a
sqlObjType (SqlObj x _) = x
......
......@@ -19,9 +19,7 @@ import Data.Text (Text)
import Data.Text.Lazy (toStrict)
import Text.Pretty.Simple (pShow)
tshow
:: (Show a)
=> a -> Text
tshow :: (Show a) => a -> Text
tshow = T.replace "\\\"" "“" . toStrict . pShow
isIn :: Char -> Text -> Bool
......
......@@ -17,8 +17,15 @@ module Database.YamSql.Parser
import Control.Exception
import Data.Aeson.Types
(GFromJSON, GToJSON, Options(..), SumEncoding(UntaggedValue), Zero,
defaultOptions, genericParseJSON, genericToJSON)
( GFromJSON
, GToJSON
, Options(..)
, SumEncoding(UntaggedValue)
, Zero
, defaultOptions
, genericParseJSON
, genericToJSON
)
import Data.Char
import Data.Data
......@@ -30,8 +37,11 @@ import Data.Yaml
import GHC.Generics
import System.IO
import Text.EditDistance
(Costs(ConstantCost), defaultEditCosts, levenshteinDistance,
substitutionCosts)
( Costs(ConstantCost)
, defaultEditCosts
, levenshteinDistance
, substitutionCosts
)
import Database.YamSql.Internal.Utils
......@@ -59,20 +69,14 @@ myOpt =
, sumEncoding = UntaggedValue
}
outJson
:: ToJSON a
=> a -> String
outJson :: ToJSON a => a -> String
outJson s = show $ toJSON s
forceToJson
:: ToJSON a
=> a -> IO ()
forceToJson :: ToJSON a => a -> IO ()
forceToJson s =
withFile "/dev/null" WriteMode (\handl -> hPrint handl (toJSON s))
parseYamSql
:: (Generic r, GFromJSON Zero (Rep r), Data r)
=> Value -> Parser r
parseYamSql :: (Generic r, GFromJSON Zero (Rep r), Data r) => Value -> Parser r
parseYamSql v = do
let used = keysOfValue v
parsed <- genericParseJSON myOpt v
......@@ -107,9 +111,7 @@ closestString x ys = minimumBy (\y y' -> compare (dist y) (dist y')) ys
defaultEditCosts {substitutionCosts = ConstantCost 2}
x
toYamSqlJson
:: (Generic a, GToJSON Zero (Rep a))
=> a -> Value
toYamSqlJson :: (Generic a, GToJSON Zero (Rep a)) => a -> Value
toYamSqlJson = genericToJSON myOpt
data YamsqlException =
......
......@@ -111,9 +111,7 @@ newSetup s =
, setupSchemaData = Just s
}
exec
:: (Eq e, Exception e)
=> e -> [String] -> IO Bool
exec :: (Eq e, Exception e) => e -> [String] -> IO Bool
exec y xs =
handle (\x -> return $ x == y) (parseThisArgv xs >>= run >> return True)
......@@ -122,15 +120,11 @@ exec' xs = do
r <- exec ExitSuccess xs
r @? "Exec should not fail"
assertNoShowDiff
:: (Show a0, Show a1)
=> a0 -> a1 -> Assertion
assertNoShowDiff :: (Show a0, Show a1) => a0 -> a1 -> Assertion
assertNoShowDiff x y =
assertNoDiff (T.lines $ pShowNoColor x) (T.lines $ pShowNoColor y)
assertNoDiff
:: (Show a, Eq a)
=> [a] -> [a] -> Assertion
assertNoDiff :: (Show a, Eq a) => [a] -> [a] -> Assertion
assertNoDiff xs ys =
case firstDiff xs ys of
Nothing -> return ()
......@@ -150,9 +144,7 @@ assertNoDiff xs ys =
in catMaybes [get zs j | j <- [i - d .. i + d]]
showContext zs i = T.intercalate "\n" $ map pShowNoColor $ getContext zs i
firstDiff
:: Eq a
=> [a] -> [a] -> Maybe Int
firstDiff :: Eq a => [a] -> [a] -> Maybe Int
firstDiff xs ys = findDiff 0
where
findDiff i
......
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