{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Example of MTL & classy lenses
module Run where

import           Protolude
import qualified Data.Char as Char
import qualified Data.Text as Txt
import           Control.Lens
import           Control.Monad.Except (throwError, runExceptT)
import           Control.Monad.Trans.Reader (ReaderT, runReaderT)

import           Lib

-----------------------------------------------------------------------------
run :: IO ()
run = do
  putText "-----1"
  demoSingleExplictErrorType1

  putText ""
  putText "-----2"
  demoApp2

  putText ""
  putText "-----3"
  demoApp3

  putText ""
  putText "-----4"
  demoApp4
-----------------------------------------------------------------------------


-----------------------------------------------------------------------------
-- Explicit error type
-----------------------------------------------------------------------------
demoSingleExplictErrorType1 :: IO ()
demoSingleExplictErrorType1 = do
  let user = UserConfig "" 1

  x <- runExceptT (runReaderT actOnUser1 user)
  case x of
    Left e -> print e
    Right r -> print r

  
  
actOnUser1 :: ( Monad m
              , HasUserConfig r
              , MonadError UserError m
              , MonadReader r m
              ) => m Text
actOnUser1 = do
  n <- ask

  if Txt.null $ n ^. ucName
  then throwError $ UserNotFound "Name is blank"
  else pass
  
  pure $ n ^. ucName
-----------------------------------------------------------------------------



-----------------------------------------------------------------------------
-- "Combined" error type using prisms
--   but the reader only has user config (HasUserConfig) but no HasSettings
-----------------------------------------------------------------------------
demoApp2 :: IO ()
demoApp2 = do
  let user = UserConfig "" 1

  x <- runExceptT (runReaderT actOnUser2 user)
  case x of
    Left (e::AppError) -> do
      print e
      print $ preview _UserError e
      print $ e ^? _UserError
    Right r -> print r
  
  

actOnUser2 :: ( Monad m
              , HasUserConfig r
              , AsSettingsError e
              , AsUserError e
              , MonadError e m
              , MonadReader r m
              ) => m Text
actOnUser2 = do
  n <- ask

  if Txt.null $ n ^. ucName
  then throwError $ _UserError # UserNotFound "Name blank"
  else throwError $ _SettingsError # SettingsLoadFailed "No settings in the reader :("
  
  pure $ n ^. ucName
-----------------------------------------------------------------------------



-----------------------------------------------------------------------------
-- "Combined" settings using app config
-----------------------------------------------------------------------------
demoApp3 :: IO ()
demoApp3 = do
  let user = UserConfig "" 1
  let settings' = Settings "~"
  let config = AppConfig settings' user

  x <- runExceptT (runReaderT actOnUser3 config)
  case x of
    Left (e::AppError) -> do
      pass
      print e
      print $ preview _UserError e
      print $ e ^? _UserError
    Right r -> print r
  
  

actOnUser3 :: ( Monad m
              , HasSettings r
              , HasUserConfig r
              , AsSettingsError e
              , AsUserError e
              , MonadError e m
              , MonadReader r m
              ) => m Text
actOnUser3 = do
  n <- ask

  if Txt.null $ n ^. ucName
  then throwError $ _UserError # UserNotFound "Name blank"
  else pass
  
  if null $ n ^. stRoot
  then throwError $ _SettingsError # SettingsLoadFailed "Invalid root path"
  else pass
  
  pure $ n ^. ucName
-----------------------------------------------------------------------------


-----------------------------------------------------------------------------
-- AppT version of demoApp3
-----------------------------------------------------------------------------
newtype AppT m a = AppT { unAppT :: ReaderT AppConfig (ExceptT AppError m) a 
                        } deriving ( Functor
                                   , Applicative
                                   , Monad
                                   , MonadReader AppConfig
                                   , MonadError AppError
                                   )

demoApp4 :: IO ()
demoApp4 = do
  let user = UserConfig "" 1
  let settings' = Settings "~"
  let config = AppConfig settings' user

  x <- runExceptT (runReaderT (unAppT actOnUser4) config)
  case x of
    Left (e::AppError) -> do
      print e
      print $ preview _UserError e
      print $ e ^? _UserError
    Right r -> print r

  
-- AppT lets us do anything AppT can do
--   calls child4 with explicit constraints
actOnUser4 :: (Monad m) => AppT m Text
actOnUser4 = do
  n <- ask

  if Txt.null $ n ^. ucName
  then throwError $ _UserError # UserNotFound "Name blank"
  else pass
  
  nameIsValid <- child4_nameIsValid
  if nameIsValid
  then throwError $ _UserError # UserNotFound "Name blank"
  else pass
  
  if null $ n ^. stRoot
  then throwError $ _SettingsError # SettingsLoadFailed "Invalid root path"
  else pass
  
  pure $ n ^. ucName


-- Can only get user config, no access to settings and ability to return error
child4_nameIsValid :: ( Monad m
                      , HasUserConfig r
                      , MonadReader r m
                      ) => m Bool
child4_nameIsValid = do
  n <- ask
  pure $ Txt.all Char.isLower $ n ^. ucName