module Uniplate where

import Prelude

import Data.Maybe (Maybe(), maybe)
import Data.Tuple (Tuple(..))
import Data.Array ((:), uncons)

class Uniplate on where
  uniplate :: on -> Tuple (Str on) (Str on -> on)

descend :: forall on. (Uniplate on) => (on -> on) -> on -> on
descend f x = case uniplate x of
  (Tuple current generate) -> generate $ strMap f current

transform :: forall on. (Uniplate on) => (on -> on) -> on -> on
transform f = g
  where
  g x = f (descend g x)

rewrite :: forall on. (Uniplate on) => (on -> Maybe on) -> on -> on
rewrite f = transform g
  where
  g x = maybe x (rewrite f) (f x)

data Str a = Zero | One a | Two (Str a) (Str a)

instance eqStr :: (Eq a) => Eq (Str a) where
  eq Zero Zero = true
  eq (One x) (One y) = x == y
  eq (Two x1 x2) (Two y1 y2) = x1 == y1 && x2 == y2
  eq _ _ = false

strMap :: forall a b. (a -> b) -> Str a -> Str b
strMap f x = g x
  where
  g  Zero = Zero
  g  (One x) = One $ f x
  g  (Two x y) = Two (g x) (g y)

strList :: forall a. Str a -> Array a
strList array = builder (f array)
  where
  f :: forall f. Str a -> (a -> f a -> f a) -> (f a -> f a -> f a) -> f a -> f a
  f Zero _ _ nil = nil
  f (One x) cons _ nil = cons x nil
  f (Two Zero xs) cons app nil = f xs cons app nil
  f (Two (One x) xs) cons app nil = x `cons` f xs cons app nil
  f (Two (Two xs ys) zs) cons app nil = (f xs cons app nil) `app` (f ys cons app nil) `app` (f zs cons app nil)

  builder :: ((a -> Array a -> Array a) -> (Array a -> Array a -> Array a) -> Array a -> Array a) -> Array a
  builder g = g (:) (<>) []

listStr :: forall a. Array a -> Str a
listStr = maybe Zero (\{ head: x, tail: xs } -> Two (One x) (listStr xs)) <<< uncons