module Main where

import GHC.Generics
import Control.Monad.Writer

data T
data G

data Group t a where
  Describe :: String -> [Group t a] -> Group G a
  It       :: String -> [Group T a] -> Group G a
  Effort   :: Float                 -> Group T a

deriving instance Functor (Group x)
deriving instance Show a => Show (Group x a)

type Spec m a = WriterT [Group G a] m ()
type TaskSpec m a = WriterT [Group T a] m ()

class (Monad m, Applicative f) => MonadSpec m f where
   it :: String -> TaskSpec m (f a) -> Spec m (f a)

   it' :: String -> Spec m (f a)
   it' s = it s (return ())

   describe :: String -> Spec m (f a) -> Spec m (f a)
   effort :: Float -> TaskSpec m (f a)

newtype Collector m a = Collector { unCollector :: m a }
  deriving ( Functor
           , Applicative
           , Monad
           , MonadIO
           )

instance (Monad m, MonadIO m) => MonadSpec (Collector m) IO where

  it name attrSpec = do
    tell [It name []]

  describe name spec = do
    sub <- lift $ execWriterT spec
    tell [Describe name sub]

  effort f = tell [Effort f]

collect :: Monad m => Spec (Collector m) (m (m a)) -> m [Group G (m a)]
collect spec = do
  groups <- unCollector $ execWriterT spec
  return (map (fmap join) groups)

run :: MonadIO m => Spec (Collector m) (m (m ())) -> m ()
run spec = do
  groups <- collect spec
  mapM_ (go 0) groups
  where
    go _ (Describe s gs) = liftIO $ print s >> mapM_ (go 0) gs
    go _ _ = error "wut"

mySpec :: MonadSpec m IO => Spec m (IO (IO ()))
mySpec =  describe "module 1" $ do
              it' "shit1"
              describe "feature A" $ do
                it "works!" $ effort 2.0

main :: IO ()
main = run mySpec --putStrLn "Hello, Haskell!"