chore(users): grfn -> aspen r/7511

Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>

7 files changed, 0 insertions, 320 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs b/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs
deleted file mode 100644
index 9e158cc8e2d4..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs
+++ /dev/null
@@ -1,24 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.Comonad
-  ( -- * Store comonad utils
-    replace
-  , current
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Control.Comonad.Store.Class
---------------------------------------------------------------------------------
-
--- | Replace the current position of a store comonad with a new value by
--- comparing positions
-replace :: (Eq i, ComonadStore i w) => w a -> a -> w a
-replace w x = w =>> \w' -> if pos w' == pos w then x else extract w'
-{-# INLINE replace #-}
-
--- | Lens into the current position of a store comonad.
---
---     current = lens extract replace
-current :: (Eq i, ComonadStore i w) => Lens' (w a) a
-current = lens extract replace
-{-# INLINE current #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Graph.hs b/users/grfn/xanthous/src/Xanthous/Util/Graph.hs
deleted file mode 100644
index 8e5c04f4bfa9..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Graph.hs
+++ /dev/null
@@ -1,33 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.Graph where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Graph.Inductive.Query.MST (msTree)
-import qualified Data.Graph.Inductive.Graph as Graph
-import           Data.Graph.Inductive.Graph
-import           Data.Graph.Inductive.Basic (undir)
-import           Data.Set (isSubsetOf)
---------------------------------------------------------------------------------
-
-mstSubGraph
-  :: forall gr node edge. (DynGraph gr, Real edge, Show edge)
-  => gr node edge -> gr node edge
-mstSubGraph graph = insEdges mstEdges . insNodes (labNodes graph) $ Graph.empty
-  where
-    mstEdges = ordNub $ do
-      LP path <- msTree $ undir graph
-      case path of
-        [] -> []
-        [_] -> []
-        ((n₂, edgeWeight) : (n₁, _) : _) ->
-          pure (n₁, n₂, edgeWeight)
-
-isSubGraphOf
-  :: (Graph gr1, Graph gr2, Ord node, Ord edge)
-  => gr1 node edge
-  -> gr2 node edge
-  -> Bool
-isSubGraphOf graph₁ graph₂
-  = setFromList (labNodes graph₁) `isSubsetOf` setFromList (labNodes graph₂)
-  && setFromList (labEdges graph₁) `isSubsetOf` setFromList (labEdges graph₂)
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs
deleted file mode 100644
index 0cb009f45ad0..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs
+++ /dev/null
@@ -1,177 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
--- | Graphics algorithms and utils for rendering things in 2D space
---------------------------------------------------------------------------------
-module Xanthous.Util.Graphics
-  ( circle
-  , filledCircle
-  , line
-  , straightLine
-  , delaunay
-
-    -- * Debugging and testing tools
-  , renderBooleanGraphics
-  , showBooleanGraphics
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
--- https://github.com/noinia/hgeometry/issues/28
--- import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer
---               as Geometry
-import qualified Algorithms.Geometry.DelaunayTriangulation.Naive
-              as Geometry
-import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry
-import           Control.Monad.State (execState, State)
-import qualified Data.Geometry.Point as Geometry
-import           Data.Ext ((:+)(..))
-import           Data.List (unfoldr)
-import           Data.List.NonEmpty (NonEmpty((:|)))
-import qualified Data.List.NonEmpty as NE
-import           Data.Ix (Ix)
-import           Linear.V2
---------------------------------------------------------------------------------
-
-
--- | Generate a circle centered at the given point and with the given radius
--- using the <midpoint circle algorithm
--- https://en.wikipedia.org/wiki/Midpoint_circle_algorithm>.
---
--- Code taken from <https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#Haskell>
-circle :: (Num i, Ord i)
-       => V2 i -- ^ center
-       -> i    -- ^ radius
-       -> [V2 i]
-circle (V2 x₀ y₀) radius
-  -- Four initial points, plus the generated points
-  = V2 x₀ (y₀ + radius)
-  : V2 x₀ (y₀ - radius)
-  : V2 (x₀ + radius) y₀
-  : V2 (x₀ - radius) y₀
-  : points
-    where
-      -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets.
-      points = concatMap generatePoints $ unfoldr step initialValues
-
-      generatePoints (V2 x y)
-        = [ V2 (x₀ `xop` x') (y₀ `yop` y')
-          | (x', y') <- [(x, y), (y, x)]
-          , xop <- [(+), (-)]
-          , yop <- [(+), (-)]
-          ]
-
-      initialValues = (1 - radius, 1, (-2) * radius, 0, radius)
-
-      step (f, ddf_x, ddf_y, x, y)
-        | x >= y = Nothing
-        | otherwise = Just (V2 x' y', (f', ddf_x', ddf_y', x', y'))
-        where
-          (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1)
-                           | otherwise = (f + ddf_x, ddf_y, y)
-          ddf_x' = ddf_x + 2
-          x' = x + 1
-
-
-data FillState i
-  = FillState
-  { _inCircle :: Bool
-  , _result :: NonEmpty (V2 i)
-  }
-makeLenses ''FillState
-
-runFillState :: NonEmpty (V2 i) -> State (FillState i) a -> [V2 i]
-runFillState circumference s
-  = toList
-  . view result
-  . execState s
-  $ FillState False circumference
-
--- | Generate a *filled* circle centered at the given point and with the given
--- radius by filling a circle generated with 'circle'
-filledCircle :: (Num i, Integral i, Ix i)
-             => V2 i -- ^ center
-             -> i    -- ^ radius
-             -> [V2 i]
-filledCircle center radius =
-  case NE.nonEmpty (circle center radius) of
-    Nothing -> []
-    Just circumference -> runFillState circumference $
-      -- the first and last lines of all circles are solid, so the whole "in the
-      -- circle, out of the circle" thing doesn't work... but that's fine since
-      -- we don't need to fill them. So just skip them
-      for_ [succ minX..pred maxX] $ \x ->
-        for_ [minY..maxY] $ \y -> do
-          let pt = V2 x y
-              next = V2 x $ succ y
-          whenM (use inCircle) $ result %= NE.cons pt
-
-          when (pt `elem` circumference && next `notElem` circumference)
-            $ inCircle %= not
-
-      where
-        (V2 minX minY, V2 maxX maxY) = minmaxes circumference
-
--- | Draw a line between two points using Bresenham's line drawing algorithm
---
--- Code taken from <https://wiki.haskell.org/Bresenham%27s_line_drawing_algorithm>
-line :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
-line pa@(V2 xa ya) pb@(V2 xb yb)
-  = (if maySwitch pa < maySwitch pb then id else reverse) points
-  where
-    points               = map maySwitch . unfoldr go $ (x₁, y₁, 0)
-    steep                = abs (yb - ya) > abs (xb - xa)
-    maySwitch            = if steep then view _yx else id
-    [V2 x₁ y₁, V2 x₂ y₂] = sort [maySwitch pa, maySwitch pb]
-    δx                   = x₂ - x₁
-    δy                   = abs (y₂ - y₁)
-    ystep                = if y₁ < y₂ then 1 else -1
-    go (xTemp, yTemp, err)
-      | xTemp > x₂ = Nothing
-      | otherwise  = Just (V2 xTemp yTemp, (xTemp + 1, newY, newError))
-      where
-        tempError        = err + δy
-        (newY, newError) = if (2 * tempError) >= δx
-                           then (yTemp + ystep, tempError - δx)
-                           else (yTemp, tempError)
-{-# SPECIALIZE line :: V2 Int -> V2 Int -> [V2 Int] #-}
-{-# SPECIALIZE line :: V2 Word -> V2 Word -> [V2 Word] #-}
-
-straightLine :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
-straightLine pa@(V2 xa _) pb@(V2 _ yb) = line pa midpoint ++ line midpoint pb
-  where midpoint = V2 xa yb
-
-delaunay
-  :: (Ord n, Fractional n)
-  => NonEmpty (V2 n, p)
-  -> [((V2 n, p), (V2 n, p))]
-delaunay
-  = map (over both fromPoint)
-  . Geometry.edgesAsPoints
-  . Geometry.delaunayTriangulation
-  . map toPoint
-  where
-    toPoint (V2 px py, pid) = Geometry.Point2 px py :+ pid
-    fromPoint (Geometry.Point2 px py :+ pid) = (V2 px py, pid)
-
---------------------------------------------------------------------------------
-
-renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> String
-renderBooleanGraphics [] = ""
-renderBooleanGraphics (pt : pts') = intercalate "\n" rows
-  where
-    rows = row <$> [minX..maxX]
-    row x = [minY..maxY] <&> \y -> if V2 x y `member` ptSet then 'X' else ' '
-    (V2 minX minY, V2 maxX maxY) = minmaxes pts
-    pts = pt :| pts'
-    ptSet :: Set (V2 i)
-    ptSet = setFromList $ toList pts
-
-showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> IO ()
-showBooleanGraphics = putStrLn . pack . renderBooleanGraphics
-
-minmaxes :: forall i. (Ord i) => NonEmpty (V2 i) -> (V2 i, V2 i)
-minmaxes xs =
-  ( V2 (minimum1Of (traverse1 . _x) xs)
-       (minimum1Of (traverse1 . _y) xs)
-  , V2 (maximum1Of (traverse1 . _x) xs)
-       (maximum1Of (traverse1 . _y) xs)
-  )
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs b/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs
deleted file mode 100644
index 724f2339dd21..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-
-module Xanthous.Util.Inflection
-  ( toSentence
-  ) where
-
-import Xanthous.Prelude
-
-toSentence :: (MonoFoldable mono, Element mono ~ Text) => mono -> Text
-toSentence xs = case reverse . toList $ xs of
-  [] -> ""
-  [x] -> x
-  [b, a] -> a <> " and " <> b
-  (final : butlast) ->
-    intercalate ", " (reverse butlast) <> ", and " <> final
diff --git a/users/grfn/xanthous/src/Xanthous/Util/JSON.hs b/users/grfn/xanthous/src/Xanthous/Util/JSON.hs
deleted file mode 100644
index 91d1328e4a10..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/JSON.hs
+++ /dev/null
@@ -1,19 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.JSON
-  ( ReadShowJSON(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Data.Aeson
---------------------------------------------------------------------------------
-
-newtype ReadShowJSON a = ReadShowJSON a
-  deriving newtype (Read, Show)
-
-instance Show a => ToJSON (ReadShowJSON a) where
-  toJSON = toJSON . show
-
-instance Read a => FromJSON (ReadShowJSON a) where
-  parseJSON = withText "readable"
-    $ maybe (fail "Could not read") pure . readMay
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs b/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs
deleted file mode 100644
index dfa65372351d..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs
+++ /dev/null
@@ -1,21 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.Optparse
-  ( readWithGuard
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import qualified Options.Applicative as Opt
---------------------------------------------------------------------------------
-
-readWithGuard
-  :: Read b
-  => (b -> Bool)
-  -> (b -> String)
-  -> Opt.ReadM b
-readWithGuard predicate errmsg = do
-  res <- Opt.auto
-  unless (predicate res)
-    $ Opt.readerError
-    $ errmsg res
-  pure res
diff --git a/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs b/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs
deleted file mode 100644
index aa881b322779..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-module Xanthous.Util.QuickCheck
-  ( functionShow
-  , FunctionShow(..)
-  , functionJSON
-  , FunctionJSON(..)
-  , genericArbitrary
-  , GenericArbitrary(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Test.QuickCheck
-import Test.QuickCheck.Function
-import Test.QuickCheck.Instances.ByteString ()
-import Test.QuickCheck.Arbitrary.Generic
-import Data.Aeson
---------------------------------------------------------------------------------
-
-newtype FunctionShow a = FunctionShow a
-  deriving newtype (Show, Read)
-
-instance (Show a, Read a) => Function (FunctionShow a) where
-  function = functionShow
-
-functionJSON :: (ToJSON a, FromJSON a) => (a -> c) -> a :-> c
-functionJSON = functionMap encode (headEx . decode)
-
-newtype FunctionJSON a = FunctionJSON a
-  deriving newtype (ToJSON, FromJSON)
-
-instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where
-  function = functionJSON