From c69c90f3d12d088eb60cf6da66c7cc473d399abf Mon Sep 17 00:00:00 2001 From: stuebinm Date: Tue, 15 Feb 2022 22:28:24 +0100 Subject: server: switch to universum prelude, some cleanup it's slightly less of a mess than it was before --- .hlint.yaml | 1042 +++++++++++++++++++++++++++++++++++++++++++++++++ config.toml | 1 + package.yaml | 7 +- server/Handlers.hs | 81 ++-- server/HtmlOrphans.hs | 46 +-- server/Main.hs | 100 +++-- server/Server.hs | 40 +- stack.yaml | 2 +- stack.yaml.lock | 8 +- walint.cabal | 5 +- 10 files changed, 1186 insertions(+), 146 deletions(-) create mode 100644 .hlint.yaml diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..0415941 --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,1042 @@ +# This is a custom hlint config with rules that suggest +# using Universum functions whenever it has a suitable +# alternative. You may either copy-paste this config into +# your .hlint.yaml or run hlint twice: once with your +# default config, and the second time with this one. +# This config is *not* intended for Universum developers. + +############################################################################ +## Universum +############################################################################ + +# There's no 'head' in Universum +- ignore: {name: "Use head"} + +# We have 'whenJust' for this +- ignore: {name: "Use Foldable.forM_"} + +- warn: {lhs: Data.Text.pack, rhs: Universum.toText} +- warn: {lhs: Data.Text.unpack, rhs: Universum.toString} + +- warn: {lhs: Data.Text.Lazy.pack, rhs: Universum.toLText} +- warn: {lhs: Data.Text.Lazy.unpack, rhs: Universum.toString} +- warn: {lhs: Data.Text.Lazy.toStrict, rhs: Universum.toText} +- warn: {lhs: Data.Text.Lazy.fromStrict, rhs: Universum.toLText} + +- warn: {lhs: Data.Text.pack (show x), rhs: Universum.show x} +- warn: {lhs: Data.Text.Lazy.pack (show x), rhs: Universum.show x} + +- warn: {lhs: Control.Exception.evaluate, rhs: evaluateWHNF} +- warn: {lhs: Control.Exception.evaluate (force x), rhs: evaluateNF x} +- warn: {lhs: Control.Exception.evaluate (x `deepseq` ()), rhs: evaluateNF_ x} +- warn: {lhs: void (evaluateWHNF x), rhs: evaluateWHNF_ x} +- warn: {lhs: void (evaluateNF x), rhs: evaluateNF_ x} + +## Containers +- hint: {lhs: Data.HashMap.Lazy.keys, rhs: Universum.keys} +- hint: {lhs: Data.HashMap.Strict.keys, rhs: Universum.keys} +- hint: {lhs: Data.Map.Lazy.keys, rhs: Universum.keys} +- hint: {lhs: Data.Map.Strict.keys, rhs: Universum.keys} +- hint: {lhs: Data.IntMap.Lazy.keys, rhs: Universum.keys} +- hint: {lhs: Data.IntMap.Strict.keys, rhs: Universum.keys} + +- hint: {lhs: Data.HashMap.Lazy.elems, rhs: Universum.elems} +- hint: {lhs: Data.HashMap.Strict.elems, rhs: Universum.elems} +- hint: {lhs: Data.Map.Lazy.elems, rhs: Universum.elems} +- hint: {lhs: Data.Map.Strict.elems, rhs: Universum.elems} +- hint: {lhs: Data.IntMap.Lazy.elems, rhs: Universum.elems} +- hint: {lhs: Data.IntMap.Strict.elems, rhs: Universum.elems} + +- hint: {lhs: Data.HashMap.Lazy.toList, rhs: Universum.toPairs} +- hint: {lhs: Data.HashMap.Strict.toList, rhs: Universum.toPairs} +- hint: {lhs: Data.Map.Lazy.toList, rhs: Universum.toPairs} +- hint: {lhs: Data.Map.Lazy.assocs, rhs: Universum.toPairs} +- hint: {lhs: Data.Map.Strict.toList, rhs: Universum.toPairs} +- hint: {lhs: Data.Map.Strict.assocs, rhs: Universum.toPairs} +- hint: {lhs: Data.IntMap.Lazy.toList, rhs: Universum.toPairs} +- hint: {lhs: Data.IntMap.Lazy.assocs, rhs: Universum.toPairs} +- hint: {lhs: Data.IntMap.Strict.toList, rhs: Universum.toPairs} +- hint: {lhs: Data.IntMap.Strict.assocs, rhs: Universum.toPairs} + +- warn: { lhs: Data.Map.toAscList (Data.Map.fromList x) + , rhs: Universum.sortWith fst x + } +- warn: { lhs: Data.Map.toDescList (Data.Map.fromList x) + , rhs: Universum.sortWith (Down . fst) x + } + +- warn: {lhs: Data.Set.toList (Data.Set.fromList l), rhs: Universum.sortNub l} +- warn: {lhs: Data.Set.assocs (Data.Set.fromList l), rhs: Universum.sortNub l} +- warn: {lhs: Data.Set.toAscList (Data.Set.fromList l), rhs: Universum.sortNub l} + +- warn: {lhs: Data.HashSet.toList (Data.HashSet.fromList l), rhs: Universum.unstableNub} + +- hint: { lhs: nub, rhs: Universum.ordNub + , note: "'nub' is O(n^2), 'ordNub' is O(n log n)" } + +- warn: { lhs: sortBy (comparing f), rhs: Universum.sortWith f + , note: "If the function you are using for 'comparing' is slow, use 'sortOn' instead of 'sortWith', because 'sortOn' caches applications the function and 'sortWith' doesn't." } + +- warn: { lhs: sortOn fst, rhs: Universum.sortWith fst + , note: "'sortWith' will be faster here because it doesn't do caching" } +- warn: { lhs: sortOn snd, rhs: Universum.sortWith snd + , note: "'sortWith' will be faster here because it doesn't do caching" } +- warn: { lhs: sortOn (Down . fst), rhs: Universum.sortWith (Down . fst) + , note: "'sortWith' will be faster here because it doesn't do caching" } +- warn: { lhs: sortOn (Down . snd), rhs: Universum.sortWith (Down . snd) + , note: "'sortWith' will be faster here because it doesn't do caching" } + +- warn: {lhs: map fst &&& map snd, rhs: unzip} + +- warn: {lhs: f >>= guard, rhs: guardM} +- warn: {lhs: guard =<< f, rhs: guardM} + +- warn: {lhs: fmap concat (mapM f s), rhs: Universum.concatMapM f s} +- warn: {lhs: concat <$> mapM f s, rhs: Universum.concatMapM f s} + +- warn: {lhs: fmap concat (forM f s), rhs: Universum.concatForM s f} +- warn: {lhs: fmap concat (for f s), rhs: Universum.concatForM s f} +- warn: {lhs: concat <$> forM f s, rhs: Universum.concatForM s f} +- warn: {lhs: concat <$> for f s, rhs: Universum.concatForM s f} + +- hint: { lhs: fmap and (sequence s), rhs: Universum.andM s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } +- hint: { lhs: and <$> sequence s, rhs: Universum.andM s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } + +- hint: { lhs: fmap or (sequence s), rhs: Universum.orM s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } +- hint: { lhs: or <$> sequence s, rhs: Universum.orM s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } + +- hint: { lhs: fmap and (mapM f s), rhs: Universum.allM f s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } +- hint: { lhs: and <$> mapM f s, rhs: Universum.allM f s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } +- hint: { lhs: fmap or (mapM f s), rhs: Universum.anyM f s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } +- hint: { lhs: or <$> mapM f s, rhs: Universum.anyM f s + , note: "Applying this hint would mean that some actions\n that were being executed previously would no longer be executed." } + +- warn: {lhs: whenM (not <$> x), rhs: unlessM x} +- warn: {lhs: unlessM (not <$> x), rhs: whenM x} + +- warn: {lhs: either (const True) (const False), rhs: isLeft} +- warn: {lhs: either (const False) (const True), rhs: isRight} + +- warn: {lhs: either id (const a), rhs: fromLeft a} +- warn: {lhs: either (const b) id, rhs: fromRight b} + +- warn: {lhs: either Just (const Nothing), rhs: leftToMaybe} +- warn: {lhs: either (const Nothing) Just, rhs: rightToMaybe} +- warn: {lhs: maybe (Left l) Right, rhs: maybeToRight} +- warn: {lhs: maybe (Right r) Left, rhs: maybeToLeft} + +- warn: {lhs: fromMaybe mempty, rhs: maybeToMonoid} +- warn: {lhs: "m ?: mempty", rhs: maybeToMonoid m} + + +- hint: {lhs: pure (), rhs: pass} +- hint: {lhs: return (), rhs: pass} + +# Probably will be reduced when function equality is done: +# https://github.com/ndmitchell/hlint/issues/434 +- warn: {lhs: (case m of Just x -> f x; Nothing -> pure () ), rhs: Universum.whenJust m f} +- warn: {lhs: (case m of Just x -> f x; Nothing -> return ()), rhs: Universum.whenJust m f} +- warn: {lhs: (case m of Just x -> f x; Nothing -> pass ), rhs: Universum.whenJust m f} +- warn: {lhs: (case m of Nothing -> pure () ; Just x -> f x), rhs: Universum.whenJust m f} +- warn: {lhs: (case m of Nothing -> return (); Just x -> f x), rhs: Universum.whenJust m f} +- warn: {lhs: (case m of Nothing -> pass ; Just x -> f x), rhs: Universum.whenJust m f} +- warn: {lhs: (maybe (pure ()) f m), rhs: Universum.whenJust m f} +- warn: {lhs: (maybe (return ()) f m), rhs: Universum.whenJust m f} +- warn: {lhs: (maybe pass f m), rhs: Universum.whenJust m f} + +- warn: {lhs: (m >>= \case Just x -> f x; Nothing -> pure () ), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= \case Just x -> f x; Nothing -> return ()), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= \case Just x -> f x; Nothing -> pass ), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= \case Nothing -> pure () ; Just x -> f x), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= \case Nothing -> return (); Just x -> f x), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= \case Nothing -> pass ; Just x -> f x), rhs: Universum.whenJustM m f} +- warn: {lhs: (maybe (pure ()) f =<< m), rhs: Universum.whenJustM m f} +- warn: {lhs: (maybe (return ()) f =<< m), rhs: Universum.whenJustM m f} +- warn: {lhs: (maybe pass f =<< m), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= maybe (pure ()) f), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= maybe (return ()) f), rhs: Universum.whenJustM m f} +- warn: {lhs: (m >>= maybe pass f), rhs: Universum.whenJustM m f} + +- warn: {lhs: (case m of Just _ -> pure () ; Nothing -> x), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (case m of Just _ -> return (); Nothing -> x), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (case m of Just _ -> pass ; Nothing -> x), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (case m of Nothing -> x; Just _ -> pure () ), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (case m of Nothing -> x; Just _ -> return ()), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (case m of Nothing -> x; Just _ -> pass ), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (maybe x (\_ -> pure () ) m), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (maybe x (\_ -> return () ) m), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (maybe x (\_ -> pass ) m), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (maybe x (const (pure () )) m), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (maybe x (const (return ())) m), rhs: Universum.whenNothing_ m x} +- warn: {lhs: (maybe x (const (pass )) m), rhs: Universum.whenNothing_ m x} + +- warn: {lhs: (m >>= \case Just _ -> pure () ; Nothing -> x), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= \case Just _ -> return (); Nothing -> x), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= \case Just _ -> pass ; Nothing -> x), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= \case Nothing -> x; Just _ -> pure () ), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= \case Nothing -> x; Just _ -> return ()), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= \case Nothing -> x; Just _ -> pass ), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (maybe x (\_ -> pure () ) =<< m), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (maybe x (\_ -> return () ) =<< m), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (maybe x (\_ -> pass ) =<< m), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (maybe x (const (pure () )) =<< m), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (maybe x (const (return ())) =<< m), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (maybe x (const (pass )) =<< m), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= maybe x (\_ -> pure ()) ), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= maybe x (\_ -> return ()) ), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= maybe x (\_ -> pass) ), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= maybe x (const (pure ()) )), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= maybe x (const (return ()))), rhs: Universum.whenNothingM_ m x} +- warn: {lhs: (m >>= maybe x (const (pass) )), rhs: Universum.whenNothingM_ m x} + +- warn: {lhs: (case m of Left x -> f x; Right _ -> pure () ), rhs: Universum.whenLeft m f} +- warn: {lhs: (case m of Left x -> f x; Right _ -> return ()), rhs: Universum.whenLeft m f} +- warn: {lhs: (case m of Left x -> f x; Right _ -> pass ), rhs: Universum.whenLeft m f} +- warn: {lhs: (case m of Right _ -> pure () ; Left x -> f x), rhs: Universum.whenLeft m f} +- warn: {lhs: (case m of Right _ -> return (); Left x -> f x), rhs: Universum.whenLeft m f} +- warn: {lhs: (case m of Right _ -> pass ; Left x -> f x), rhs: Universum.whenLeft m f} +- warn: {lhs: (either f (\_ -> pure () ) m), rhs: Universum.whenLeft m f} +- warn: {lhs: (either f (\_ -> return () ) m), rhs: Universum.whenLeft m f} +- warn: {lhs: (either f (\_ -> pass ) m), rhs: Universum.whenLeft m f} +- warn: {lhs: (either f (const (pure () )) m), rhs: Universum.whenLeft m f} +- warn: {lhs: (either f (const (return ())) m), rhs: Universum.whenLeft m f} +- warn: {lhs: (either f (const (pass )) m), rhs: Universum.whenLeft m f} + +- warn: {lhs: (m >>= \case Left x -> f x; Right _ -> pure () ), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= \case Left x -> f x; Right _ -> return ()), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= \case Left x -> f x; Right _ -> pass ), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= \case Right _ -> pure () ; Left x -> f x), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= \case Right _ -> return (); Left x -> f x), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= \case Right _ -> pass ; Left x -> f x), rhs: Universum.whenLeftM m f} +- warn: {lhs: (either f (\_ -> pure () ) =<< m), rhs: Universum.whenLeftM m f} +- warn: {lhs: (either f (\_ -> return () ) =<< m), rhs: Universum.whenLeftM m f} +- warn: {lhs: (either f (\_ -> pass ) =<< m), rhs: Universum.whenLeftM m f} +- warn: {lhs: (either f (const (pure () )) =<< m), rhs: Universum.whenLeftM m f} +- warn: {lhs: (either f (const (return ())) =<< m), rhs: Universum.whenLeftM m f} +- warn: {lhs: (either f (const (pass )) =<< m), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= either f (\_ -> pure ()) ), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= either f (\_ -> return ()) ), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= either f (\_ -> pass) ), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= either f (const (pure ()) )), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= either f (const (return ()))), rhs: Universum.whenLeftM m f} +- warn: {lhs: (m >>= either f (const (pass) )), rhs: Universum.whenLeftM m f} + +- warn: {lhs: (case m of Right x -> f x; Left _ -> pure () ), rhs: Universum.whenRight m f} +- warn: {lhs: (case m of Right x -> f x; Left _ -> return ()), rhs: Universum.whenRight m f} +- warn: {lhs: (case m of Right x -> f x; Left _ -> pass ), rhs: Universum.whenRight m f} +- warn: {lhs: (case m of Left _ -> pure () ; Right x -> f x), rhs: Universum.whenRight m f} +- warn: {lhs: (case m of Left _ -> return (); Right x -> f x), rhs: Universum.whenRight m f} +- warn: {lhs: (case m of Left _ -> pass ; Right x -> f x), rhs: Universum.whenRight m f} +- warn: {lhs: (either (\_ -> pure () ) f m), rhs: Universum.whenRight m f} +- warn: {lhs: (either (\_ -> return () ) f m), rhs: Universum.whenRight m f} +- warn: {lhs: (either (\_ -> pass ) f m), rhs: Universum.whenRight m f} +- warn: {lhs: (either (const (pure () )) f m), rhs: Universum.whenRight m f} +- warn: {lhs: (either (const (return ())) f m), rhs: Universum.whenRight m f} +- warn: {lhs: (either (const (pass )) f m), rhs: Universum.whenRight m f} + +- warn: {lhs: (m >>= \case Right x -> f x; Left _ -> pure () ), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= \case Right x -> f x; Left _ -> return ()), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= \case Right x -> f x; Left _ -> pass ), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= \case Left _ -> pure () ; Right x -> f x), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= \case Left _ -> return (); Right x -> f x), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= \case Left _ -> pass ; Right x -> f x), rhs: Universum.whenRightM m f} +- warn: {lhs: (either (\_ -> pure () ) f =<< m), rhs: Universum.whenRightM m f} +- warn: {lhs: (either (\_ -> return () ) f =<< m), rhs: Universum.whenRightM m f} +- warn: {lhs: (either (\_ -> pass ) f =<< m), rhs: Universum.whenRightM m f} +- warn: {lhs: (either (const (pure () )) f =<< m), rhs: Universum.whenRightM m f} +- warn: {lhs: (either (const (return ())) f =<< m), rhs: Universum.whenRightM m f} +- warn: {lhs: (either (const (pass )) f =<< m), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= either (\_ -> pure ()) f), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= either (\_ -> return ()) f), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= either (\_ -> pass) f), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= either (const (pure ()) ) f), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= either (const (return ())) f), rhs: Universum.whenRightM m f} +- warn: {lhs: (m >>= either (const (pass) ) f), rhs: Universum.whenRightM m f} + +- warn: {lhs: "(case m of [] -> return (); (x:xs) -> f (x :| xs))", rhs: Universum.whenNotNull m f} +- warn: {lhs: "(case m of [] -> pure () ; (x:xs) -> f (x :| xs))", rhs: Universum.whenNotNull m f} +- warn: {lhs: "(case m of [] -> pass ; (x:xs) -> f (x :| xs))", rhs: Universum.whenNotNull m f} +- warn: {lhs: "(case m of (x:xs) -> f (x :| xs); [] -> return ())", rhs: Universum.whenNotNull m f} +- warn: {lhs: "(case m of (x:xs) -> f (x :| xs); [] -> pure () )", rhs: Universum.whenNotNull m f} +- warn: {lhs: "(case m of (x:xs) -> f (x :| xs); [] -> pass )", rhs: Universum.whenNotNull m f} +- warn: {lhs: "(m >>= \\case [] -> pass ; (x:xs) -> f (x :| xs))", rhs: Universum.whenNotNullM m f} +- warn: {lhs: "(m >>= \\case [] -> pure () ; (x:xs) -> f (x :| xs))", rhs: Universum.whenNotNullM m f} +- warn: {lhs: "(m >>= \\case [] -> return (); (x:xs) -> f (x :| xs))", rhs: Universum.whenNotNullM m f} +- warn: {lhs: "(m >>= \\case (x:xs) -> f (x :| xs); [] -> pass )", rhs: Universum.whenNotNullM m f} +- warn: {lhs: "(m >>= \\case (x:xs) -> f (x :| xs); [] -> pure () )", rhs: Universum.whenNotNullM m f} +- warn: {lhs: "(m >>= \\case (x:xs) -> f (x :| xs); [] -> return ())", rhs: Universum.whenNotNullM m f} + +- warn: {lhs: mapMaybe leftToMaybe, rhs: lefts} +- warn: {lhs: mapMaybe rightToMaybe, rhs: rights} + +############################################################################ +## Reexports +############################################################################ + +## Applicative +- warn: { name: "Use 'Alternative' from Universum" + , lhs: Control.Applicative.Alternative, rhs: Universum.Alternative } +- warn: { name: "Use 'empty' from Universum" + , lhs: Control.Applicative.empty, rhs: Universum.empty } +- warn: { name: "Use '(<|>)' from Universum" + , lhs: Control.Applicative.(<|>), rhs: Universum.(<|>) } +- warn: { name: "Use 'some' from Universum" + , lhs: Control.Applicative.some, rhs: Universum.some } +- warn: { name: "Use 'many' from Universum" + , lhs: Control.Applicative.many, rhs: Universum.many } +- warn: { name: "Use 'Const' from Universum" + , lhs: Control.Applicative.Const, rhs: Universum.Const } +- warn: { name: "Use 'getConst' from Universum" + , lhs: Control.Applicative.getConst, rhs: Universum.getConst } +- warn: { name: "Use 'ZipList' from Universum" + , lhs: Control.Applicative.ZipList, rhs: Universum.ZipList } +- warn: { name: "Use 'getZipList' from Universum" + , lhs: Control.Applicative.getZipList, rhs: Universum.getZipList } +- warn: { name: "Use 'liftA2' from Universum" + , lhs: Control.Applicative.liftA2, rhs: Universum.liftA2 } +- warn: { name: "Use 'liftA3' from Universum" + , lhs: Control.Applicative.liftA3, rhs: Universum.liftA3 } +- warn: { name: "Use 'optional' from Universum" + , lhs: Control.Applicative.optional, rhs: Universum.optional } +- warn: { name: "Use '(<**>)' from Universum" + , lhs: Control.Applicative.(<**>), rhs: Universum.(<**>) } + +## Base +- warn: { name: "Use 'xor' from Universum" + , lhs: Data.Bits.xor, rhs: Universum.xor } + +- warn: { name: "Use 'chr' from Universum" + , lhs: Data.Char.chr, rhs: Universum.chr } + +- warn: { name: "Use 'Int16' from Universum" + , lhs: Data.Int.Int16, rhs: Universum.Int16 } +- warn: { name: "Use 'Int32' from Universum" + , lhs: Data.Int.Int32, rhs: Universum.Int32 } +- warn: { name: "Use 'Int64' from Universum" + , lhs: Data.Int.Int64, rhs: Universum.Int64 } +- warn: { name: "Use 'Int8' from Universum" + , lhs: Data.Int.Int8, rhs: Universum.Int8 } + +- warn: { name: "Use 'Word16' from Universum" + , lhs: Data.Word.Word16, rhs: Universum.Word16 } +- warn: { name: "Use 'Word32' from Universum" + , lhs: Data.Word.Word32, rhs: Universum.Word32 } +- warn: { name: "Use 'Word64' from Universum" + , lhs: Data.Word.Word64, rhs: Universum.Word64 } +- warn: { name: "Use 'Word8' from Universum" + , lhs: Data.Word.Word8, rhs: Universum.Word8 } +- warn: { name: "Use 'byteSwap16' from Universum" + , lhs: Data.Word.byteSwap16, rhs: Universum.byteSwap16 } +- warn: { name: "Use 'byteSwap32' from Universum" + , lhs: Data.Word.byteSwap32, rhs: Universum.byteSwap32 } +- warn: { name: "Use 'byteSwap64' from Universum" + , lhs: Data.Word.byteSwap64, rhs: Universum.byteSwap64 } + +- warn: { name: "Use 'Natural' from Universum" + , lhs: Numeric.Natural.Natural, rhs: Universum.Natural } + +- warn: { name: "Use 'Handle' from Universum" + , lhs: System.IO.Handle, rhs: Universum.Handle } +- warn: { name: "Use 'IOMode' from Universum" + , lhs: System.IO.IOMode, rhs: Universum.IOMode } +- warn: { name: "Use 'ReadMode' from Universum" + , lhs: System.IO.ReadMode, rhs: Universum.ReadMode } +- warn: { name: "Use 'WriteMode' from Universum" + , lhs: System.IO.WriteMode, rhs: Universum.WriteMode } +- warn: { name: "Use 'AppendMode' from Universum" + , lhs: System.IO.AppendMode, rhs: Universum.AppendMode } +- warn: { name: "Use 'ReadWriteMode' from Universum" + , lhs: System.IO.ReadWriteMode, rhs: Universum.ReadWriteMode } +- warn: { name: "Use 'stderr' from Universum" + , lhs: System.IO.stderr, rhs: Universum.stderr } +- warn: { name: "Use 'stdin' from Universum" + , lhs: System.IO.stdin, rhs: Universum.stdin } +- warn: { name: "Use 'stdout' from Universum" + , lhs: System.IO.stdout, rhs: Universum.stdout } +- warn: { name: "Use 'withFile' from Universum" + , lhs: System.IO.withFile, rhs: Universum.withFile } + +- warn: { name: "Use 'foldlM' from Universum" + , lhs: Data.Foldable.foldlM, rhs: Universum.foldlM } +- warn: { name: "Use 'foldrM' from Universum" + , lhs: Data.Foldable.foldrM, rhs: Universum.foldrM } +- warn: { name: "Use 'maximumBy' from Universum" + , lhs: Data.Foldable.maximumBy, rhs: Universum.maximumBy } +- warn: { name: "Use 'minimumBy' from Universum" + , lhs: Data.Foldable.minimumBy, rhs: Universum.minimumBy } + +- warn: { name: "Use 'Down' from Universum" + , lhs: Data.Ord.Down, rhs: Universum.Down } +- warn: { name: "Use 'comparing' from Universum" + , lhs: Data.Ord.comparing, rhs: Universum.comparing } + +- warn: { name: "Use 'fmapDefault' from Universum" + , lhs: Data.Traversable.fmapDefault, rhs: Universum.fmapDefault } +- warn: { name: "Use 'foldMapDefault' from Universum" + , lhs: Data.Traversable.foldMapDefault, rhs: Universum.foldMapDefault } +- warn: { name: "Use 'forM' from Universum" + , lhs: Data.Traversable.forM, rhs: Universum.forM } +- warn: { name: "Use 'mapAccumL' from Universum" + , lhs: Data.Traversable.mapAccumL, rhs: Universum.mapAccumL } +- warn: { name: "Use 'mapAccumR' from Universum" + , lhs: Data.Traversable.mapAccumR, rhs: Universum.mapAccumR } + +- warn: { name: "Use 'Proxy' from Universum" + , lhs: Data.Proxy.Proxy, rhs: Universum.Proxy } + +- warn: { name: "Use 'Typeable' from Universum" + , lhs: Data.Typeable.Typeable, rhs: Universum.Typeable } + +- warn: { name: "Use 'Void' from Universum" + , lhs: Data.Void.Void, rhs: Universum.Void } +- warn: { name: "Use 'absurd' from Universum" + , lhs: Data.Void.absurd, rhs: Universum.absurd } +- warn: { name: "Use 'vacuous' from Universum" + , lhs: Data.Void.vacuous, rhs: Universum.vacuous } + +- warn: { name: "Use 'maxInt' from Universum" + , lhs: Data.Base.maxInt, rhs: Universum.maxInt } +- warn: { name: "Use 'minInt' from Universum" + , lhs: Data.Base.minInt, rhs: Universum.minInt } +- warn: { name: "Use 'ord' from Universum" + , lhs: Data.Base.ord, rhs: Universum.ord } + +- warn: { name: "Use 'boundedEnumFrom' from Universum" + , lhs: GHC.Enum.boundedEnumFrom, rhs: Universum.boundedEnumFrom } +- warn: { name: "Use 'boundedEnumFromThen' from Universum" + , lhs: GHC.Enum.boundedEnumFromThen, rhs: Universum.boundedEnumFromThen } + +- warn: { name: "Use 'Constraint' from Universum" + , lhs: GHC.Exts.Constraint, rhs: Universum.Constraint } +- warn: { name: "Use 'FunPtr' from Universum" + , lhs: GHC.Exts.FunPtr, rhs: Universum.FunPtr } +- warn: { name: "Use 'Ptr' from Universum" + , lhs: GHC.Exts.Ptr, rhs: Universum.Ptr } + +- warn: { name: "Use 'Generic' from Universum" + , lhs: GHC.Generics.Generic, rhs: Universum.Generic } + +- warn: { name: "Use 'Ratio' from Universum" + , lhs: GHC.Real.Ratio, rhs: Universum.Ratio } +- warn: { name: "Use 'Rational' from Universum" + , lhs: GHC.Real.Rational, rhs: Universum.Rational } + +- warn: { name: "Use 'CmpNat' from Universum" + , lhs: GHC.TypeNats.CmpNat, rhs: Universum.CmpNat } +- warn: { name: "Use 'KnownNat' from Universum" + , lhs: GHC.TypeNats.KnownNat, rhs: Universum.KnownNat } +- warn: { name: "Use 'Nat' from Universum" + , lhs: GHC.TypeNats.Nat, rhs: Universum.Nat } +- warn: { name: "Use 'SomeNat' from Universum" + , lhs: GHC.TypeNats.SomeNat, rhs: Universum.SomeNat } +- warn: { name: "Use 'natVal' from Universum" + , lhs: GHC.TypeNats.natVal, rhs: Universum.natVal } +- warn: { name: "Use 'someNatVal' from Universum" + , lhs: GHC.TypeNats.someNatVal, rhs: Universum.someNatVal } + +- warn: { name: "Use 'CmpNat' from Universum" + , lhs: GHC.TypeLits.CmpNat, rhs: Universum.CmpNat } +- warn: { name: "Use 'KnownNat' from Universum" + , lhs: GHC.TypeLits.KnownNat, rhs: Universum.KnownNat } +- warn: { name: "Use 'Nat' from Universum" + , lhs: GHC.TypeLits.Nat, rhs: Universum.Nat } +- warn: { name: "Use 'SomeNat' from Universum" + , lhs: GHC.TypeLits.SomeNat, rhs: Universum.SomeNat } +- warn: { name: "Use 'natVal' from Universum" + , lhs: GHC.TypeLits.natVal, rhs: Universum.natVal } +- warn: { name: "Use 'someNatVal' from Universum" + , lhs: GHC.TypeLits.someNatVal, rhs: Universum.someNatVal } + +- warn: { name: "Use 'Coercible' from Universum" + , lhs: GHC.Types.Coercible, rhs: Universum.Coercible } + +- warn: { name: "Use 'getStackTrace' from Universum" + , lhs: GHC.ExecutionStack.getStackTrace, rhs: Universum.getStackTrace } +- warn: { name: "Use 'showStackTrace' from Universum" + , lhs: GHC.ExecutionStack.showStackTrace, rhs: Universum.showStackTrace } + +- warn: { name: "Use 'IsLabel' from Universum" + , lhs: GHC.OverloadedLabels.IsLabel, rhs: Universum.IsLabel } +- warn: { name: "Use 'fromLabel' from Universum" + , lhs: GHC.OverloadedLabels.fromLabel, rhs: Universum.fromLabel } + +- warn: { name: "Use 'CallStack' from Universum" + , lhs: GHC.Stack.CallStack, rhs: Universum.CallStack } +- warn: { name: "Use 'HasCallStack' from Universum" + , lhs: GHC.Stack.HasCallStack, rhs: Universum.HasCallStack } +- warn: { name: "Use 'callStack' from Universum" + , lhs: GHC.Stack.callStack, rhs: Universum.callStack } +- warn: { name: "Use 'currentCallStack' from Universum" + , lhs: GHC.Stack.currentCallStack, rhs: Universum.currentCallStack } +- warn: { name: "Use 'getCallStack' from Universum" + , lhs: GHC.Stack.getCallStack, rhs: Universum.getCallStack } +- warn: { name: "Use 'prettyCallStack' from Universum" + , lhs: GHC.Stack.prettyCallStack, rhs: Universum.prettyCallStack } +- warn: { name: "Use 'prettySrcLoc' from Universum" + , lhs: GHC.Stack.prettySrcLoc, rhs: Universum.prettySrcLoc } +- warn: { name: "Use 'withFrozenCallStack' from Universum" + , lhs: GHC.Stack.withFrozenCallStack, rhs: Universum.withFrozenCallStack } + +- warn: { name: "Use 'Type' from Universum" + , lhs: Data.Kind.Type, rhs: Universum.Type } + +## Bool + +- warn: { name: "Use 'guard' from Universum" + , lhs: Control.Monad.guard, rhs: Universum.guard } +- warn: { name: "Use 'unless' from Universum" + , lhs: Control.Monad.unless, rhs: Universum.unless } +- warn: { name: "Use 'when' from Universum" + , lhs: Control.Monad.when, rhs: Universum.when } +- warn: { name: "Use 'bool' from Universum" + , lhs: Data.Bool.bool, rhs: Universum.bool } + +## Container +- warn: { name: "Use 'Hashable' from Universum" + , lhs: Data.Hashable.Hashable, rhs: Universum.Hashable } +- warn: { name: "Use 'hashWithSalt' from Universum" + , lhs: Data.Hashable.hashWithSalt, rhs: Universum.hashWithSalt } +- warn: { name: "Use 'HashMap' from Universum" + , lhs: Data.HashMap.Strict.HashMap, rhs: Universum.HashMap } +- warn: { name: "Use 'HashSet' from Universum" + , lhs: Data.HashSet.HashSet, rhs: Universum.HashSet } +- warn: { name: "Use 'IntMap' from Universum" + , lhs: Data.IntMap.Strict.IntMap, rhs: Universum.IntMap } +- warn: { name: "Use 'IntSet' from Universum" + , lhs: Data.IntSet.IntSet, rhs: Universum.IntSet } +- warn: { name: "Use 'Map' from Universum" + , lhs: Data.Map.Strict.Map, rhs: Universum.Map } +- warn: { name: "Use 'Sequence' from Universum" + , lhs: Data.Sequence.Sequence, rhs: Universum.Sequence } +- warn: { name: "Use 'Set' from Universum" + , lhs: Data.Set.Set, rhs: Universum.Set } +- warn: { name: "Use 'swap' from Universum" + , lhs: Data.Tuple.swap, rhs: Universum.swap } +- warn: { name: "Use 'Vector' from Universum" + , lhs: Data.Vector.Vector, rhs: Universum.Vector } + +## Deepseq +- warn: { name: "Use 'NFData' from Universum" + , lhs: Control.DeepSeq.NFData, rhs: Universum.NFData } +- warn: { name: "Use 'rnf' from Universum" + , lhs: Control.DeepSeq.rnf, rhs: Universum.rnf } +- warn: { name: "Use 'deepseq' from Universum" + , lhs: Control.DeepSeq.deepseq, rhs: Universum.deepseq } +- warn: { name: "Use 'force' from Universum" + , lhs: Control.DeepSeq.force, rhs: Universum.force } +- warn: { name: "Use '($!!)' from Universum" + , lhs: "Control.DeepSeq.($!!)", rhs: "Universum.($!!)" } + +## Exception +- warn: { name: "Use 'Exception' from Universum" + , lhs: Control.Exception.Exception, rhs: Universum.Exception } +- warn: { name: "Use 'toException' from Universum" + , lhs: Control.Exception.toException, rhs: Universum.toException } +- warn: { name: "Use 'fromException' from Universum" + , lhs: Control.Exception.fromException, rhs: Universum.fromException } + +- warn: { name: "Use 'Exception' from Universum" + , lhs: Control.Exception.Safe.Exception, rhs: Universum.Exception } +- warn: { name: "Use 'toException' from Universum" + , lhs: Control.Exception.Safe.toException, rhs: Universum.toException } +- warn: { name: "Use 'fromException' from Universum" + , lhs: Control.Exception.Safe.fromException, rhs: Universum.fromException } +- warn: { name: "Use 'displayException' from Universum" + , lhs: Control.Exception.Safe.displayException, rhs: Universum.displayException } +- warn: { name: "Use 'MonadCatch' from Universum" + , lhs: Control.Exception.Safe.MonadCatch, rhs: Universum.MonadCatch } +- warn: { name: "Use 'MonadMask' from Universum" + , lhs: Control.Exception.Safe.MonadMask, rhs: Universum.MonadMask } +- warn: { name: "Use 'mask' from Universum" + , lhs: Control.Exception.Safe.mask, rhs: Universum.mask } +- warn: { name: "Use 'uninterruptibleMask' from Universum" + , lhs: Control.Exception.Safe.uninterruptibleMask, rhs: Universum.uninterruptibleMask } +- warn: { name: "Use 'MonadThrow' from Universum" + , lhs: Control.Exception.Safe.MonadThrow, rhs: Universum.MonadThrow } +- warn: { name: "Use 'SomeException' from Universum" + , lhs: Control.Exception.Safe.SomeException, rhs: Universum.SomeException } +- warn: { name: "Use 'bracket' from Universum" + , lhs: Control.Exception.Safe.bracket, rhs: Universum.bracket } +- warn: { name: "Use 'bracketOnError' from Universum" + , lhs: Control.Exception.Safe.bracketOnError, rhs: Universum.bracketOnError } +- warn: { name: "Use 'bracket_' from Universum" + , lhs: Control.Exception.Safe.bracket_, rhs: Universum.bracket_ } +- warn: { name: "Use 'catch' from Universum" + , lhs: Control.Exception.Safe.catch, rhs: Universum.catch } +- warn: { name: "Use 'catchAny' from Universum" + , lhs: Control.Exception.Safe.catchAny, rhs: Universum.catchAny } +- warn: { name: "Use 'finally' from Universum" + , lhs: Control.Exception.Safe.finally, rhs: Universum.finally } +- warn: { name: "Use 'handleAny' from Universum" + , lhs: Control.Exception.Safe.handleAny, rhs: Universum.handleAny } +- warn: { name: "Use 'onException' from Universum" + , lhs: Control.Exception.Safe.onException, rhs: Universum.onException } +- warn: { name: "Use 'throwM' from Universum" + , lhs: Control.Exception.Safe.throwM, rhs: Universum.throwM } +- warn: { name: "Use 'try' from Universum" + , lhs: Control.Exception.Safe.try, rhs: Universum.try } +- warn: { name: "Use 'tryAny' from Universum" + , lhs: Control.Exception.Safe.tryAny, rhs: Universum.tryAny } + +## Function +- warn: { name: "Use 'fix' from Universum" + , lhs: Data.Function.fix, rhs: Universum.fix } +- warn: { name: "Use 'on' from Universum" + , lhs: Data.Function.on, rhs: Universum.on } + +## Functor +- warn: { name: "Use '(&&&)' from Universum" + , lhs: Control.Arrow.(&&&), rhs: Universum.(&&&) } +- warn: { name: "Use 'Bifunctor' from Universum" + , lhs: Data.Bifunctor.Bifunctor, rhs: Universum.Bifunctor } +- warn: { name: "Use 'bimap' from Universum" + , lhs: Data.Bifunctor.bimap, rhs: Universum.bimap } +- warn: { name: "Use 'first' from Universum" + , lhs: Data.Bifunctor.first, rhs: Universum.first } +- warn: { name: "Use 'second' from Universum" + , lhs: Data.Bifunctor.second, rhs: Universum.second } +- warn: { name: "Use 'void' from Universum" + , lhs: Data.Functor.void, rhs: Universum.void } +- warn: { name: "Use '($>)' from Universum" + , lhs: Data.Functor.($>), rhs: Universum.($>) } +- warn: { name: "Use 'Compose' from Universum" + , lhs: Data.Functor.Compose.Compose, rhs: Universum.Compose } +- warn: { name: "Use 'getCompose' from Universum" + , lhs: Data.Functor.Compose.getCompose, rhs: Universum.getCompose } +- warn: { name: "Use 'Identity' from Universum" + , lhs: Data.Functor.Identity.Identity, rhs: Universum.Identity } +- warn: { name: "Use 'runIdentity' from Universum" + , lhs: Data.Functor.Identity.runIdentity, rhs: Universum.runIdentity } + +## List +- warn: { name: "Use 'genericDrop' from Universum" + , lhs: Data.List.genericDrop, rhs: Universum.genericDrop } +- warn: { name: "Use 'genericLength' from Universum" + , lhs: Data.List.genericLength, rhs: Universum.genericLength } +- warn: { name: "Use 'genericReplicate' from Universum" + , lhs: Data.List.genericReplicate, rhs: Universum.genericReplicate } +- warn: { name: "Use 'genericSplitAt' from Universum" + , lhs: Data.List.genericSplitAt, rhs: Universum.genericSplitAt } +- warn: { name: "Use 'genericTake' from Universum" + , lhs: Data.List.genericTake, rhs: Universum.genericTake } +- warn: { name: "Use 'group' from Universum" + , lhs: Data.List.group, rhs: Universum.group } +- warn: { name: "Use 'inits' from Universum" + , lhs: Data.List.inits, rhs: Universum.inits } +- warn: { name: "Use 'intercalate' from Universum" + , lhs: Data.List.intercalate, rhs: Universum.intercalate } +- warn: { name: "Use 'intersperse' from Universum" + , lhs: Data.List.intersperse, rhs: Universum.intersperse } +- warn: { name: "Use 'isPrefixOf' from Universum" + , lhs: Data.List.isPrefixOf, rhs: Universum.isPrefixOf } +- warn: { name: "Use 'permutations' from Universum" + , lhs: Data.List.permutations, rhs: Universum.permutations } +- warn: { name: "Use 'sort' from Universum" + , lhs: Data.List.sort, rhs: Universum.sort } +- warn: { name: "Use 'sortBy' from Universum" + , lhs: Data.List.sortBy, rhs: Universum.sortBy } +- warn: { name: "Use 'sortOn' from Universum" + , lhs: Data.List.sortOn, rhs: Universum.sortOn } +- warn: { name: "Use 'subsequences' from Universum" + , lhs: Data.List.subsequences, rhs: Universum.subsequences } +- warn: { name: "Use 'tails' from Universum" + , lhs: Data.List.tails, rhs: Universum.tails } +- warn: { name: "Use 'transpose' from Universum" + , lhs: Data.List.transpose, rhs: Universum.transpose } +- warn: { name: "Use 'unfoldr' from Universum" + , lhs: Data.List.unfoldr, rhs: Universum.unfoldr } + +- warn: { name: "Use 'NonEmpty' from Universum" + , lhs: Data.List.NonEmpty.NonEmpty, rhs: Universum.NonEmpty } +- warn: { name: "Use '(:|)' from Universum" + , lhs: "Data.List.NonEmpty.(:|)", rhs: "Universum.(:|)"} +- warn: { name: "Use 'nonEmpty' from Universum" + , lhs: Data.List.NonEmpty.nonEmpty, rhs: Universum.nonEmpty} +- warn: { name: "Use 'head' from Universum" + , lhs: Data.List.NonEmpty.head, rhs: Universum.head } +- warn: { name: "Use 'init' from Universum" + , lhs: Data.List.NonEmpty.init, rhs: Universum.init } +- warn: { name: "Use 'last' from Universum" + , lhs: Data.List.NonEmpty.last, rhs: Universum.last } +- warn: { name: "Use 'tail' from Universum" + , lhs: Data.List.NonEmpty.tail, rhs: Universum.tail } +- warn: { name: "Use 'sortWith' from Universum" + , lhs: GHC.Exts.sortWith, rhs: Universum.sortWith } + +## Monad +- warn: { name: "Use '(>=>)' from Universum" + , lhs: Control.Monad.(>=>), rhs: Universum.(>=>) } +- warn: { name: "Use '(<=<)' from Universum" + , lhs: Control.Monad.(<=<), rhs: Universum.(<=<) } +- warn: { name: "Use 'forever' from Universum" + , lhs: Control.Monad.forever, rhs: Universum.forever } +- warn: { name: "Use 'join' from Universum" + , lhs: Control.Monad.join, rhs: Universum.join } +- warn: { name: "Use 'mfilter' from Universum" + , lhs: Control.Monad.mfilter, rhs: Universum.mfilter } +- warn: { name: "Use 'filterM' from Universum" + , lhs: Control.Monad.filterM, rhs: Universum.filterM } +- warn: { name: "Use 'mapAndUnzipM' from Universum" + , lhs: Control.Monad.mapAndUnzipM, rhs: Universum.mapAndUnzipM } +- warn: { name: "Use 'zipWithM' from Universum" + , lhs: Control.Monad.zipWithM, rhs: Universum.zipWithM } +- warn: { name: "Use 'zipWithM_' from Universum" + , lhs: Control.Monad.zipWithM_, rhs: Universum.zipWithM_ } +- warn: { name: "Use 'foldM' from Universum" + , lhs: Control.Monad.foldM, rhs: Universum.foldM } +- warn: { name: "Use 'foldM_' from Universum" + , lhs: Control.Monad.foldM_, rhs: Universum.foldM_ } +- warn: { name: "Use 'replicateM' from Universum" + , lhs: Control.Monad.replicateM, rhs: Universum.replicateM } +- warn: { name: "Use 'replicateM_' from Universum" + , lhs: Control.Monad.replicateM_, rhs: Universum.replicateM_ } +- warn: { name: "Use 'liftM2' from Universum" + , lhs: Control.Monad.liftM2, rhs: Universum.liftM2 } +- warn: { name: "Use 'liftM3' from Universum" + , lhs: Control.Monad.liftM3, rhs: Universum.liftM3 } +- warn: { name: "Use 'liftM4' from Universum" + , lhs: Control.Monad.liftM4, rhs: Universum.liftM4 } +- warn: { name: "Use 'liftM5' from Universum" + , lhs: Control.Monad.liftM5, rhs: Universum.liftM5 } +- warn: { name: "Use 'ap' from Universum" + , lhs: Control.Monad.ap, rhs: Universum.ap } +- warn: { name: "Use '(<$!>)' from Universum" + , lhs: Control.Monad.(<$!>), rhs: Universum.(<$!>) } + +- warn: { name: "Use 'ExceptT' from Universum" + , lhs: Control.Monad.Except.ExceptT, rhs: Universum.ExceptT } +- warn: { name: "Use 'runExceptT' from Universum" + , lhs: Control.Monad.Except.runExceptT, rhs: Universum.runExceptT } + +- warn: { name: "Use 'MonadReader' from Universum" + , lhs: Control.Monad.Reader.MonadReader, rhs: Universum.MonadReader } +- warn: { name: "Use 'Reader' from Universum" + , lhs: Control.Monad.Reader.Reader, rhs: Universum.Reader } +- warn: { name: "Use 'ReaderT' from Universum" + , lhs: Control.Monad.Reader.ReaderT, rhs: Universum.ReaderT } +- warn: { name: "Use 'runReaderT' from Universum" + , lhs: Control.Monad.Reader.runReaderT, rhs: Universum.runReaderT } +- warn: { name: "Use 'ask' from Universum" + , lhs: Control.Monad.Reader.ask, rhs: Universum.ask } +- warn: { name: "Use 'local' from Universum" + , lhs: Control.Monad.Reader.local, rhs: Universum.local } +- warn: { name: "Use 'reader' from Universum" + , lhs: Control.Monad.Reader.reader, rhs: Universum.reader } +- warn: { name: "Use 'runReader' from Universum" + , lhs: Control.Monad.Reader.runReader, rhs: Universum.runReader } + +- warn: { name: "Use 'MonadState' from Universum" + , lhs: Control.Monad.State.Strict.MonadState, rhs: Universum.MonadState } +- warn: { name: "Use 'State' from Universum" + , lhs: Control.Monad.State.Strict.State, rhs: Universum.State } +- warn: { name: "Use 'StateT' from Universum" + , lhs: Control.Monad.State.Strict.StateT, rhs: Universum.StateT } +- warn: { name: "Use 'runStateT' from Universum" + , lhs: Control.Monad.State.Strict.runStateT, rhs: Universum.runStateT } +- warn: { name: "Use 'evalState' from Universum" + , lhs: Control.Monad.State.Strict.evalState, rhs: Universum.evalState } +- warn: { name: "Use 'evalStateT' from Universum" + , lhs: Control.Monad.State.Strict.evalStateT, rhs: Universum.evalStateT } +- warn: { name: "Use 'execState' from Universum" + , lhs: Control.Monad.State.Strict.execState, rhs: Universum.execState } +- warn: { name: "Use 'execStateT' from Universum" + , lhs: Control.Monad.State.Strict.execStateT, rhs: Universum.execStateT } +- warn: { name: "Use 'get' from Universum" + , lhs: Control.Monad.State.Strict.get, rhs: Universum.get } +- warn: { name: "Use 'gets' from Universum" + , lhs: Control.Monad.State.Strict.gets, rhs: Universum.gets } +- warn: { name: "Use 'modify' from Universum" + , lhs: Control.Monad.State.Strict.modify, rhs: Universum.modify } +- warn: { name: "Use 'modify'' from Universum" + , lhs: "Control.Monad.State.Strict.modify'", rhs: "Universum.modify'" } +- warn: { name: "Use 'put' from Universum" + , lhs: Control.Monad.State.Strict.put, rhs: Universum.put } +- warn: { name: "Use 'runState' from Universum" + , lhs: Control.Monad.State.Strict.runState, rhs: Universum.runState } +- warn: { name: "Use 'state' from Universum" + , lhs: Control.Monad.State.Strict.state, rhs: Universum.state } +- warn: { name: "Use 'withState' from Universum" + , lhs: Control.Monad.State.Strict.withState, rhs: Universum.withState } + +- warn: { name: "Use 'MonadFail' from Universum" + , lhs: Control.Monad.Fail.MonadFail, rhs: Universum.MonadFail } + + +- warn: { name: "Use 'MonadIO' from Universum" + , lhs: Control.Monad.Trans.MonadIO, rhs: Universum.MonadIO } +- warn: { name: "Use 'MonadTrans' from Universum" + , lhs: Control.Monad.Trans.MonadTrans, rhs: Universum.MonadTrans } +- warn: { name: "Use 'lift' from Universum" + , lhs: Control.Monad.Trans.lift, rhs: Universum.lift } +- warn: { name: "Use 'liftIO' from Universum" + , lhs: Control.Monad.Trans.liftIO, rhs: Universum.liftIO } + +- warn: { name: "Use 'IdentityT' from Universum" + , lhs: Control.Monad.Trans.Identity.IdentityT, rhs: Universum.IdentityT } +- warn: { name: "Use 'runIdentityT' from Universum" + , lhs: Control.Monad.Trans.Identity.runIdentityT, rhs: Universum.runIdentityT } + +- warn: { name: "Use 'MaybeT' from Universum" + , lhs: Control.Monad.Trans.Maybe.MaybeT, rhs: Universum.MaybeT } +- warn: { name: "Use 'maybeToExceptT' from Universum" + , lhs: Control.Monad.Trans.Maybe.maybeToExceptT, rhs: Universum.maybeToExceptT } +- warn: { name: "Use 'exceptToMaybeT' from Universum" + , lhs: Control.Monad.Trans.Maybe.exceptToMaybeT, rhs: Universum.exceptToMaybeT } + +- warn: { name: "Use 'catMaybes' from Universum" + , lhs: Data.Maybe.catMaybes, rhs: Universum.catMaybes } +- warn: { name: "Use 'fromMaybe' from Universum" + , lhs: Data.Maybe.fromMaybe, rhs: Universum.fromMaybe } +- warn: { name: "Use 'isJust' from Universum" + , lhs: Data.Maybe.isJust, rhs: Universum.isJust } +- warn: { name: "Use 'isNothing' from Universum" + , lhs: Data.Maybe.isNothing, rhs: Universum.isNothing } +- warn: { name: "Use 'listToMaybe' from Universum" + , lhs: Data.Maybe.listToMaybe, rhs: Universum.listToMaybe } +- warn: { name: "Use 'mapMaybe' from Universum" + , lhs: Data.Maybe.mapMaybe, rhs: Universum.mapMaybe } +- warn: { name: "Use 'maybeToList' from Universum" + , lhs: Data.Maybe.maybeToList, rhs: Universum.maybeToList } + +- warn: { name: "Use 'isLeft' from Universum" + , lhs: Data.Either.isLeft, rhs: Universum.isLeft } +- warn: { name: "Use 'isRight' from Universum" + , lhs: Data.Either.isRight, rhs: Universum.isRight } +- warn: { name: "Use 'lefts' from Universum" + , lhs: Data.Either.lefts, rhs: Universum.lefts } +- warn: { name: "Use 'partitionEithers' from Universum" + , lhs: Data.Either.partitionEithers, rhs: Universum.partitionEithers } +- warn: { name: "Use 'rights' from Universum" + , lhs: Data.Either.rights, rhs: Universum.rights } + +- warn: { name: "Use 'newTVar' from Universum" + , lhs: Control.Concurrent.STM.TVar.newTVar, rhs: Universum.newTVar } +- warn: { name: "Use 'readTVar' from Universum" + , lhs: Control.Concurrent.STM.TVar.readTVar, rhs: Universum.readTVar } +- warn: { name: "Use 'writeTVar' from Universum" + , lhs: Control.Concurrent.STM.TVar.writeTVar, rhs: Universum.writeTVar } +- warn: { name: "Use 'modifyTVar'' from Universum" + , lhs: "Control.Concurrent.STM.TVar.modifyTVar'", rhs: "Universum.modifyTVar'" } +- warn: { name: "Use 'newTVarIO' from Universum" + , lhs: Control.Concurrent.STM.TVar.newTVarIO, rhs: Universum.newTVarIO } +- warn: { name: "Use 'readTVarIO' from Universum" + , lhs: Control.Concurrent.STM.TVar.readTVarIO, rhs: Universum.readTVarIO } + +- warn: { name: "Use 'newIORef' from Universum" + , lhs: Data.IORef.newIORef, rhs: Universum.newIORef } +- warn: { name: "Use 'readIORef' from Universum" + , lhs: Data.IORef.readIORef, rhs: Universum.readIORef } +- warn: { name: "Use 'writeIORef' from Universum" + , lhs: Data.IORef.writeIORef, rhs: Universum.writeIORef } +- warn: { name: "Use 'modifyIORef' from Universum" + , lhs: Data.IORef.modifyIORef, rhs: Universum.modifyIORef } +- warn: { name: "Use 'modifyIORef'' from Universum" + , lhs: "Data.IORef.modifyIORef'", rhs: "Universum.modifyIORef'" } +- warn: { name: "Use 'atomicModifyIORef' from Universum" + , lhs: Data.IORef.atomicModifyIORef, rhs: Universum.atomicModifyIORef } +- warn: { name: "Use 'atomicModifyIORef'' from Universum" + , lhs: "Data.IORef.atomicModifyIORef'", rhs: "Universum.atomicModifyIORef'" } +- warn: { name: "Use 'atomicWriteIORef' from Universum" + , lhs: Data.IORef.atomicWriteIORef, rhs: Universum.atomicWriteIORef } + +## Monoid +- warn: { name: "Use 'All' from Universum" + , lhs: Data.Monoid.All, rhs: Universum.All } +- warn: { name: "Use 'Alt' from Universum" + , lhs: Data.Monoid.Alt, rhs: Universum.Alt } +- warn: { name: "Use 'Any' from Universum" + , lhs: Data.Monoid.Any, rhs: Universum.Any } +- warn: { name: "Use 'Dual' from Universum" + , lhs: Data.Monoid.Dual, rhs: Universum.Dual } +- warn: { name: "Use 'Endo' from Universum" + , lhs: Data.Monoid.Endo, rhs: Universum.Endo } +- warn: { name: "Use 'First' from Universum" + , lhs: Data.Monoid.First, rhs: Universum.First } +- warn: { name: "Use 'Last' from Universum" + , lhs: Data.Monoid.Last, rhs: Universum.Last } +- warn: { name: "Use 'Product' from Universum" + , lhs: Data.Monoid.Product, rhs: Universum.Product } +- warn: { name: "Use 'Sum' from Universum" + , lhs: Data.Monoid.Sum, rhs: Universum.Sum } + +- warn: { name: "Use 'Option' from Universum" + , lhs: Data.Semigroup.Option, rhs: Universum.Option } +- warn: { name: "Use 'Semigroup' from Universum" + , lhs: Data.Semigroup.Semigroup, rhs: Universum.Semigroup } +- warn: { name: "Use 'sconcat' from Universum" + , lhs: Data.Semigroup.sconcat, rhs: Universum.sconcat } +- warn: { name: "Use 'stimes' from Universum" + , lhs: Data.Semigroup.stimes, rhs: Universum.stimes } +- warn: { name: "Use '(<>)' from Universum" + , lhs: Data.Semigroup.(<>), rhs: Universum.(<>) } +- warn: { name: "Use 'WrappedMonoid' from Universum" + , lhs: Data.Semigroup.WrappedMonoid, rhs: Universum.WrappedMonoid } +- warn: { name: "Use 'cycle1' from Universum" + , lhs: Data.Semigroup.cycle1, rhs: Universum.cycle1 } +- warn: { name: "Use 'mtimesDefault' from Universum" + , lhs: Data.Semigroup.mtimesDefault, rhs: Universum.mtimesDefault } +- warn: { name: "Use 'stimesIdempotent' from Universum" + , lhs: Data.Semigroup.stimesIdempotent, rhs: Universum.stimesIdempotent } +- warn: { name: "Use 'stimesIdempotentMonoid' from Universum" + , lhs: Data.Semigroup.stimesIdempotentMonoid, rhs: Universum.stimesIdempotentMonoid } +- warn: { name: "Use 'stimesMonoid' from Universum" + , lhs: Data.Semigroup.stimesMonoid, rhs: Universum.stimesMonoid } + +## String +- warn: { name: "Use 'ByteString' from Universum" + , lhs: Data.ByteString.ByteString, rhs: Universum.ByteString } +- warn: { name: "Use 'IsString' from Universum" + , lhs: Data.String.IsString, rhs: Universum.IsString } + +- warn: { name: "Use 'Text' from Universum" + , lhs: Data.Text.Text, rhs: Universum.Text } +- warn: { name: "Use 'lines' from Universum" + , lhs: Data.Text.lines, rhs: Universum.lines } +- warn: { name: "Use 'unlines' from Universum" + , lhs: Data.Text.unlines, rhs: Universum.unlines } +- warn: { name: "Use 'words' from Universum" + , lhs: Data.Text.words, rhs: Universum.words } +- warn: { name: "Use 'unwords' from Universum" + , lhs: Data.Text.unwords, rhs: Universum.unwords } + +- warn: { name: "Use 'LText' from Universum" + , lhs: Data.Text.Lazy.Text, rhs: Universum.LText } +- warn: { name: "Use 'LByteString' from Universum" + , lhs: Data.ByteString.Lazy.LByteString, rhs: Universum.LByteString } + +- warn: { name: "Use 'Buildable' from Universum" + , lhs: Data.Text.Buildable, rhs: Universum.Buildable } +- warn: { name: "Use 'decodeUtf8'' from Universum" + , lhs: "Data.Text.Encoding.decodeUtf8'", rhs: "Universum.decodeUtf8'" } +- warn: { name: "Use 'decodeUtf8With' from Universum" + , lhs: Data.Text.Encoding.decodeUtf8With, rhs: Universum.decodeUtf8With } + +- warn: { name: "Use 'OnDecodeError' from Universum" + , lhs: Data.Text.Encoding.Error.OnDecodeError, rhs: Universum.OnDecodeError } +- warn: { name: "Use 'OnDecodeError' from Universum" + , lhs: Data.Text.Encoding.Error.OnDecodeError, rhs: Universum.OnDecodeError } +- warn: { name: "Use 'OnError' from Universum" + , lhs: Data.Text.Encoding.Error.OnError, rhs: Universum.OnError } +- warn: { name: "Use 'UnicodeException' from Universum" + , lhs: Data.Text.Encoding.Error.UnicodeException, rhs: Universum.UnicodeException } +- warn: { name: "Use 'lenientDecode' from Universum" + , lhs: Data.Text.Encoding.Error.lenientDecode, rhs: Universum.lenientDecode } +- warn: { name: "Use 'strictDecode' from Universum" + , lhs: Data.Text.Encoding.Error.strictDecode, rhs: Universum.strictDecode } + +- warn: { name: "Use 'fromStrict' from Universum" + , lhs: Data.Text.Lazy.fromStrict, rhs: Universum.fromStrict } +- warn: { name: "Use 'toStrict' from Universum" + , lhs: Data.Text.Lazy.toStrict, rhs: Universum.toStrict } + +- warn: { name: "Use 'readMaybe' from Universum" + , lhs: Text.Read.readMaybe, rhs: Universum.readMaybe } + +- warn: { name: "Use 'getLine' from Universum" + , lhs: Data.Text.IO.getLine, rhs: Universum.getLine } +- warn: { name: "Use 'readFile' from Universum" + , lhs: Data.Text.IO.readFile, rhs: Universum.readFile } +- warn: { name: "Use 'writeFile' from Universum" + , lhs: Data.Text.IO.writeFile, rhs: Universum.writeFile } +- warn: { name: "Use 'appendFile' from Universum" + , lhs: Data.Text.IO.appendFile, rhs: Universum.appendFile } + +## Unsafe +- warn: { name: "Use 'head' from Universum.Unsafe" + , lhs: Data.List.head, rhs: Universum.Unsafe.head + , note: "Use 'import qualified Universum.Unsafe as Unsafe (head)'" } +- warn: { name: "Use 'tail' from Universum.Unsafe" + , lhs: Data.List.tail, rhs: Universum.Unsafe.tail + , note: "Use 'import qualified Universum.Unsafe as Unsafe (tail)'" } +- warn: { name: "Use 'init' from Universum.Unsafe" + , lhs: Data.List.init, rhs: Universum.Unsafe.init + , note: "Use 'import qualified Universum.Unsafe as Unsafe (init)'" } +- warn: { name: "Use 'last' from Universum.Unsafe" + , lhs: Data.List.last, rhs: Universum.Unsafe.last + , note: "Use 'import qualified Universum.Unsafe as Unsafe (last)'" } +- warn: { name: "Use '(!!)' from Universum.Unsafe" + , lhs: "Data.List.(!!)", rhs: "Universum.Unsafe.(!!)" + , note: "Use 'import qualified Universum.Unsafe as Unsafe ((!!))'" } +- warn: { name: "Use 'fromJust' from Universum.Unsafe" + , lhs: "Data.Maybe.fromJust", rhs: "Universum.Unsafe.fromJust" + , note: "Use 'import qualified Universum.Unsafe as Unsafe (fromJust)'" } + +############################################################################ +## Lifted functions in Universum +############################################################################ + +## concurrency + +- warn: { name: "liftIO is not needed", lhs: liftIO newEmptyMVar, rhs: Universum.newEmptyMVar + , note: "If you import 'newEmptyMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (newMVar x), rhs: Universum.newMVar x + , note: "If you import 'newMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (putMVar x y), rhs: Universum.putMVar x y + , note: "If you import 'putMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (readMVar x), rhs: Universum.readMVar x + , note: "If you import 'readMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (swapMVar x y), rhs: Universum.swapMVar x y + , note: "If you import 'swapMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (takeMVar x), rhs: Universum.takeMVar x + , note: "If you import 'takeMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (tryPutMVar x y), rhs: Universum.tryPutMVar x y + , note: "If you import 'tryPutMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (tryReadMVar x), rhs: Universum.tryReadMVar x + , note: "If you import 'tryReadMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (tryTakeMVar x), rhs: Universum.tryTakeMVar x + , note: "If you import 'tryTakeMVar' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (atomically x), rhs: Universum.atomically x + , note: "If you import 'atomically' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (newTVarIO x), rhs: Universum.newTVarIO x + , note: "If you import 'newTVarIO' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (readTVarIO x), rhs: Universum.readTVarIO x + , note: "If you import 'readTVarIO' from Universum, it's already lifted" } + +## IORef + +- warn: { name: "liftIO is not needed", lhs: liftIO (newIORef x), rhs: Universum.newIORef x + , note: "If you import 'newIORef' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (readIORef x), rhs: Universum.readIORef x + , note: "If you import 'readIORef' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (writeIORef x y), rhs: Universum.writeIORef x y + , note: "If you import 'writeIORef' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (modifyIORef x y), rhs: Universum.modifyIORef x y + , note: "If you import 'modifyIORef' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: "liftIO (modifyIORef' x y)", rhs: "Universum.modifyIORef' x y" + , note: "If you import 'modifyIORef'' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (atomicModifyIORef x y), rhs: Universum.atomicModifyIORef x y + , note: "If you import 'atomicModifyIORef' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: "liftIO (atomicModifyIORef' x y)", rhs: "Universum.atomicModifyIORef' x y" + , note: "If you import 'atomicModifyIORef'' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (atomicWriteIORef x y), rhs: Universum.atomicWriteIORef x y + , note: "If you import 'atomicWriteIORef' from Universum, it's already lifted" } + +## others + +- warn: { name: "liftIO is not needed", lhs: liftIO Universum.getLine, rhs: Universum.getLine + , note: "If you import 'getLine' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (Universum.readFile x), rhs: Universum.readFile x + , note: "If you import 'readFile' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (Universum.writeFile x y), rhs: Universum.writeFile x y + , note: "If you import 'writeFile' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (Universum.appendFile x y), rhs: Universum.appendFile x y + , note: "If you import 'appendFile' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (Universum.openFile x y), rhs: Universum.openFile x y + , note: "If you import 'openFile' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (exitWith x), rhs: Universum.exitWith x + , note: "If you import 'exitWith' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO exitFailure, rhs: Universum.exitFailure + , note: "If you import 'exitFailure' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO exitSuccess, rhs: Universum.exitSuccess + , note: "If you import 'exitSuccess' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (die x), rhs: Universum.die x + , note: "If you import 'die' from Universum, it's already lifted" } +- warn: { name: "liftIO is not needed", lhs: liftIO (stToIO x), rhs: Universum.stToIO x + , note: "If you import 'stToIO' from Universum, it's already lifted" } diff --git a/config.toml b/config.toml index 94e189c..ff3ef8e 100644 --- a/config.toml +++ b/config.toml @@ -1,6 +1,7 @@ port = 8080 +verbose = true tmpdir = "/tmp" entrypoint = "main.json" diff --git a/package.yaml b/package.yaml index 4392187..652cb37 100644 --- a/package.yaml +++ b/package.yaml @@ -53,14 +53,19 @@ executables: walint-server: main: Main.hs source-dirs: 'server' + default-extensions: + - NoImplicitPrelude dependencies: - walint + - universum + - containers - base-compat - time - directory - filepath - warp - wai + - wai-extra - servant - servant-server - lucid @@ -70,8 +75,6 @@ executables: - cli-extras - extra - uuid - - containers - - microlens - microlens-th - tomland - dotgen diff --git a/server/Handlers.hs b/server/Handlers.hs index ce1eb9b..e590cb7 100644 --- a/server/Handlers.hs +++ b/server/Handlers.hs @@ -1,50 +1,45 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} module Handlers (App, submitImpl,statusImpl,relintImpl,adminOverviewImpl) where -import Bindings.Cli.Git (gitProc) -import CheckDir (recursiveCheckDir) -import Cli.Extras (CliConfig, CliT, ProcessFailure, - Severity (..), callProcessAndLogOutput, - getCliConfig, prettyProcessFailure, - putLog, runCli) -import Control.Concurrent (MVar, ThreadId, forkIO, readMVar, - withMVar) -import Control.Monad.Extra (ifM) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans (lift) -import qualified Data.Map as M -import qualified Data.Text as T -import Data.UUID (UUID) -import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as UUID -import Lens.Micro.Extras (view) -import Servant (Handler, NoContent (NoContent), err404, - err500, throwError) -import Server (AdminOverview (AdminOverview), - Config (entrypoint, lintconfig, tmpdir), - JobStatus (..), - RemoteRef (reporef, repourl), State, - jobs, registry, setJobStatus, - setRegistry) -import System.Directory (doesDirectoryExist) -import System.FilePath (()) +import Universum + +import Bindings.Cli.Git (gitProc) +import CheckDir (recursiveCheckDir) +import Cli.Extras (CliConfig, CliT, ProcessFailure, + Severity (..), + callProcessAndLogOutput, getCliConfig, + prettyProcessFailure, runCli) +import Control.Concurrent (ThreadId, forkIO) +import Control.Concurrent.MVar (withMVar) +import qualified Data.Map as M +import qualified Data.Text as T +import Data.UUID (UUID) +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import Servant (Handler, NoContent (NoContent), + err404, err500, throwError) +import Server (AdminOverview (AdminOverview), + Config (entrypoint, lintconfig, tmpdir), + JobStatus (..), + RemoteRef (reporef, repourl), + ServerState, jobs, registry, + setJobStatus, setRegistry) +import System.Directory (doesDirectoryExist) +import System.FilePath (()) -- | this servant app can run cli programs! type App = CliT ProcessFailure Handler -- | annoying (and afaik unused), but has to be here for type system reasons instance MonadFail Handler where - fail _ = throwError $ err500 + fail _ = throwError err500 -- | someone submitted a map; lint it (synchronously for now) -submitImpl :: Config True -> MVar State -> RemoteRef -> App UUID +submitImpl :: Config True -> MVar ServerState -> RemoteRef -> App UUID submitImpl config state ref = do jobid <- liftIO UUID.nextRandom -- TODO: these two should really be atomic @@ -56,7 +51,7 @@ submitImpl config state ref = do -- the submission itself can't really fail or return anything useful pure jobid -relintImpl :: Config True -> MVar State -> UUID -> App NoContent +relintImpl :: Config True -> MVar ServerState -> UUID -> App NoContent relintImpl config state uuid = do mref <- liftIO $ withMVar state (pure . M.lookup uuid . view registry) case mref of @@ -66,7 +61,7 @@ relintImpl config state uuid = do _ <- checkRef config cliconfig state ref pure NoContent -statusImpl :: MVar State -> UUID -> App JobStatus +statusImpl :: MVar ServerState -> UUID -> App JobStatus statusImpl state uuid = do status <- liftIO $ withMVar state $ \state -> case M.lookup uuid (view registry state) of @@ -77,28 +72,28 @@ statusImpl state uuid = do Nothing -> lift $ throwError err404 -adminOverviewImpl :: MVar State -> App AdminOverview +adminOverviewImpl :: MVar ServerState -> App AdminOverview adminOverviewImpl state = do - state <- liftIO $ readMVar state + state <- readMVar state pure (AdminOverview state) -- | the actual check function. forks, calls out to git to update the -- repository, create a new worktree, lints it, then tells git to -- delete that tree again -checkRef :: Config True -> CliConfig -> MVar State -> RemoteRef -> App ThreadId +checkRef :: Config True -> CliConfig -> MVar ServerState -> RemoteRef -> App ThreadId checkRef config cliconfig state ref = liftIO $ forkIO $ do res <- liftIO $ runCli cliconfig $ do ifM (liftIO $ doesDirectoryExist gitdir) -- TODO: these calls fail for dumb http, add some fallback! (callgit gitdir - [ "fetch", "origin", T.unpack (reporef ref), "--depth", "1" ]) + [ "fetch", "origin", toString (reporef ref), "--depth", "1" ]) (callgit gitdir - [ "clone", T.unpack $ repourl ref, "--bare" - , "--depth", "1", "-b", T.unpack (reporef ref)]) + [ "clone", toString $ repourl ref, "--bare" + , "--depth", "1", "-b", toString (reporef ref)]) rand <- liftIO UUID.nextRandom let workdir = "/tmp" ("worktree-" <> UUID.toString rand) callgit gitdir [ "worktree", "add", workdir ] - callgit workdir [ "checkout", T.unpack (reporef ref) ] + callgit workdir [ "checkout", toString (reporef ref) ] res <- liftIO $ recursiveCheckDir (lintconfig config) workdir (entrypoint config) callgit gitdir [ "worktree", "remove", "-f", "-f", workdir ] pure res @@ -107,7 +102,7 @@ checkRef config cliconfig state ref = liftIO $ forkIO $ do Left err -> Failed (prettyProcessFailure err) where callgit dir = callProcessAndLogOutput (Debug, Debug) . gitProc dir - gitdir = tmpdir config hashedname - hashedname = fmap escapeSlash . T.unpack . repourl $ ref + gitdir = tmpdir config toString hashedname + hashedname = T.map escapeSlash . repourl $ ref escapeSlash = \case { '/' -> '-'; a -> a } diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs index bb4932d..4d03234 100644 --- a/server/HtmlOrphans.hs +++ b/server/HtmlOrphans.hs @@ -12,29 +12,23 @@ -- linter results as html module HtmlOrphans () where - -import CheckDir (DirResult (..), MissingAsset (MissingAsset), - MissingDep (..), maximumLintLevel) -import CheckMap (MapResult (..)) -import Control.Monad (forM_, unless) -import Data.Functor ((<&>)) -import Data.List (intersperse) -import Data.List.Extra (escapeJSON) -import qualified Data.Map as M -import Data.Text (Text) -import qualified Data.Text as T -import Lens.Micro.Extras (view) -import Lucid (HtmlT, ToHtml) -import Lucid.Base (ToHtml (toHtml)) -import Lucid.Html5 (a_, body_, class_, code_, div_, em_, h1_, - h2_, h3_, h4_, h5_, head_, href_, html_, - id_, li_, link_, main_, p_, rel_, script_, - span_, src_, title_, type_, ul_) -import Server (AdminOverview (..), JobStatus (..), - RemoteRef (reporef, repourl), jobs, - registry) -import Text.Dot (showDot) -import Types (Hint (Hint), Level (..)) +import Universum + +import CheckDir (DirResult (..), MissingAsset (MissingAsset), + MissingDep (..), maximumLintLevel) +import CheckMap (MapResult (..)) +import Data.List.Extra (escapeJSON) +import qualified Data.Map as M +import Lucid (HtmlT, ToHtml) +import Lucid.Base (ToHtml (toHtml)) +import Lucid.Html5 (a_, body_, class_, code_, div_, em_, h1_, h2_, + h3_, h4_, h5_, head_, href_, html_, id_, li_, + link_, main_, p_, rel_, script_, span_, src_, + title_, type_, ul_) +import Server (AdminOverview (..), JobStatus (..), + RemoteRef (reporef, repourl), jobs, registry) +import Text.Dot (showDot) +import Types (Hint (Hint), Level (..)) mono :: Monad m => HtmlT m () -> HtmlT m () @@ -74,7 +68,7 @@ instance ToHtml AdminOverview where Just (Linted res) -> toHtml $ maximumLintLevel res Just (Failed _) -> badge Error "system error" Nothing -> toHtml Fatal - " "; a_ [href_ (T.pack $ "/status/"<>show uuid)] $ do + " "; a_ [href_ ("/status/"<>show uuid)] $ do mono $ toHtml $ reporef ref; " on "; mono $ toHtml $ repourl ref @@ -90,7 +84,7 @@ badge level = span_ [class_ badgetype] -- | Lint Levels directly render into badges instance ToHtml Level where - toHtml level = badge level (toHtml $ show level) + toHtml level = badge level (toHtml (show level :: Text)) -- | Hints are just text with a level instance ToHtml Hint where @@ -142,7 +136,7 @@ instance ToHtml DirResult where "\ \d3.select(\"#exitGraph\")\n\ \ .graphviz()\n\ - \ .dot(\"" <> T.pack (escapeJSON $ showDot dirresultGraph) <> "\")\n\ + \ .dot(\"" <> toText (escapeJSON $ showDot dirresultGraph) <> "\")\n\ \ .render()\n\ \" diff --git a/server/Main.hs b/server/Main.hs index fa7d2bd..fd66ad3 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -1,6 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -11,35 +9,40 @@ -- | simple server offering linting "as a service" module Main where -import Cli.Extras (CliConfig, Severity (..), - mkDefaultCliConfig, putLog, runCli) -import Control.Concurrent (MVar, newMVar) -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import qualified Data.ByteString.Lazy.Char8 as C8 -import Data.List (intersperse) -import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) -import Data.UUID (UUID) -import Handlers (App, adminOverviewImpl, relintImpl, - statusImpl, submitImpl) -import HtmlOrphans () -import Network.HTTP.Types.Status (Status (..)) -import Network.Wai (Request, pathInfo, requestMethod) -import Network.Wai.Handler.Warp (defaultSettings, runSettings, - setLogger, setPort) -import Servant (Application, Capture, Get, Handler, - HasServer (ServerT), JSON, - NoContent, Post, Proxy (Proxy), - Raw, ReqBody, - ServerError (errBody), err500, - hoistServer, serve, throwError, - type (:<|>) (..), type (:>)) -import Servant.HTML.Lucid (HTML) -import Servant.Server.StaticFiles (serveDirectoryWebApp) -import Server (AdminOverview, Config (..), - JobStatus, RemoteRef (..), State, - defaultState, loadConfig) +import Universum + +import Cli.Extras (CliConfig, + mkDefaultCliConfig, + runCli) +import qualified Data.ByteString.Lazy.Char8 as C8 +import Data.UUID (UUID) +import Handlers (App, adminOverviewImpl, + relintImpl, statusImpl, + submitImpl) +import HtmlOrphans () +import Network.Wai.Handler.Warp (defaultSettings, + runSettings, setPort) +import Network.Wai.Middleware.Gzip (def) +import Network.Wai.Middleware.RequestLogger (OutputFormat (..), + RequestLoggerSettings (..), + mkRequestLogger) +import Servant (Application, Capture, + Get, Handler, + HasServer (ServerT), + JSON, NoContent, Post, + Raw, ReqBody, + ServerError (errBody), + err500, hoistServer, + serve, throwError, + type (:<|>) (..), + type (:>)) +import Servant.HTML.Lucid (HTML) +import Servant.Server.StaticFiles (serveDirectoryWebApp) +import Server (AdminOverview, + Config (..), JobStatus, + RemoteRef (..), + ServerState, + defaultState, loadConfig) -- | Main API type @@ -56,14 +59,14 @@ type Routes = :<|> Raw -- | API's implementation -jsonAPI :: Config True -> MVar State -> ServerT (API JSON) App +jsonAPI :: Config True -> MVar ServerState -> ServerT (API JSON) App jsonAPI config state = submitImpl config state :<|> statusImpl state :<|> relintImpl config state :<|> adminOverviewImpl state -server :: Config True -> MVar State -> ServerT Routes App +server :: Config True -> MVar ServerState -> ServerT Routes App server config state = jsonAPI config state :<|> statusImpl state @@ -71,7 +74,7 @@ server config state = :<|> serveDirectoryWebApp "./static" -- | make an application; convert any cli errors into a 500 -app :: CliConfig -> Config True -> MVar State -> Application +app :: CliConfig -> Config True -> MVar ServerState -> Application app cliconfig config = serve api . hoistServer api conv . server config where api = Proxy @Routes @@ -82,26 +85,21 @@ app cliconfig config = Right a -> pure a Left err -> throwError (err500 { errBody = C8.pack (show err) }) + main :: IO () main = do - cliconfig <- liftIO $ mkDefaultCliConfig ["-v"] config <- loadConfig "./config.toml" state <- newMVar defaultState - let warpsettings = - setPort (port config) - . setLogger (logRequest cliconfig) - $ defaultSettings + -- TODO: i really don't like all this cli logging stuff, replace it with + -- fast-logger at some point … + cliconfig <- liftIO $ mkDefaultCliConfig ["-v" | verbose config] + loggerMiddleware <- mkRequestLogger + $ def { outputFormat = Detailed (verbose config) } - runSettings warpsettings (app cliconfig config state) + let warpsettings = + setPort (port config) + defaultSettings --- TODO: at some point i should learn how to do these things properly, but --- for now this works well enough i guess -logRequest :: CliConfig -> Request -> Status -> Maybe Integer -> IO () -logRequest cliconfig req status _size = void . runCli cliconfig $ - putLog Notice - $ "request: " - <> decodeUtf8 (requestMethod req) <> " " - <> parts <> " " - <> T.pack (show (statusCode status)) <> " " - <> decodeUtf8 (statusMessage status) - where parts = T.concat $ intersperse "/" (pathInfo req) + runSettings warpsettings + . loggerMiddleware + $ app cliconfig config state diff --git a/server/Server.hs b/server/Server.hs index d7205bc..8014053 100644 --- a/server/Server.hs +++ b/server/Server.hs @@ -5,7 +5,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} @@ -13,25 +12,28 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -module Server (loadConfig, Config(..), RemoteRef(..), State, registry, jobs, JobStatus(..), - setJobStatus,defaultState,setRegistry, AdminOverview(..)) where +module Server ( loadConfig + , Config(..) + , RemoteRef(..) + , ServerState, registry, jobs, defaultState + , JobStatus(..) + , setJobStatus + , setRegistry + , AdminOverview(..) + ) where + +import Universum import CheckDir (DirResult) -import Control.Concurrent (MVar, modifyMVar_) +import Control.Concurrent (modifyMVar_) import Data.Aeson (FromJSON, ToJSON (toJSON), eitherDecode, (.=)) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as LB -import Data.Map (Map) import qualified Data.Map as M -import Data.Text (Text) import Data.UUID (UUID) -import GHC.Generics (Generic) -import Lens.Micro (over) -import Lens.Micro.Extras (view) import Lens.Micro.TH import LintConfig (LintConfig') -import System.Exit.Compat (exitFailure) import Toml (TomlCodec) import qualified Toml as T @@ -50,6 +52,7 @@ data Config (loaded :: Bool) = Config { tmpdir :: FilePath -- ^ dir to clone git things in , port :: Int + , verbose :: Bool -- ^ port to bind to , entrypoint :: FilePath , lintconfig :: ConfigRes loaded LintConfig' @@ -59,6 +62,7 @@ configCodec :: TomlCodec (Config False) configCodec = Config <$> T.string "tmpdir" T..= tmpdir <*> T.int "port" T..= port + <*> T.bool "verbose" T..= verbose <*> T.string "entrypoint" T..= entrypoint <*> T.string "lintconfig" T..= lintconfig @@ -68,17 +72,17 @@ data JobStatus = deriving (Generic, ToJSON) -- | the server's global state -data State = State +data ServerState = ServerState { _jobs :: Map RemoteRef JobStatus , _registry :: Map UUID RemoteRef } -makeLenses ''State +makeLenses ''ServerState -defaultState :: State -defaultState = State mempty mempty +defaultState :: ServerState +defaultState = ServerState mempty mempty newtype AdminOverview = - AdminOverview { unAdminOverview :: State } + AdminOverview { unAdminOverview :: ServerState } instance ToJSON AdminOverview where toJSON (AdminOverview state) = @@ -103,15 +107,15 @@ loadConfig' :: Config False -> IO (Config True) loadConfig' config = do loaded <- LB.readFile (lintconfig config) >>= \res -> case eitherDecode res :: Either String LintConfig' of - Left err -> error $ "config file invalid: " <> err + Left err -> error $ "config file invalid: " <> show err Right file -> pure file pure $ config { lintconfig = loaded } -setJobStatus :: MVar State -> RemoteRef -> JobStatus -> IO () +setJobStatus :: MVar ServerState -> RemoteRef -> JobStatus -> IO () setJobStatus mvar !ref !status = modifyMVar_ mvar $ pure . over jobs (M.insert ref status) -setRegistry :: MVar State -> UUID -> RemoteRef -> IO () +setRegistry :: MVar ServerState -> UUID -> RemoteRef -> IO () setRegistry mvar !uuid !ref = modifyMVar_ mvar $ pure . over registry (M.insert uuid ref) diff --git a/stack.yaml b/stack.yaml index fb24c06..dacc540 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-18.16 +resolver: lts-18.25 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/stack.yaml.lock b/stack.yaml.lock index 9f568e8..05aa1bc 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -83,7 +83,7 @@ packages: hackage: servant-lucid-0.9.0.4@sha256:698db96903a145fdef40cc897f8790728642af917c37b941a98b2da872b65f08,1787 snapshots: - completed: - size: 586286 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml - sha256: cdead65fca0323144b346c94286186f4969bf85594d649c49c7557295675d8a5 - original: lts-18.16 + size: 587393 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/25.yaml + sha256: 1b74fb5e970497b5aefae56703f1bd44aa648bd1a5ef95c1eb8c29775087e2bf + original: lts-18.25 diff --git a/walint.cabal b/walint.cabal index 1165a37..5b82fec 100644 --- a/walint.cabal +++ b/walint.cabal @@ -87,6 +87,8 @@ executable walint-server Paths_walint hs-source-dirs: server + default-extensions: + NoImplicitPrelude ghc-options: -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors build-depends: aeson @@ -102,7 +104,6 @@ executable walint-server , filepath , http-types , lucid - , microlens , microlens-th , mtl , servant @@ -111,8 +112,10 @@ executable walint-server , text , time , tomland + , universum , uuid , wai + , wai-extra , walint , warp default-language: Haskell2010 -- cgit v1.2.3