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

module Yesod.Core.Instances
  (
  ) where

import Prelude (errorWithoutStackTrace)
import ClassyPrelude.Yesod

import Utils (assertM')
import Control.Lens

import Data.ByteString.Builder (toLazyByteString)

import System.FilePath ((</>))

import Data.Aeson

import Control.Monad.Fix
import Control.Monad.Fail (MonadFail)
import qualified Control.Monad.Fail as MonadFail
import Control.Monad.Except (MonadError(..))
import Data.Functor.Extend
  

instance (RenderRoute site, ParseRoute site) => PathPiece (Route site) where
  fromPathPiece
    = parseRoute
    . over (_2.traverse._2) (fromMaybe "")
    . over _2 queryToQueryText
    . decodePath
    . encodeUtf8
  toPathPiece
    = pack
    . ("/" </>)
    . unpack
    . decodeUtf8
    . toLazyByteString
    . uncurry encodePath
    . over _2 queryTextToQuery
    . over (_2.traverse._2) (assertM' $ not . null)
    . renderRoute
    
instance (RenderRoute site, ParseRoute site) => FromJSON (Route site) where
  parseJSON = withText "Route" $ maybe (fail "Could not parse route") return . fromPathPiece

instance (RenderRoute site, ParseRoute site) => ToJSON (Route site) where
  toJSON = String . toPathPiece


instance Monad FormResult where
  (FormSuccess a)    >>= f = f a
  FormMissing        >>= _ = FormMissing
  (FormFailure errs) >>= _ = FormFailure errs

  fail = MonadFail.fail

instance MonadFail FormResult where
  fail _ = FormMissing

instance MonadError [Text] FormResult where
  throwError = FormFailure

  catchError a@(FormSuccess _)    _ = a
  catchError    FormMissing       _ = FormMissing
  catchError   (FormFailure errs) h = h errs

instance MonadPlus FormResult

instance MonadFix FormResult where
  mfix f = let a = f (unSuccess a) in a
    where unSuccess (FormSuccess x) = x
          unSuccess  FormMissing    = errorWithoutStackTrace "mfix FormResult: FormMissing"
          unSuccess (FormFailure _) = errorWithoutStackTrace "mfix FormResult: FormFailure"

instance Extend FormResult where
  duplicated (FormSuccess x)    = FormSuccess $ FormSuccess x
  duplicated  FormMissing       = FormMissing
  duplicated (FormFailure errs) = FormFailure errs