content: {-# LANGUAGE NoImplicitPrelude, OverloadedStrings, UnicodeSyntax, FlexibleContexts #-}
  
  -- | The Sweetroll prelude == ClassyPrelude + more stuff.
  module Sweetroll.Prelude (
    module X
  , module Sweetroll.Prelude
  ) where
  
  import           RIO as X (HasLogFunc, HasCallStack, logDebug, logInfo, logWarn, logError, display, MonadThrow, throwM)
  import           ClassyPrelude as X hiding (fromString, (<>))
  import           Magicbane as X
  import           Control.Monad.Trans.Except as X (throwE)
  import           Control.Lens as X hiding (Index, index, cons, snoc, uncons, unsnoc, (<.>), (.=), (|>), (<|), Context, Strict)
  import           Text.XML (Document, Element)
  import qualified Data.Text
  import           Data.Default as X
  import           Data.Maybe (fromJust)
  import           Data.List as X (nub)
  import           Data.List.Split as X (splitOn)
  import           Data.Char as X (isSpace, generalCategory, GeneralCategory(..))
  import qualified Data.HashMap.Strict as HMS
  import           Data.Aeson.Lens as X hiding (nonNull)
  
  type XDocument = Text.XML.Document
  type XElement = Text.XML.Element
  
  infixl 1 |>
  (|>) ∷ Monad μ ⇒ μ α → (α → β) → μ β
  (|>) = flip liftM
  
  firstStr v l = (v ^? l . _String) <|> (v ^? values . l . _String) <|> (v ^? l . values . _String)
  
  uriPathParts ∷ ConvertibleStrings Text α ⇒ URI → [α]
  uriPathParts = map cs . Data.Text.splitOn "/" . drop 1 . cs . uriPath
  
  orEmptyMaybe ∷ IsString α ⇒ Maybe α → α
  orEmptyMaybe = fromMaybe ""
  
  ensureArrayProp ∷ Text → Value → Value
  ensureArrayProp k (Object o) | HMS.member k o = Object o
  ensureArrayProp k (Object o) = Object $ HMS.insert k (Array empty) o
  ensureArrayProp _ v = v
  
  errWrongDomain ∷ ServantErr
  errWrongDomain = errText err400 "The target URI is not on this domain."
  
  errWrongPath ∷ ServantErr
  errWrongPath = errText err400 "The target URI is not a resource that exists on this domain."
  
  errNotFound ∷ ServantErr
  errNotFound = errText err404 "Not found"
  
  errNoURIInField ∷ LByteString → ServantErr
  errNoURIInField f = errText err400 $ "You didn't put a valid absolute URI in the '" ++ f ++ "' field of the www-form-urlencoded request body."
  
  guardJustP ∷ MonadThrow μ ⇒ ServantErr → Maybe α → μ α
  guardJustP _ (Just x) = return x
  guardJustP e Nothing = throwM e
  
  guardJustM ∷ MonadThrow μ ⇒ μ ServantErr → μ (Maybe α) → μ α
  guardJustM ea a = a >>= \x → case x of
                                   Just v → return v
                                   Nothing → throwM =<< ea
  
  guardJust ∷ MonadThrow μ ⇒ ServantErr → μ (Maybe α) → μ α
  guardJust e = guardJustM (return e)
  
  guardBool ∷ MonadThrow μ ⇒ ServantErr → Bool → μ ()
  guardBool e x = unless x $ throwM e
  
  guardBoolM ∷ MonadThrow μ ⇒ μ ServantErr → Bool → μ ()
  guardBoolM ea False = throwM =<< ea
  guardBoolM _ True = return ()
  
  base ∷ ConvertibleStrings a String ⇒ Maybe a → URI
  base (Just x) = fromJust $ parseURI $ "https://" ++ cs x -- have to parse because it might have a port number
  base Nothing = URI "http:" (Just $ URIAuth "" "localhost" "") "" "" ""
  
  compareDomain ∷ URI → URI → Bool
  compareDomain x y = (uriRegName <$> uriAuthority x) == (uriRegName <$> uriAuthority y)
  
  ensureRightDomain ∷ MonadThrow μ ⇒ URI → URI → μ ()
  ensureRightDomain x y = guardBool errWrongDomain $ compareDomain x y
  
  guardEntryNotFound ∷ MonadThrow μ ⇒ Maybe α → μ α
  guardEntryNotFound (Just obj) = return obj
  guardEntryNotFound Nothing = throwErrText err404 "Entry not found."
  
  withTrailingSlash ∷ Text → [Text]
  withTrailingSlash t = let t' = fromMaybe t (stripSuffix "/" t) in [ t', t' ++ "/" ]
  