{-# language QuasiQuotes #-}

module Render.VkException
  ( vkExceptionRenderElement
  ) where

import           Data.Text                     as T
import           Prettyprinter
import           Data.Vector                   as V
import           Polysemy.Input
import           Relude                  hiding ( ask )
import           Text.InterpolatedString.Perl6.Unindented
import           Text.Pandoc

import           Control.Exception

import           Documentation
import           Error
import           Haskell                       as H
import           Haskell.Name                   ( )
import           Render.Element
import           Render.SpecInfo
import           Render.Type
import           Spec.Types

vkExceptionRenderElement
  :: (HasErr r, HasRenderParams r, HasSpecInfo r)
  => (Documentee -> Maybe Documentation)
  -> Enum'
  -> Sem r RenderElement
vkExceptionRenderElement getDocumentation vkResultEnum =
  genRe "VulkanException declaration" $ do
    tellExplicitModule =<< mkModuleName ["Exception"]
    tellNotReexportable
    RenderParams {..} <- input
    tellImportWithAll ''Control.Exception.Exception
    vkResultTyDoc <- renderType =<< cToHsType DoNotPreserve successCodeType
    tellImportWithAll (mkTyName (eName vkResultEnum))
    tellExport (EData exceptionTypeName)
    let resultPatterns = evName <$> eValues vkResultEnum
    cases <- V.mapMaybe id
      <$> forV resultPatterns (displayExceptionCase getDocumentation)
    tellDoc [qci|
        -- | This exception is thrown from calls to marshalled Vulkan commands
        -- which return a negative VkResult.
        newtype {exceptionTypeName} = {exceptionTypeName} \{ vulkanExceptionResult :: {vkResultTyDoc} }
          deriving (Eq, Ord, Read, Show)

        instance Exception {exceptionTypeName} where
          displayException ({exceptionTypeName} r) = show r ++ ": " ++ resultString r

        -- | A human understandable message for each VkResult
        resultString :: {vkResultTyDoc} -> String
        resultString = \case
        {indent 2 . vcat $ V.toList cases}
          r -> show r
      |]

displayExceptionCase
  :: HasRenderParams r
  => (Documentee -> Maybe Documentation)
  -> CName
  -> Sem r (Maybe (Doc ()))
displayExceptionCase getDocumentation pat = do
  RenderParams {..} <- input
  let pat' = mkPatternName pat
  pure $ fmap
    ((pretty pat' <+> "->") <+>)
    (documentationToString =<< getDocumentation (Nested "VkResult" pat))

-- | Get a string expression from some documentation
documentationToString :: Documentation -> Maybe (Doc ())
documentationToString Documentation {..} =
  let writerOptions = def
  in  viaShow . fixupResultDescription <$> eitherToMaybe
        (runPure (writePlain writerOptions (prepareForPlain dDocumentation)))

-- |
-- - Keep only the first sentence
-- - Drop the first word (it's the enum name)
fixupResultDescription :: Text -> Text
fixupResultDescription =
  T.takeWhile (/= '.') . T.unwords . tailSafe . T.words . T.replace "\8217" "'"

tailSafe :: [a] -> [a]
tailSafe = \case
  []     -> []
  _ : xs -> xs

prepareForPlain :: Pandoc -> Pandoc
prepareForPlain = topDown removeEmph
 where
  removeEmph :: [Inline] -> [Inline]
  removeEmph is = removeEmphInline =<< is
  removeEmphInline :: Inline -> [Inline]
  removeEmphInline = \case
    Emph is -> is
    i       -> [i]

----------------------------------------------------------------
-- Utils
----------------------------------------------------------------

eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = \case
  Left  _ -> Nothing
  Right x -> Just x
