{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Webc.Generator where

import Control.Applicative (Applicative (..))
import Data.Either (Either (..))
import Data.Eq (Eq (..))
import Data.Foldable (foldMap)
import Data.Function (id, (.))
import Data.Functor (Functor (..), (<$>))
import Data.List qualified as List
import Data.Ord (Ord (..))
import Data.Semigroup (Semigroup (..))
import Data.Tree (Forest, Tree (..), drawForest, flatten)
import Network.URI.Slug as URI
import Symantic.Classes (Iso (..), IsoFunctor (..), ProductFunctor (..), SumFunctor ((<+>)))
import Text.Show (Show (..))

import Webc.Classes

-- * The 'Generator' interpreter

-- | This is a very basic generator.
newtype Generator a = Generator
  { unGenerator ::
      GeneratorBranch (Forest (GeneratorNode a))
  }
  deriving (Functor)

generator :: Generator a -> Generator a
generator = id

generate :: Generator a -> Forest (GeneratorNode a)
generate = collapseCheckBranch . unGenerator

generateValues :: Generator a -> [a]
generateValues repr = genValue <$> foldMap flatten (generate repr)

generateSlugs :: Generator a -> [[Slug]]
generateSlugs repr = genSlugs <$> foldMap flatten (generate repr)

{- | Keep the path in the 'Tree'
where to append new branches;
in reverse order to simplify appending.
-}
type GeneratorBranch = []

{- | Fold 'GeneratorBranch' maintained for appending;
to be done when there is no more appending.
-}
collapseCheckBranch ::
  GeneratorBranch (Forest (GeneratorNode a)) ->
  Forest (GeneratorNode a)
collapseCheckBranch =
  List.foldr
    (\ts acc -> ((\(Node n ns) -> Node n (ns <> acc)) <$> ts))
    []

instance Show a => Show (Generator a) where
  show = drawForest . ((show <$>) <$>) . generate

instance IsoFunctor Generator where
  Iso{..} <%> x = a2b <$> x

-- ** Type 'GeneratorNode'
data GeneratorNode a = GeneratorNode {genValue :: a, genSlugs :: [Slug]}
  deriving (Eq, Ord, Show, Functor)
instance Applicative GeneratorNode where
  pure a = GeneratorNode a []
  GeneratorNode f fs <*> GeneratorNode a as =
    GeneratorNode (f a) (fs <> as)

genNode :: GeneratorNode a -> Generator a
genNode = Generator . pure . pure . pure

instance ProductFunctor Generator where
  Generator x <.> Generator y =
    Generator
      ( ( \x1 y1 ->
            ( \x2 y2 ->
                ( \x3 y3 ->
                    (,) <$> x3 <*> y3
                )
                  <$> x2
                  <*> y2
            )
              <$> x1
              <*> y1
        )
          <$> x
          <*> y
      )

{- TODO:
x .> y = undefined
x <. y = undefined
-}
instance SumFunctor Generator where
  x <+> y =
    Generator
      [ collapseCheckBranch (unGenerator (Left <$> x))
          <> collapseCheckBranch (unGenerator (Right <$> y))
      ]
mapCheckNode :: (GeneratorNode a -> GeneratorNode b) -> Generator a -> Generator b
mapCheckNode f = Generator . (((f <$>) <$>) <$>) . unGenerator

instance Repeatable Generator where
  many0 x =
    Generator
      [ collapseCheckBranch (unGenerator (mapCheckNode (\GeneratorNode{} -> GeneratorNode [] []) x))
          <> collapseCheckBranch (unGenerator (mapCheckNode (\(GeneratorNode a s) -> GeneratorNode [a] s) x))
          <> collapseCheckBranch (unGenerator (mapCheckNode (\(GeneratorNode a s) -> GeneratorNode [a, a] (s <> s)) x))
      ]
  many1 x =
    Generator
      [ collapseCheckBranch (unGenerator (mapCheckNode (\(GeneratorNode a s) -> GeneratorNode [a] s) x))
          <> collapseCheckBranch (unGenerator (mapCheckNode (\(GeneratorNode a s) -> GeneratorNode [a, a] (s <> s)) x))
      ]
instance Slugable Generator where
  literalSlug = genNode . GeneratorNode () . pure
  captureSlug n = genNode (GeneratorNode n [n])