LensesOnRepresentables.hs

{-# LANGUAGE
      TupleSections
    , LambdaCase
    , DeriveFunctor
    , RankNTypes
    , TypeFamilies
    , OverloadedStrings
#-}

module Optics.LensesOnRepresentables where

import Relude
import Control.Lens hiding (universe)
import qualified Data.Functor.Rep as Rep
import Data.Distributive ( Distributive(distribute) )
import qualified Data.Stream as Str
import qualified Data.Map.Strict as Map
import qualified Text.Show
import qualified Data.Text as T

-------------------------------------------------------------------------------
-- Isomorphism from isomorphism
-------------------------------------------------------------------------------

transportIso ::
  ( Rep.Representable f, Rep.Rep f ~ r1
  , Rep.Representable g, Rep.Rep g ~ r2
  ) =>
  Iso' r1 r2 -> Iso (f a) (f b) (g a) (g b)
transportIso givenIso = iso fromFa toFa
  where
    fromFa fa = Rep.tabulate $ Rep.index fa . view (re givenIso)
    toFa ga = Rep.tabulate $ Rep.index ga . view givenIso

-------------------------------------------------------------------------------
-- Lens from prism
-------------------------------------------------------------------------------

homemadeLensFromPrism ::
  ( Rep.Representable f, Rep.Rep f ~ r1
  , Rep.Representable g, Rep.Rep g ~ r2
  ) =>
  Prism' r1 r2 -> Lens' (f a) (g a)
homemadeLensFromPrism restriction = lens getter setter
  where
    getter fa =
      Rep.tabulate $ Rep.index fa . review restriction
    setter fa ga =
      Rep.tabulate $ \r1 ->
        case preview restriction r1 of
          Nothing -> Rep.index fa r1
          Just r2 -> Rep.index ga r2

repIso :: (Rep.Representable f, Rep.Rep f ~ r) => Iso (f a) (f b) (r -> a) (r -> b)
repIso = iso Rep.index Rep.tabulate

mkLensFromPrism ::
  ( Rep.Representable f, Rep.Rep f ~ r1
  , Rep.Representable g, Rep.Rep g ~ r2
  ) =>
  Prism' r1 r2 -> Lens' (f a) (g a)
mkLensFromPrism pr = repIso . outside pr . from repIso

wrappedInIdentity ::
  ( Rep.Representable f, Rep.Rep f ~ r, Eq r
  ) =>
  r -> Lens' (f a) (Identity a)
wrappedInIdentity r =
  mkLensFromPrism $ only r

atPosition ::
  ( Rep.Representable f, Rep.Rep f ~ r, Eq r
  ) =>
  r -> Lens' (f a) a
atPosition r = wrappedInIdentity r . coerced

-- This is a lawful prism if `create` is injective
mkPrismFromInjection ::
  (Ord a, Enum b, Bounded b
  ) =>
  (b -> a) -> Prism' a b
mkPrismFromInjection create = prism' create mbRecover
  where
    mbRecover a =
      Map.lookup a $
        Map.fromList [(create b, b) | b <- universe ]

-- `positionMapping` should contain distinct positions for this to create a lawful lens
restrictByPositionMapping ::
  ( Rep.Representable f, Rep.Rep f ~ r1
  , Rep.Representable g, Rep.Rep g ~ r2
  , Ord r1, Enum r2, Bounded r2
  ) =>
  g r1 -> Lens' (f a) (g a)
restrictByPositionMapping positionMapping =
  mkLensFromPrism $ mkPrismFromInjection $ Rep.index positionMapping

-------------------------------------------------------------------------------
-- Examples

data Triple a = Triple
  { _slot0 :: a
  , _slot1 :: a
  , _slot2 :: a
  } deriving (Functor, Show)

instance Distributive Triple where
  distribute wrappedTriple = Triple a1 a2 a3
    where
      a1 = _slot0 <$> wrappedTriple
      a2 = _slot1 <$> wrappedTriple
      a3 = _slot2 <$> wrappedTriple

data Slot = Slot0 | Slot1 | Slot2
  deriving (Eq, Enum, Bounded, Show)

instance Rep.Representable Triple where
  type Rep Triple = Slot
  tabulate f =
    Triple (f Slot0) (f Slot1) (f Slot2)
  index (Triple s0 s1 s2) = \case
    Slot0 -> s0
    Slot1 -> s1
    Slot2 -> s2

-- newtype is to mostly avoid orphan instance warnings
newtype WrappedStream a = WrappedStream { getStream :: Str.Stream a}
  deriving Functor

instance Show a => Show (WrappedStream a) where
  show =
    (<>" ...") . concatMap (<>", ") . fmap show . Str.take 20 . getStream

instance Distributive WrappedStream where
  distribute = WrappedStream . Str.distribute . fmap getStream

instance Rep.Representable WrappedStream where
  type Rep WrappedStream = Natural
  tabulate f = WrappedStream $
    Str.fromList [f n | n <- [0 ..]]
  index (WrappedStream str) n =
    Str.head $ Str.drop (fromIntegral n) str

firstThree :: Lens' (WrappedStream a) (Triple a)
firstThree = restrictByPositionMapping $ Triple 0 1 2

secondThree :: Lens' (WrappedStream a) (Triple a)
secondThree = restrictByPositionMapping $ Triple 3 4 5

evens :: Lens' (WrappedStream a) (WrappedStream a)
evens = mkLensFromPrism $ prism' create mbRecover
  where
    create n = 2 * n
    mbRecover n = if even n then Just (n `div` 2) else Nothing

example1 :: WrappedStream Int
example1 = WrappedStream $ Str.fromList [0 ..]

example2 :: WrappedStream Int
example2 = WrappedStream $ Str.fromList [100 ..]

-- >>> example1
-- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,  ...

-- >>> example1 ^. atPosition 5
-- 5

-- >>> example1 & atPosition 5 .~ 77
-- 0, 1, 2, 3, 4, 77, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,  ...

-- >>> example1 ^. firstThree
-- Triple {_slot0 = 0, _slot1 = 1, _slot2 = 2}

-- >>> example1 & atPosition 4 .~ 0 & view secondThree
-- Triple {_slot0 = 3, _slot1 = 0, _slot2 = 5}

-- >>> example1 & firstThree .~ Triple 100 101 102
-- 100, 101, 102, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,  ...

-- >>> example1 & firstThree . atPosition Slot2 .~ 999
-- 0, 1, 999, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,  ...

-- >>> example2
-- 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,  ...

-- >>> example1 ^. evens
-- 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38,  ...

-- >>> example1 & evens .~ example2
-- 100, 1, 101, 3, 102, 5, 103, 7, 104, 9, 105, 11, 106, 13, 107, 15, 108, 17, 109, 19,  ...

-- >>> example2 & evens .~ example1
-- 0, 101, 1, 103, 2, 105, 3, 107, 4, 109, 5, 111, 6, 113, 7, 115, 8, 117, 9, 119,  ...

-- >>> example1 & evens . evens . evens .~ example2
-- 100, 1, 2, 3, 4, 5, 6, 7, 101, 9, 10, 11, 12, 13, 14, 15, 102, 17, 18, 19,  ...

-- >>> example1 & evens . firstThree .~ Triple 100 101 102
-- 100, 1, 101, 3, 102, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,  ...

-- >>> example1 & evens . secondThree . atPosition Slot2 .~ 1000
-- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1000, 11, 12, 13, 14, 15, 16, 17, 18, 19,  ...

-------------------------------------------------------------------------------
-- 2D Menger Sponge

-- We assume that type Interval represents [0, 1]
type Interval = Rational
type Square = (Interval, Interval)

inInterval :: Rational -> Bool
inInterval x = 0 <= x && x <= 1

inSquare :: Square -> Bool
inSquare (x, y) = inInterval x && inInterval y

leftSegment :: Prism' Interval Interval
leftSegment = prism' create mbRecover
  where
    create x =
      if inInterval x then x/3 else x
    mbRecover x
      | not (inInterval x)
        = Just x
      | x <= 1/3
        = Just (3*x)
      | otherwise
        = Nothing

shift :: Rational -> Iso' Rational Rational
shift t = iso (+t) (subtract t)

middleSegment, rightSegment :: Prism' Interval Interval
middleSegment = shift (-1/3) . leftSegment
rightSegment = shift (-2/3) . leftSegment

data Position = PositionLeft | PositionMiddle | PositionRight
  deriving (Eq, Enum, Bounded)

toPositionPrism :: Position -> Prism' Interval Interval
toPositionPrism = \case
  PositionLeft -> leftSegment
  PositionMiddle -> middleSegment
  PositionRight -> rightSegment

menger :: Natural -> Square -> Bool
menger = go inSquare
  where
    mkLensFromSegs p1 p2 =
      mkLensFromPrism $
        prismProduct (toPositionPrism p1) (toPositionPrism p2)
    go predicate d
      | d == 0
        = predicate
      | otherwise
        = foldr ($) (predicate
            & mkLensFromSegs PositionMiddle PositionMiddle .~ const False) (
              [ mkLensFromSegs p1 p2 .~ go predicate (d - 1)
              | p1 <- [minBound .. maxBound]
              , p2 <- [minBound .. maxBound]
              , p1/= PositionMiddle || p2/= PositionMiddle
              ])

prismProduct :: Prism' s a -> Prism' s' a' -> Prism' (s, s') (a, a')
prismProduct prism1 prism2 = prism' create mbRecover
  where
    create (a, a') =
      (review prism1 a, review prism2 a')
    mbRecover (s, s') =
      liftA2 (,) (preview prism1 s) (preview prism2 s')

newtype Table = Table [Text]

tableFromSample :: Rational -> (Square -> Bool) -> Table
tableFromSample step predicate = Table $ mkRow <$> allLines
  where
    steps = [0,step..1]
    singleLine x = (x,) <$> steps
    allLines =  fmap predicate . singleLine <$> steps
    mkRow = foldMap (\b -> if b then "\x02593\x02593" else "\x02591\x02591")

-- Hacky show instance to fool >>>
instance Show Table where
  show (Table rows) = T.unpack $ T.intercalate "\n-- " rows
-- >>> tableFromSample (1/80) $ menger 4
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓░░░░░░░░░░░░░░░░░░▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓▓▓░░▓▓░░░░░░▓▓░░▓▓
-- ▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓▓▓▓▓▓▓░░░░░░▓▓▓▓▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
-- ▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓▓▓░░▓▓
-- ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓


-------------------------------------------------------------------------------
-- Grate from lens
-------------------------------------------------------------------------------

newtype GrateRep s t a b = GrateRep { unGrateRep :: ((s -> a) -> b) -> t }

type GrateRep' s a = GrateRep s s a a

represented :: Rep.Representable f => GrateRep (f a) (f b) a b
represented = GrateRep $
  \faab -> Rep.tabulate (\r -> faab (`Rep.index` r))

newtype DoubleCont a b s = DoubleCont { unDoubleCont :: (s -> a) -> b }
  deriving Functor

distributed :: Distributive f => GrateRep (f a) (f b) a b
distributed = GrateRep $
  \faab -> ($ id) . unDoubleCont <$> distribute (DoubleCont faab)

zipWith0 :: GrateRep s t a b -> b -> t
zipWith0 (GrateRep sabt) b =
  sabt (const b)

zipWith1 :: GrateRep s t a b -> (a -> b) -> s -> t
zipWith1 (GrateRep sabt) ab s =
  sabt $ \sa -> ab (sa s)

zipWith2 :: GrateRep s t a b -> (a -> a -> b) -> s -> s -> t
zipWith2 (GrateRep sabt) o s1 s2 =
  sabt $ \sa -> o (sa s1) (sa s2)

modifyDoubleCont ::
  (s1 -> s2) ->
  (a2 -> a1) ->
  (b1 -> b2) ->
  ((s1 -> a1) -> b1) ->
  ((s2 -> a2) -> b2)
modifyDoubleCont mapS contramapA mapB  =
  (. (contramapA .)) . (mapB .) . (. (. mapS))

grateFromLens ::
  ( Rep.Representable f, Rep.Rep f ~ r1
  , Rep.Representable g, Rep.Rep g ~ r2
  ) =>
  Lens' r1 r2 -> GrateRep (f a) (f b) (g a) (g b)
grateFromLens lns = GrateRep $ \fagaga ->
  Rep.tabulate $
    \r1 ->
      fagaga
        & modifyDoubleCont Rep.index Rep.tabulate Rep.index
        & modifyDoubleCont id (\r1a r2 -> r1a $ lns .~ r2 $ r1) (\r2a _ -> r2a $ r1 ^. lns )
        & ($ id)
        & ($ r1)

decompose3 :: Iso' Natural (Natural, Slot)
decompose3 = iso fromN toN
  where
    fromN n = (n `div` 3, remainderAsSlot $ n `mod` 3)
    toN (n, slot) =
      3 * n + slotAsRemainder slot
    slotAsRemainder = \case
      Slot0 -> 0
      Slot1 -> 1
      Slot2 -> 2
    remainderAsSlot n
      | n == 0    = Slot0
      | n == 1    = Slot1
      | otherwise = Slot2

divideBy3 :: Lens' Natural Natural
divideBy3 = decompose3 . _1

remainderBy3 :: Lens' Natural Slot
remainderBy3 = decompose3 . _2

divideBy3Grate :: GrateRep (WrappedStream a) (WrappedStream b) (WrappedStream a) (WrappedStream b)
divideBy3Grate = grateFromLens divideBy3

remainderBy3Grate :: GrateRep (WrappedStream a) (WrappedStream b) (Triple a) (Triple b)
remainderBy3Grate = grateFromLens remainderBy3

-- first three examples give you the usual zip.
-- >>> zipWith2 represented (+) example1 example2
-- 100, 102, 104, 106, 108, 110, 112, 114, 116, 118, 120, 122, 124, 126, 128, 130, 132, 134, 136, 138,  ...

-- >>> zipWith2 divideBy3Grate (zipWith2 represented (+)) example1 example2
-- 100, 102, 104, 106, 108, 110, 112, 114, 116, 118, 120, 122, 124, 126, 128, 130, 132, 134, 136, 138,  ...

-- >>> zipWith2 remainderBy3Grate (zipWith2 represented (+)) example1 example2
-- 100, 102, 104, 106, 108, 110, 112, 114, 116, 118, 120, 122, 124, 126, 128, 130, 132, 134, 136, 138,  ...

-- These are more interesting

liftWrapped2 ::
  (Str.Stream a -> Str.Stream a -> Str.Stream a) ->
  WrappedStream a -> WrappedStream a -> WrappedStream a
liftWrapped2 binaryOp w1 w2 = WrappedStream $ on binaryOp getStream w1 w2

-- >>> liftWrapped2 Str.interleave example1 example2
-- 0, 100, 1, 101, 2, 102, 3, 103, 4, 104, 5, 105, 6, 106, 7, 107, 8, 108, 9, 109,  ...

-- >>> zipWith2 divideBy3Grate (liftWrapped2 Str.interleave) example1 example2
-- 0, 1, 2, 100, 101, 102, 3, 4, 5, 103, 104, 105, 6, 7, 8, 106, 107, 108, 9, 10,  ...

pickAlternating :: Str.Stream a -> Str.Stream a -> Str.Stream a
pickAlternating str1 str2 = Str.zip3 str1 str2 (Str.fromList [0 :: Int ..]) <&>
  \(a, b, n) -> if even n then a else b

-- >>> liftWrapped2 pickAlternating example1 example2
-- 0, 101, 2, 103, 4, 105, 6, 107, 8, 109, 10, 111, 12, 113, 14, 115, 16, 117, 18, 119,  ...

-- >>> zipWith2 divideBy3Grate (liftWrapped2 pickAlternating) example1 example2
-- 0, 1, 2, 103, 104, 105, 6, 7, 8, 109, 110, 111, 12, 13, 14, 115, 116, 117, 18, 19,  ...

crissCross :: Str.Stream a -> Str.Stream a -> Str.Stream a
crissCross (Str.Cons _x1 (Str.Cons y1 rest1)) (Str.Cons x2 (Str.Cons _y2 rest2)) =
  y1 Str.<:> x2 Str.<:> crissCross rest1 rest2

-- >>> liftWrapped2 crissCross example1 example2
-- 1, 100, 3, 102, 5, 104, 7, 106, 9, 108, 11, 110, 13, 112, 15, 114, 17, 116, 19, 118,  ...

-- >>> zipWith2 divideBy3Grate (liftWrapped2 crissCross) example1 example2
-- 3, 4, 5, 100, 101, 102, 9, 10, 11, 106, 107, 108, 15, 16, 17, 112, 113, 114, 21, 22,  ...

shiftByEndo ::
  ( Rep.Representable f
  , Rep.Rep f ~ r
  ) =>
  Endo r -> (a -> a -> b) -> f a -> f a -> f b
shiftByEndo (Endo endo) binaryOp fa1 =
  zipWith2 represented binaryOp (Rep.tabulate $ Rep.index fa1 . endo)

swapNeightbors :: Endo Natural
swapNeightbors = Endo $ \n -> if even n then n + 1 else n - 1

-- >>> zipWith2 divideBy3Grate (shiftByEndo swapNeightbors (+)) example1 example2
-- 103, 105, 107, 103, 105, 107, 115, 117, 119, 115, 117, 119, 127, 129, 131, 127, 129, 131, 139, 141,  ...

-- >>> zipWith2 remainderBy3Grate (shiftByEndo (Endo id) (+)) example1 example2
-- 100, 102, 104, 106, 108, 110, 112, 114, 116, 118, 120, 122, 124, 126, 128, 130, 132, 134, 136, 138,  ...

-- >>> zipWith2 remainderBy3Grate (shiftByEndo (Endo $ const Slot0) (+)) example1 example2
-- 100, 101, 102, 106, 107, 108, 112, 113, 114, 118, 119, 120, 124, 125, 126, 130, 131, 132, 136, 137,  ...

-- >>> zipWith2 remainderBy3Grate (shiftByEndo (Endo $ const Slot1) (+)) example1 example2
-- 101, 102, 103, 107, 108, 109, 113, 114, 115, 119, 120, 121, 125, 126, 127, 131, 132, 133, 137, 138,  ...

rotateSlot :: Slot -> Slot
rotateSlot = \case
  Slot0 -> Slot1
  Slot1 -> Slot2
  Slot2 -> Slot0

-- >>> zipWith2 remainderBy3Grate (shiftByEndo (Endo rotateSlot) (+)) example1 example2
-- 101, 103, 102, 107, 109, 108, 113, 115, 114, 119, 121, 120, 125, 127, 126, 131, 133, 132, 137, 139,  ...