{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module FlatBuffers.Internal.Compiler.NamingConventions where

import qualified Data.Set                                      as Set
import           Data.Text                                     ( Text )
import qualified Data.Text                                     as T
import qualified Data.Text.Manipulate                          as TM

import           FlatBuffers.Internal.Compiler.ValidSyntaxTree ( EnumDecl, EnumVal, HasIdent(..), Ident(..), Namespace(..), UnionDecl, UnionVal )

-- Style guide: https://google.github.io/flatbuffers/flatbuffers_guide_writing_schema.html

dataTypeConstructor :: HasIdent a => a -> Text
dataTypeConstructor :: a -> Text
dataTypeConstructor = Text -> Text
replaceKeyword (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TM.toCamel (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
unIdent (Ident -> Text) -> (a -> Ident) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ident
forall a. HasIdent a => a -> Ident
getIdent

arg :: HasIdent a => a -> Text
arg :: a -> Text
arg = Text -> Text
TM.toCamel (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
unIdent (Ident -> Text) -> (a -> Ident) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ident
forall a. HasIdent a => a -> Ident
getIdent

dataTypeName :: HasIdent a => a -> Text
dataTypeName :: a -> Text
dataTypeName = Text -> Text
TM.toPascal (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
unIdent (Ident -> Text) -> (a -> Ident) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ident
forall a. HasIdent a => a -> Ident
getIdent

namespace :: Namespace -> Text
namespace :: Namespace -> Text
namespace (Namespace [Text]
fragments) = Text -> [Text] -> Text
T.intercalate Text
"." (Text -> Text
TM.toPascal (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
fragments)

getter :: (HasIdent parent, HasIdent field) => parent -> field -> Text
getter :: parent -> field -> Text
getter (parent -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
parent) (field -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
field) =
  Text -> Text
TM.toCamel Text
parent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal Text
field

toEnumFun :: EnumDecl -> Text
toEnumFun :: EnumDecl -> Text
toEnumFun EnumDecl
enum =
  Text
"to" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal (Ident -> Text
unIdent (EnumDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent EnumDecl
enum))

fromEnumFun :: EnumDecl -> Text
fromEnumFun :: EnumDecl -> Text
fromEnumFun EnumDecl
enum =
  Text
"from" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal (Ident -> Text
unIdent (EnumDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent EnumDecl
enum))

enumUnionMember :: (HasIdent parent, HasIdent val) => parent -> val -> Text
enumUnionMember :: parent -> val -> Text
enumUnionMember (parent -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
parentIdent) (val -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
valIdent) =
  Text -> Text
TM.toPascal Text
parentIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal Text
valIdent

enumBitFlagsConstant :: EnumDecl -> EnumVal -> Text
enumBitFlagsConstant :: EnumDecl -> EnumVal -> Text
enumBitFlagsConstant (EnumDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
enumIdent) (EnumVal -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
enumValIdent) =
  Text -> Text
TM.toCamel Text
enumIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal Text
enumValIdent

enumBitFlagsAllFun :: EnumDecl -> Text
enumBitFlagsAllFun :: EnumDecl -> Text
enumBitFlagsAllFun (EnumDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
enumIdent) =
  Text
"all" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal Text
enumIdent

enumBitFlagsNamesFun :: EnumDecl -> Text
enumBitFlagsNamesFun :: EnumDecl -> Text
enumBitFlagsNamesFun (EnumDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
enumIdent) =
  Text -> Text
TM.toCamel Text
enumIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Names"

enumNameFun :: EnumDecl -> Text
enumNameFun :: EnumDecl -> Text
enumNameFun (EnumDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
enumIdent) =
  Text -> Text
TM.toCamel Text
enumIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Name"

unionConstructor :: UnionDecl -> UnionVal -> Text
unionConstructor :: UnionDecl -> UnionVal -> Text
unionConstructor (UnionDecl -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
unionIdent) (UnionVal -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
unionValIdent) =
  Text -> Text
TM.toCamel Text
unionIdent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal Text
unionValIdent

readUnionFun :: HasIdent union => union -> Text
readUnionFun :: union -> Text
readUnionFun (union -> Ident
forall a. HasIdent a => a -> Ident
getIdent -> Ident Text
unionIdent) =
  Text
"read" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
TM.toPascal Text
unionIdent

withModulePrefix :: Namespace -> Text -> Text
withModulePrefix :: Namespace -> Text -> Text
withModulePrefix Namespace
ns Text
text =
  if Namespace
ns Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Namespace
""
    then Text
text
    else Namespace -> Text
namespace Namespace
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text

keywords :: Set.Set Text
keywords :: Set Text
keywords = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList
  [ Text
"as" , Text
"case", Text
"class", Text
"data", Text
"default", Text
"deriving", Text
"do"
  , Text
"else", Text
"hiding", Text
"if", Text
"import", Text
"in", Text
"infix", Text
"infixl"
  , Text
"infixr", Text
"instance", Text
"let", Text
"module", Text
"newtype", Text
"of", Text
"qualified"
  , Text
"then", Text
"type", Text
"where", Text
"forall", Text
"mdo", Text
"family", Text
"role"
  , Text
"pattern", Text
"static", Text
"stock", Text
"anyclass", Text
"via", Text
"group", Text
"by"
  , Text
"using", Text
"foreign", Text
"export", Text
"label", Text
"dynamic", Text
"safe"
  , Text
"interruptible", Text
"unsafe", Text
"stdcall", Text
"ccall", Text
"capi", Text
"prim"
  , Text
"javascript", Text
"unit", Text
"dependency", Text
"signature", Text
"rec", Text
"proc"
  ]

replaceKeyword :: Text -> Text
replaceKeyword :: Text -> Text
replaceKeyword Text
x
  | Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
keywords = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
  | Bool
otherwise = Text
x