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

module Webc.Generator where

import Control.Applicative (Applicative (..), liftA2)
import Data.Either (Either (..))
import Data.Eq (Eq (..))
import Data.Function (($), (.))
import Data.Functor (Functor (..), (<$>))
import Data.Ord (Ord (..))
import Data.Semigroup (Semigroup (..))
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 :: [Gen a]
  }
  deriving (Functor, Show)

instance Applicative Generator where
  pure = Generator . pure . pure
  Generator f <*> Generator x = Generator ((<*>) <$> f <*> x)

generate :: Generator a -> [Gen a]
generate = unGenerator

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

instance IsoFunctor Generator where
  (<%>) Iso{..} = (a2b <$>)
instance ProductFunctor Generator where
  (<.>) = liftA2 (,)
  (<.) = (<*)
  (.>) = (*>)
instance SumFunctor Generator where
  x <+> y =
    Generator $
      unGenerator (Left <$> x)
        <> unGenerator (Right <$> y)
instance Repeatable Generator where
  many0 (Generator x) =
    Generator $
      ((\Gen{} -> Gen [] []) <$> x)
        <> ((\(Gen s a) -> Gen s [a]) <$> x)
        <> ((\(Gen s a) -> Gen (s <> s) [a, a]) <$> x)
  many1 (Generator x) =
    Generator $
      ((\(Gen s a) -> Gen s [a]) <$> x)
        <> ((\(Gen s a) -> Gen (s <> s) [a, a]) <$> x)
instance Slugable Generator where
  literalSlug s = Generator [Gen [s] ()]
  captureSlug n = Generator [Gen [n] n]