-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Michelson view.
module Morley.Michelson.Untyped.View
  ( ViewName (.., ViewName)
  , mkViewName
  , BadViewNameError (..)
  , isValidViewNameChar
  , viewNameMaxLength
  , renderViewName
  , viewNameToMText

  , View' (..)
  ) where

import Control.Monad.Except (throwError)
import Data.Aeson.TH (deriveJSON)
import Data.Data (Data)
import Data.Text qualified as Text
import Fmt (Buildable(..), (+|), (|+))
import Text.PrettyPrint.Leijen.Text (Doc, dquotes, textStrict)

import Morley.Michelson.Printer.Util
import Morley.Michelson.Text
import Morley.Michelson.Untyped.Type
import Morley.Util.Aeson

-- | Name of the view.
--
-- 1. It must not exceed 31 chars length;
-- 2. Must use [a-zA-Z0-9_.%@] charset.
newtype ViewName = UnsafeViewName { unViewName :: Text }
  deriving stock (Show, Eq, Ord, Data, Generic)
  deriving newtype (Buildable, NFData)

pattern ViewName :: Text -> ViewName
pattern ViewName name <- UnsafeViewName name
{-# COMPLETE ViewName #-}

-- | Whether the given character is valid for a view.
isValidViewNameChar :: Char -> Bool
isValidViewNameChar c = or
  [ 'A' <= c && c <= 'Z'
  , 'a' <= c && c <= 'z'
  , '0' <= c && c <= '9'
  , c `elem` ['_', '.', '%', '@']
  ]

-- | Maximum allowed name length for a view.
viewNameMaxLength :: Int
viewNameMaxLength = 31

data BadViewNameError
  = BadViewTooLong Int
  | BadViewIllegalChars Text
  deriving stock (Show, Eq, Ord, Data, Generic)
  deriving anyclass (NFData)

instance Buildable BadViewNameError where
  build = \case
    BadViewTooLong l ->
      "Bad view name length of " +| l |+ " characters, must not exceed \
      \" +| viewNameMaxLength |+ " characters length"
    BadViewIllegalChars txt ->
      "Invalid characters in the view \"" +| txt |+ ", allowed characters set \
      \is [a-zA-Z0-9_.%@]"

-- | Construct t'ViewName' performing all the checks.
mkViewName :: Text -> Either BadViewNameError ViewName
mkViewName txt = do
  unless (length txt <= viewNameMaxLength) $
    throwError (BadViewTooLong $ length txt)
  unless (Text.all isValidViewNameChar txt) $
    throwError (BadViewIllegalChars txt)
  return (UnsafeViewName txt)

renderViewName :: ViewName -> Doc
renderViewName = dquotes . textStrict . unViewName

instance RenderDoc ViewName where
  renderDoc _ = renderViewName

-- | Valid view names form a subset of valid Michelson texts.
viewNameToMText :: ViewName -> MText
viewNameToMText = unsafe . mkMText . unViewName

-- | Untyped view in a contract.
data View' op = View
  { viewName :: ViewName
    -- ^ View name
  , viewArgument :: Ty
    -- ^ View argument type
  , viewReturn :: Ty
    -- ^ View return type
  , viewCode :: [op]
    -- ^ View code
  } deriving stock (Eq, Show, Functor, Data, Generic)

instance NFData op => NFData (View' op)

deriveJSON morleyAesonOptions ''ViewName
deriveJSON morleyAesonOptions ''View'