{-# 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.List.NonEmpty (NonEmpty(..))
import Data.Attoparsec.Text qualified as AT
import Data.Char qualified as Ch
import Data.Coerce
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)

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 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