{-# LANGUAGE StrictData #-}

module Sq.Names
   ( Name
   , name
   , BindingName
   , bindingName
   , renderInputBindingName
   , parseInputBindingName
   , renderOutputBindingName
   , parseOutputBindingName
   ) where

import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Data.Aeson qualified as Ae
import Data.Attoparsec.Text qualified as AT
import Data.Char qualified as Ch
import Data.Coerce
import Data.List.NonEmpty (NonEmpty (..))
import Data.String
import Data.Text qualified as T
import GHC.Records

--------------------------------------------------------------------------------

-- | Part of a binding name suitable to use with 'Sq.encode', 'Sq.decode',
-- 'Sq.input' and 'Sq.output'.
--
-- Construct with 'name' or 'IsString'.
newtype Name = Name T.Text
   deriving newtype (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, Name -> ()
(Name -> ()) -> NFData Name
forall a. (a -> ()) -> NFData a
$crnf :: Name -> ()
rnf :: Name -> ()
NFData, [Name] -> Value
[Name] -> Encoding
Name -> Bool
Name -> Value
Name -> Encoding
(Name -> Value)
-> (Name -> Encoding)
-> ([Name] -> Value)
-> ([Name] -> Encoding)
-> (Name -> Bool)
-> ToJSON Name
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Name -> Value
toJSON :: Name -> Value
$ctoEncoding :: Name -> Encoding
toEncoding :: Name -> Encoding
$ctoJSONList :: [Name] -> Value
toJSONList :: [Name] -> Value
$ctoEncodingList :: [Name] -> Encoding
toEncodingList :: [Name] -> Encoding
$comitField :: Name -> Bool
omitField :: Name -> Bool
Ae.ToJSON)

instance IsString Name where
   fromString :: String -> Name
fromString = (String -> Name) -> (Name -> Name) -> Either String Name -> Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Name
forall a. HasCallStack => String -> a
error Name -> Name
forall a. a -> a
id (Either String Name -> Name)
-> (String -> Either String Name) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Name
name (Text -> Either String Name)
-> (String -> Text) -> String -> Either String Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Ae.FromJSON Name where
   parseJSON :: Value -> Parser Name
parseJSON = String -> (Text -> Parser Name) -> Value -> Parser Name
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Ae.withText String
"Name" ((String -> Parser Name)
-> (Name -> Parser Name) -> Either String Name -> Parser Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Name
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Name -> Parser Name
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Name -> Parser Name)
-> (Text -> Either String Name) -> Text -> Parser Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Name
name)

instance HasField "text" Name T.Text where getField :: Name -> Text
getField = Name -> Text
forall a b. Coercible a b => a -> b
coerce

-- | * First character must be ASCII letter.
--
-- * Last character, if any, must be ASCII letter or ASCII digit.
--
-- * Characters between the first and last, if any, must be ASCII letters,
-- ASCII digits, or underscore.
name :: T.Text -> Either String Name
name :: Text -> Either String Name
name = Parser Name -> Text -> Either String Name
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser Name
pName Parser Name -> Parser Text () -> Parser Name
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput)

pName :: AT.Parser Name
pName :: Parser Name
pName = (Parser Name -> String -> Parser Name)
-> String -> Parser Name -> Parser Name
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser Name -> String -> Parser Name
forall i a. Parser i a -> String -> Parser i a
(AT.<?>) String
"pName" do
   Char
c1 <- (Char -> Bool) -> Parser Char
AT.satisfy Char -> Bool
pw
   String
cs <- Parser Text String
ptail
   Name -> Parser Name
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Parser Name) -> Name -> Parser Name
forall a b. (a -> b) -> a -> b
$ Text -> Name
Name (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Char
c1 Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs)
  where
   pw :: Char -> Bool
pw = \Char
c -> Char -> Bool
Ch.isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
Ch.isAsciiUpper Char
c
   ptail :: Parser Text String
ptail = Parser Char -> Parser Text String
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many do
      (Char -> Bool) -> Parser Char
AT.satisfy Char -> Bool
pw
         Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Char
AT.satisfy Char -> Bool
Ch.isDigit
         Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
AT.char Char
'_' Parser Char -> Parser Text () -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Char
AT.peekChar' Parser Char -> (Char -> Parser Text ()) -> Parser Text ()
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_')))

--------------------------------------------------------------------------------

-- | A non-empty list of 'Name's that can be rendered as 'Sq.Input' or
-- 'Sq.Output' parameters in a 'Sq.Statement'.
--
-- As a user of "Sq", you never construct a 'BindingName' manually. Rather,
-- uses of 'Sq.input' and 'Sq.output' build one for you from its 'Name'
-- constituents. 'BindingName's are only exposed to you through 'Sq.ErrInput',
-- 'Sq.ErrOutput' and 'Sq.ErrStatement'.
newtype BindingName = BindingName (NonEmpty Name)
   deriving newtype (BindingName -> BindingName -> Bool
(BindingName -> BindingName -> Bool)
-> (BindingName -> BindingName -> Bool) -> Eq BindingName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindingName -> BindingName -> Bool
== :: BindingName -> BindingName -> Bool
$c/= :: BindingName -> BindingName -> Bool
/= :: BindingName -> BindingName -> Bool
Eq, Eq BindingName
Eq BindingName =>
(BindingName -> BindingName -> Ordering)
-> (BindingName -> BindingName -> Bool)
-> (BindingName -> BindingName -> Bool)
-> (BindingName -> BindingName -> Bool)
-> (BindingName -> BindingName -> Bool)
-> (BindingName -> BindingName -> BindingName)
-> (BindingName -> BindingName -> BindingName)
-> Ord BindingName
BindingName -> BindingName -> Bool
BindingName -> BindingName -> Ordering
BindingName -> BindingName -> BindingName
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 :: BindingName -> BindingName -> Ordering
compare :: BindingName -> BindingName -> Ordering
$c< :: BindingName -> BindingName -> Bool
< :: BindingName -> BindingName -> Bool
$c<= :: BindingName -> BindingName -> Bool
<= :: BindingName -> BindingName -> Bool
$c> :: BindingName -> BindingName -> Bool
> :: BindingName -> BindingName -> Bool
$c>= :: BindingName -> BindingName -> Bool
>= :: BindingName -> BindingName -> Bool
$cmax :: BindingName -> BindingName -> BindingName
max :: BindingName -> BindingName -> BindingName
$cmin :: BindingName -> BindingName -> BindingName
min :: BindingName -> BindingName -> BindingName
Ord, Int -> BindingName -> ShowS
[BindingName] -> ShowS
BindingName -> String
(Int -> BindingName -> ShowS)
-> (BindingName -> String)
-> ([BindingName] -> ShowS)
-> Show BindingName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BindingName -> ShowS
showsPrec :: Int -> BindingName -> ShowS
$cshow :: BindingName -> String
show :: BindingName -> String
$cshowList :: [BindingName] -> ShowS
showList :: [BindingName] -> ShowS
Show, BindingName -> ()
(BindingName -> ()) -> NFData BindingName
forall a. (a -> ()) -> NFData a
$crnf :: BindingName -> ()
rnf :: BindingName -> ()
NFData, NonEmpty BindingName -> BindingName
BindingName -> BindingName -> BindingName
(BindingName -> BindingName -> BindingName)
-> (NonEmpty BindingName -> BindingName)
-> (forall b. Integral b => b -> BindingName -> BindingName)
-> Semigroup BindingName
forall b. Integral b => b -> BindingName -> BindingName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: BindingName -> BindingName -> BindingName
<> :: BindingName -> BindingName -> BindingName
$csconcat :: NonEmpty BindingName -> BindingName
sconcat :: NonEmpty BindingName -> BindingName
$cstimes :: forall b. Integral b => b -> BindingName -> BindingName
stimes :: forall b. Integral b => b -> BindingName -> BindingName
Semigroup)

bindingName :: Name -> BindingName
bindingName :: Name -> BindingName
bindingName = NonEmpty Name -> BindingName
BindingName (NonEmpty Name -> BindingName)
-> (Name -> NonEmpty Name) -> Name -> BindingName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NonEmpty Name
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

--------------------------------------------------------------------------------

-- | @foo__bar3__the_thing@
renderInputBindingName :: BindingName -> T.Text
renderInputBindingName :: BindingName -> Text
renderInputBindingName = Char -> Text -> Text
T.cons Char
'$' (Text -> Text) -> (BindingName -> Text) -> BindingName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BindingName -> Text
renderOutputBindingName

parseInputBindingName :: T.Text -> Either String BindingName
parseInputBindingName :: Text -> Either String BindingName
parseInputBindingName = Parser BindingName -> Text -> Either String BindingName
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser BindingName
pInputBindingName Parser BindingName -> Parser Text () -> Parser BindingName
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput)

pInputBindingName :: AT.Parser BindingName
pInputBindingName :: Parser BindingName
pInputBindingName = (Parser BindingName -> String -> Parser BindingName)
-> String -> Parser BindingName -> Parser BindingName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser BindingName -> String -> Parser BindingName
forall i a. Parser i a -> String -> Parser i a
(AT.<?>) String
"pInputBindingName" do
   Parser Char -> Parser Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
'$'
   Parser Name -> Parser Text Text -> Parser Text [Name]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
AT.sepBy' Parser Name
pName Parser Text Text
"__" Parser Text [Name]
-> ([Name] -> Parser BindingName) -> Parser BindingName
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Name
n : [Name]
ns -> BindingName -> Parser BindingName
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BindingName -> Parser BindingName)
-> BindingName -> Parser BindingName
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> BindingName
BindingName (Name
n Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
:| [Name]
ns)
      [] -> Parser BindingName
forall a. Parser Text a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | @foo__bar3__the_thing@
renderOutputBindingName :: BindingName -> T.Text
renderOutputBindingName :: BindingName -> Text
renderOutputBindingName (BindingName (Name
n :| [Name]
ns)) =
   Text -> [Text] -> Text
T.intercalate Text
"__" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.text) (Name
n Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
ns)

-- | @foo__bar3__the_thing@
parseOutputBindingName :: T.Text -> Either String BindingName
parseOutputBindingName :: Text -> Either String BindingName
parseOutputBindingName = Parser BindingName -> Text -> Either String BindingName
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser BindingName
pOutputBindingName Parser BindingName -> Parser Text () -> Parser BindingName
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
AT.endOfInput)

pOutputBindingName :: AT.Parser BindingName
pOutputBindingName :: Parser BindingName
pOutputBindingName = (Parser BindingName -> String -> Parser BindingName)
-> String -> Parser BindingName -> Parser BindingName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser BindingName -> String -> Parser BindingName
forall i a. Parser i a -> String -> Parser i a
(AT.<?>) String
"pOutputBindingName" do
   Parser Name -> Parser Text Text -> Parser Text [Name]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
AT.sepBy' Parser Name
pName Parser Text Text
"__" Parser Text [Name]
-> ([Name] -> Parser BindingName) -> Parser BindingName
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Name
n : [Name]
ns -> BindingName -> Parser BindingName
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BindingName -> Parser BindingName)
-> BindingName -> Parser BindingName
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> BindingName
BindingName (Name
n Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
:| [Name]
ns)
      [] -> Parser BindingName
forall a. Parser Text a
forall (f :: * -> *) a. Alternative f => f a
empty