{-# 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.Foldable (toList)
import Data.Function (($), (.))
import Data.Functor (Functor (..), (<$>))
import Data.Maybe (Maybe (..))
import Data.Ord (Ord (..))
import Data.Semigroup (Semigroup (..))
import Network.URI.Slug as URI
import Symantic.Classes (Constantable (..), Iso (..), IsoFunctor (..), Optionable (..), 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

-- instance Monad Generator where
--   return = pure
--   Generator x >>= f = Generator (x >>=)

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

-- ** Type 'Gen'
data Gen a = Gen
  { genSlugs :: [Slug] -- TODO: Endo? Seq?
  , 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 $
      (<>)
        ((Left <$>) <$> unGenerator x)
        ((Right <$>) <$> unGenerator 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 Optionable Generator where
  optional x =
    Generator $
      Gen [] Nothing :
      ((Just <$>) <$> unGenerator x)
instance Endable Generator where
  end = Generator [Gen [] ()]
instance Slugable Generator where
  literalSlug s = Generator [Gen [s] ()]
  chooseSlug ss =
    Generator $
      [ Gen [s] s
      | s <- toList ss
      ]

-- chooseSlugs ss =
--   Generator $
--     [ Gen s s
--     | s <- toList ss
--     ]
instance Capturable Generator where
  captureSlug n = Generator $ [Gen [n] n]
instance Constantable c Generator where
  constant = pure