1 files changed, 0 insertions, 180 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs
deleted file mode 100644
index 13251d8afdf2..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs
+++ /dev/null
@@ -1,180 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.Levels
-  ( Levels
-  , allLevels
-  , numLevels
-  , nextLevel
-  , prevLevel
-  , mkLevels1
-  , mkLevels
-  , oneLevel
-  , current
-  , ComonadStore(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((<.>), Empty, foldMap)
-import           Xanthous.Util (between, EqProp, EqEqProp(..))
-import           Xanthous.Util.Comonad (current)
-import           Xanthous.Orphans ()
---------------------------------------------------------------------------------
-import           Control.Comonad.Store
-import           Control.Comonad.Store.Zipper
-import           Data.Aeson (ToJSON(..), FromJSON(..))
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Functor.Apply
-import           Data.Foldable (foldMap)
-import           Data.List.NonEmpty (NonEmpty)
-import qualified Data.List.NonEmpty as NE
-import           Data.Maybe (fromJust)
-import           Data.Sequence (Seq((:<|), Empty))
-import           Data.Semigroup.Foldable.Class
-import           Data.Text (replace)
-import           Test.QuickCheck
---------------------------------------------------------------------------------
-
--- | Collection of levels plus a pointer to the current level
---
--- Navigation is via the 'Comonad' instance. We can get the current level with
--- 'extract':
---
---     extract @Levels :: Levels level -> level
---
--- For access to and modification of the level, use
--- 'Xanthous.Util.Comonad.current'
-newtype Levels a = Levels { levelZipper :: Zipper Seq a }
-    deriving stock (Generic)
-    deriving (Functor, Comonad, Foldable) via (Zipper Seq)
-
-type instance Element (Levels a) = a
-instance MonoFoldable (Levels a)
-instance MonoFunctor (Levels a)
-instance MonoTraversable (Levels a)
-
-instance ComonadStore Word Levels where
-  pos = toEnum . pos . levelZipper
-  peek i = peek (fromEnum i) . levelZipper
-
-instance Traversable Levels where
-  traverse f (Levels z) = Levels <$> traverse f z
-
-instance Foldable1 Levels
-
-instance Traversable1 Levels where
-  traverse1 f levs@(Levels z) = seek (pos levs) . partialMkLevels <$> go (unzipper z)
-    where
-      go Empty = error "empty seq, unreachable"
-      go (x :<| xs) = (<|) <$> f x <.> go xs
-
--- | Always takes the position of the latter element
-instance Semigroup (Levels a) where
-  levs₁ <> levs₂
-    = seek (pos levs₂)
-    . partialMkLevels
-    $ allLevels levs₁ <> allLevels levs₂
-
--- | The number of levels stored in 'Levels'
---
--- Equivalent to 'Data.Foldable.length', but likely faster
-numLevels :: Levels a -> Word
-numLevels = toEnum . size . levelZipper
-
--- | Make Levels from a Seq. Throws an error if the seq is not empty
-partialMkLevels :: Seq a -> Levels a
-partialMkLevels = Levels . fromJust . zipper
-
--- | Make Levels from a possibly-empty structure
-mkLevels :: Foldable1 f => f level -> Maybe (Levels level)
-mkLevels = fmap Levels . zipper . foldMap pure
-
--- | Make Levels from a non-empty structure
-mkLevels1 :: Foldable1 f => f level -> Levels level
-mkLevels1 = fromJust . mkLevels
-
-oneLevel :: a -> Levels a
-oneLevel = mkLevels1 . Identity
-
--- | Get a sequence of all the levels
-allLevels :: Levels a -> Seq a
-allLevels = unzipper . levelZipper
-
--- | Step to the next level, generating a new level if necessary using the given
--- applicative action
-nextLevel
-  :: Applicative m
-  => m level -- ^ Generate a new level, if necessary
-  -> Levels level
-  -> m (Levels level)
-nextLevel genLevel levs
-  | succ (pos levs) < numLevels levs
-  = pure $ seeks succ levs
-  | otherwise
-  = genLevel <&> \level ->
-      seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level
-
--- | Go to the previous level. Returns Nothing if 'pos' is 0
-prevLevel :: Levels level -> Maybe (Levels level)
-prevLevel levs | pos levs == 0 = Nothing
-               | otherwise = Just $ seeks pred levs
-
---------------------------------------------------------------------------------
-
--- | alternate, slower representation of Levels we can Iso into to perform
--- various operations
-data AltLevels a = AltLevels
-  { _levels :: NonEmpty a
-  , _currentLevel :: Word -- ^ invariant: is within the bounds of _levels
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           (AltLevels a)
-makeLenses ''AltLevels
-
-alt :: Iso (Levels a) (Levels b) (AltLevels a) (AltLevels b)
-alt = iso hither yon
-  where
-    hither levs = AltLevels (NE.fromList . toList $ allLevels levs) (pos levs)
-    yon (AltLevels levs curr) = seek curr $ mkLevels1 levs
-
-instance Eq a => Eq (Levels a) where
-  (==) = (==) `on` view alt
-
-deriving via EqEqProp (Levels a) instance Eq a => EqProp (Levels a)
-
-instance Show a => Show (Levels a) where
-  show = unpack . replace "AltLevels" "Levels" . pack . show . view alt
-
-instance NFData a => NFData (Levels a) where
-  rnf = rnf . view alt
-
-instance ToJSON a => ToJSON (Levels a) where
-  toJSON = toJSON . view alt
-
-instance FromJSON a => FromJSON (Levels a) where
-  parseJSON = fmap (review alt) . parseJSON
-
-instance Arbitrary a => Arbitrary (AltLevels a) where
-  arbitrary = do
-    _levels <- arbitrary
-    _currentLevel <- choose (0, pred . toEnum . length $ _levels)
-    pure AltLevels {..}
-  shrink als = do
-    _levels <- shrink $ als ^. levels
-    _currentLevel <- filter (between 0 $ pred . toEnum . length $ _levels)
-                    $ shrink $ als ^. currentLevel
-    pure AltLevels {..}
-
-
-instance Arbitrary a => Arbitrary (Levels a) where
-  arbitrary = review alt <$> arbitrary
-  shrink = fmap (review alt) . shrink . view alt
-
-instance CoArbitrary a => CoArbitrary (Levels a) where
-  coarbitrary = coarbitrary . view alt
-
-instance Function a => Function (Levels a) where
-  function = functionMap (view alt) (review alt)