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

{-# OPTIONS_HADDOCK not-home #-}

-- | Michelson view name.
module Morley.Michelson.Internal.ViewName
  ( module Morley.Michelson.Internal.ViewName
  ) where

import Control.Monad.Except (throwError)
import Data.Aeson (FromJSONKey(..), ToJSONKey(..))
import Data.Aeson.TH (deriveJSON)
import Data.Aeson.Types qualified as AesonTypes
import Data.Char (isAsciiLower, isAsciiUpper, isDigit)
import Data.Data (Data)
import Data.Text qualified as Text
import Fmt (Buildable(..), Doc, pretty, (+|), (|+))
import Prettyprinter (dquotes)

import Morley.Michelson.Printer.Util
import Morley.Michelson.Text
import Morley.Util.Aeson
import Morley.Util.CLI

-- | Name of the view.
--
-- 1. It must not exceed 31 chars length;
-- 2. Must use [a-zA-Z0-9_.%@] charset.
newtype ViewName = UnsafeViewName { ViewName -> Text
unViewName :: Text }
  deriving stock (Int -> ViewName -> ShowS
[ViewName] -> ShowS
ViewName -> [Char]
(Int -> ViewName -> ShowS)
-> (ViewName -> [Char]) -> ([ViewName] -> ShowS) -> Show ViewName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViewName -> ShowS
showsPrec :: Int -> ViewName -> ShowS
$cshow :: ViewName -> [Char]
show :: ViewName -> [Char]
$cshowList :: [ViewName] -> ShowS
showList :: [ViewName] -> ShowS
Show, ViewName -> ViewName -> Bool
(ViewName -> ViewName -> Bool)
-> (ViewName -> ViewName -> Bool) -> Eq ViewName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ViewName -> ViewName -> Bool
== :: ViewName -> ViewName -> Bool
$c/= :: ViewName -> ViewName -> Bool
/= :: ViewName -> ViewName -> Bool
Eq, Eq ViewName
Eq ViewName
-> (ViewName -> ViewName -> Ordering)
-> (ViewName -> ViewName -> Bool)
-> (ViewName -> ViewName -> Bool)
-> (ViewName -> ViewName -> Bool)
-> (ViewName -> ViewName -> Bool)
-> (ViewName -> ViewName -> ViewName)
-> (ViewName -> ViewName -> ViewName)
-> Ord ViewName
ViewName -> ViewName -> Bool
ViewName -> ViewName -> Ordering
ViewName -> ViewName -> ViewName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ViewName -> ViewName -> Ordering
compare :: ViewName -> ViewName -> Ordering
$c< :: ViewName -> ViewName -> Bool
< :: ViewName -> ViewName -> Bool
$c<= :: ViewName -> ViewName -> Bool
<= :: ViewName -> ViewName -> Bool
$c> :: ViewName -> ViewName -> Bool
> :: ViewName -> ViewName -> Bool
$c>= :: ViewName -> ViewName -> Bool
>= :: ViewName -> ViewName -> Bool
$cmax :: ViewName -> ViewName -> ViewName
max :: ViewName -> ViewName -> ViewName
$cmin :: ViewName -> ViewName -> ViewName
min :: ViewName -> ViewName -> ViewName
Ord, Typeable ViewName
Typeable ViewName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ViewName -> c ViewName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ViewName)
-> (ViewName -> Constr)
-> (ViewName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ViewName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ViewName))
-> ((forall b. Data b => b -> b) -> ViewName -> ViewName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ViewName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ViewName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ViewName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ViewName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ViewName -> m ViewName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ViewName -> m ViewName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ViewName -> m ViewName)
-> Data ViewName
ViewName -> Constr
ViewName -> DataType
(forall b. Data b => b -> b) -> ViewName -> ViewName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ViewName -> u
forall u. (forall d. Data d => d -> u) -> ViewName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ViewName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ViewName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ViewName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ViewName -> c ViewName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ViewName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ViewName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ViewName -> c ViewName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ViewName -> c ViewName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ViewName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ViewName
$ctoConstr :: ViewName -> Constr
toConstr :: ViewName -> Constr
$cdataTypeOf :: ViewName -> DataType
dataTypeOf :: ViewName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ViewName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ViewName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ViewName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ViewName)
$cgmapT :: (forall b. Data b => b -> b) -> ViewName -> ViewName
gmapT :: (forall b. Data b => b -> b) -> ViewName -> ViewName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ViewName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ViewName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ViewName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ViewName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ViewName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ViewName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ViewName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ViewName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ViewName -> m ViewName
Data, (forall x. ViewName -> Rep ViewName x)
-> (forall x. Rep ViewName x -> ViewName) -> Generic ViewName
forall x. Rep ViewName x -> ViewName
forall x. ViewName -> Rep ViewName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ViewName -> Rep ViewName x
from :: forall x. ViewName -> Rep ViewName x
$cto :: forall x. Rep ViewName x -> ViewName
to :: forall x. Rep ViewName x -> ViewName
Generic)
  deriving newtype ([ViewName] -> Doc
ViewName -> Doc
(ViewName -> Doc) -> ([ViewName] -> Doc) -> Buildable ViewName
forall a. (a -> Doc) -> ([a] -> Doc) -> Buildable a
$cbuild :: ViewName -> Doc
build :: ViewName -> Doc
$cbuildList :: [ViewName] -> Doc
buildList :: [ViewName] -> Doc
Buildable, ViewName -> ()
(ViewName -> ()) -> NFData ViewName
forall a. (a -> ()) -> NFData a
$crnf :: ViewName -> ()
rnf :: ViewName -> ()
NFData)

pattern ViewName :: Text -> ViewName
pattern $mViewName :: forall {r}. ViewName -> (Text -> r) -> ((# #) -> r) -> r
ViewName name <- UnsafeViewName name
{-# COMPLETE ViewName #-}

deriveJSON morleyAesonOptions ''ViewName

instance HasCLReader ViewName where
  getReader :: ReadM ViewName
getReader = ([Char] -> Either [Char] ViewName) -> ReadM ViewName
forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader ((BadViewNameError -> [Char])
-> Either BadViewNameError ViewName -> Either [Char] ViewName
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first BadViewNameError -> [Char]
forall a b. (Buildable a, FromDoc b) => a -> b
pretty (Either BadViewNameError ViewName -> Either [Char] ViewName)
-> ([Char] -> Either BadViewNameError ViewName)
-> [Char]
-> Either [Char] ViewName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either BadViewNameError ViewName
mkViewName (Text -> Either BadViewNameError ViewName)
-> ([Char] -> Text) -> [Char] -> Either BadViewNameError ViewName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. ToText a => a -> Text
toText)
  getMetavar :: [Char]
getMetavar = [Char]
"VIEW NAME"

instance ToJSONKey ViewName where
  toJSONKey :: ToJSONKeyFunction ViewName
toJSONKey = (ViewName -> Text) -> ToJSONKeyFunction ViewName
forall a. (a -> Text) -> ToJSONKeyFunction a
AesonTypes.toJSONKeyText ViewName -> Text
unViewName

instance FromJSONKey ViewName where
  fromJSONKey :: FromJSONKeyFunction ViewName
fromJSONKey = (Text -> Parser ViewName) -> FromJSONKeyFunction ViewName
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
AesonTypes.FromJSONKeyTextParser ((Text -> Parser ViewName) -> FromJSONKeyFunction ViewName)
-> (Text -> Parser ViewName) -> FromJSONKeyFunction ViewName
forall a b. (a -> b) -> a -> b
$ (BadViewNameError -> Parser ViewName)
-> (ViewName -> Parser ViewName)
-> Either BadViewNameError ViewName
-> Parser ViewName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Parser ViewName
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ViewName)
-> (BadViewNameError -> [Char])
-> BadViewNameError
-> Parser ViewName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadViewNameError -> [Char]
forall a b. (Buildable a, FromDoc b) => a -> b
pretty) ViewName -> Parser ViewName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BadViewNameError ViewName -> Parser ViewName)
-> (Text -> Either BadViewNameError ViewName)
-> Text
-> Parser ViewName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either BadViewNameError ViewName
mkViewName

-- | Whether the given character is valid for a view.
isValidViewNameChar :: Char -> Bool
isValidViewNameChar :: Char -> Bool
isValidViewNameChar = [Char -> Bool] -> Element [Char -> Bool]
forall c.
(Container c, BooleanMonoid (Element c)) =>
c -> Element c
or
  [ Char -> Bool
isAsciiUpper
  , Char -> Bool
isAsciiLower
  , Char -> Bool
isDigit
  , (Element [Char] -> [Char] -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`elem` [Char
'_', Char
'.', Char
'%', Char
'@'])
  ]

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

data BadViewNameError
  = BadViewTooLong Int
  | BadViewIllegalChars Text
  deriving stock (Int -> BadViewNameError -> ShowS
[BadViewNameError] -> ShowS
BadViewNameError -> [Char]
(Int -> BadViewNameError -> ShowS)
-> (BadViewNameError -> [Char])
-> ([BadViewNameError] -> ShowS)
-> Show BadViewNameError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BadViewNameError -> ShowS
showsPrec :: Int -> BadViewNameError -> ShowS
$cshow :: BadViewNameError -> [Char]
show :: BadViewNameError -> [Char]
$cshowList :: [BadViewNameError] -> ShowS
showList :: [BadViewNameError] -> ShowS
Show, BadViewNameError -> BadViewNameError -> Bool
(BadViewNameError -> BadViewNameError -> Bool)
-> (BadViewNameError -> BadViewNameError -> Bool)
-> Eq BadViewNameError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BadViewNameError -> BadViewNameError -> Bool
== :: BadViewNameError -> BadViewNameError -> Bool
$c/= :: BadViewNameError -> BadViewNameError -> Bool
/= :: BadViewNameError -> BadViewNameError -> Bool
Eq, Eq BadViewNameError
Eq BadViewNameError
-> (BadViewNameError -> BadViewNameError -> Ordering)
-> (BadViewNameError -> BadViewNameError -> Bool)
-> (BadViewNameError -> BadViewNameError -> Bool)
-> (BadViewNameError -> BadViewNameError -> Bool)
-> (BadViewNameError -> BadViewNameError -> Bool)
-> (BadViewNameError -> BadViewNameError -> BadViewNameError)
-> (BadViewNameError -> BadViewNameError -> BadViewNameError)
-> Ord BadViewNameError
BadViewNameError -> BadViewNameError -> Bool
BadViewNameError -> BadViewNameError -> Ordering
BadViewNameError -> BadViewNameError -> BadViewNameError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BadViewNameError -> BadViewNameError -> Ordering
compare :: BadViewNameError -> BadViewNameError -> Ordering
$c< :: BadViewNameError -> BadViewNameError -> Bool
< :: BadViewNameError -> BadViewNameError -> Bool
$c<= :: BadViewNameError -> BadViewNameError -> Bool
<= :: BadViewNameError -> BadViewNameError -> Bool
$c> :: BadViewNameError -> BadViewNameError -> Bool
> :: BadViewNameError -> BadViewNameError -> Bool
$c>= :: BadViewNameError -> BadViewNameError -> Bool
>= :: BadViewNameError -> BadViewNameError -> Bool
$cmax :: BadViewNameError -> BadViewNameError -> BadViewNameError
max :: BadViewNameError -> BadViewNameError -> BadViewNameError
$cmin :: BadViewNameError -> BadViewNameError -> BadViewNameError
min :: BadViewNameError -> BadViewNameError -> BadViewNameError
Ord, Typeable BadViewNameError
Typeable BadViewNameError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> BadViewNameError -> c BadViewNameError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BadViewNameError)
-> (BadViewNameError -> Constr)
-> (BadViewNameError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BadViewNameError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BadViewNameError))
-> ((forall b. Data b => b -> b)
    -> BadViewNameError -> BadViewNameError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> BadViewNameError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BadViewNameError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> BadViewNameError -> m BadViewNameError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BadViewNameError -> m BadViewNameError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BadViewNameError -> m BadViewNameError)
-> Data BadViewNameError
BadViewNameError -> Constr
BadViewNameError -> DataType
(forall b. Data b => b -> b)
-> BadViewNameError -> BadViewNameError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> BadViewNameError -> u
forall u. (forall d. Data d => d -> u) -> BadViewNameError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BadViewNameError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BadViewNameError -> c BadViewNameError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BadViewNameError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BadViewNameError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BadViewNameError -> c BadViewNameError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BadViewNameError -> c BadViewNameError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BadViewNameError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BadViewNameError
$ctoConstr :: BadViewNameError -> Constr
toConstr :: BadViewNameError -> Constr
$cdataTypeOf :: BadViewNameError -> DataType
dataTypeOf :: BadViewNameError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BadViewNameError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BadViewNameError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BadViewNameError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BadViewNameError)
$cgmapT :: (forall b. Data b => b -> b)
-> BadViewNameError -> BadViewNameError
gmapT :: (forall b. Data b => b -> b)
-> BadViewNameError -> BadViewNameError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BadViewNameError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BadViewNameError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> BadViewNameError -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BadViewNameError -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BadViewNameError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BadViewNameError -> m BadViewNameError
Data, (forall x. BadViewNameError -> Rep BadViewNameError x)
-> (forall x. Rep BadViewNameError x -> BadViewNameError)
-> Generic BadViewNameError
forall x. Rep BadViewNameError x -> BadViewNameError
forall x. BadViewNameError -> Rep BadViewNameError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BadViewNameError -> Rep BadViewNameError x
from :: forall x. BadViewNameError -> Rep BadViewNameError x
$cto :: forall x. Rep BadViewNameError x -> BadViewNameError
to :: forall x. Rep BadViewNameError x -> BadViewNameError
Generic)
  deriving anyclass (BadViewNameError -> ()
(BadViewNameError -> ()) -> NFData BadViewNameError
forall a. (a -> ()) -> NFData a
$crnf :: BadViewNameError -> ()
rnf :: BadViewNameError -> ()
NFData)

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

-- | Construct t'ViewName' performing all the checks.
mkViewName :: Text -> Either BadViewNameError ViewName
mkViewName :: Text -> Either BadViewNameError ViewName
mkViewName Text
txt = do
  Bool -> Either BadViewNameError () -> Either BadViewNameError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length Text
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
viewNameMaxLength) (Either BadViewNameError () -> Either BadViewNameError ())
-> Either BadViewNameError () -> Either BadViewNameError ()
forall a b. (a -> b) -> a -> b
$
    BadViewNameError -> Either BadViewNameError ()
forall a. BadViewNameError -> Either BadViewNameError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Int -> BadViewNameError
BadViewTooLong (Int -> BadViewNameError) -> Int -> BadViewNameError
forall a b. (a -> b) -> a -> b
$ Text -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length Text
txt)
  Bool -> Either BadViewNameError () -> Either BadViewNameError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
isValidViewNameChar Text
txt) (Either BadViewNameError () -> Either BadViewNameError ())
-> Either BadViewNameError () -> Either BadViewNameError ()
forall a b. (a -> b) -> a -> b
$
    BadViewNameError -> Either BadViewNameError ()
forall a. BadViewNameError -> Either BadViewNameError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> BadViewNameError
BadViewIllegalChars Text
txt)
  return (Text -> ViewName
UnsafeViewName Text
txt)

renderViewName :: ViewName -> Doc
renderViewName :: ViewName -> Doc
renderViewName = Doc -> Doc
forall ann. Doc ann -> Doc ann
dquotes (Doc -> Doc) -> (ViewName -> Doc) -> ViewName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (ViewName -> Text) -> ViewName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewName -> Text
unViewName

instance RenderDoc ViewName where
  renderDoc :: RenderContext -> ViewName -> Doc
renderDoc RenderContext
_ = ViewName -> Doc
renderViewName

-- | Valid view names form a subset of valid Michelson texts.
viewNameToMText :: ViewName -> MText
viewNameToMText :: ViewName -> MText
viewNameToMText = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (ViewName -> Either Text MText) -> ViewName -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (ViewName -> Text) -> ViewName -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewName -> Text
unViewName