{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Text.EDE.Internal.Syntax
-- Copyright   : (c) 2013-2020 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!
module Text.EDE.Internal.Syntax where

import Control.Lens ((.~))
import Data.Function ((&))
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Text.EDE.Internal.Types
import Text.Parser.Token.Style (CommentStyle)
import qualified Text.Parser.Token.Style as Token
import Text.Trifecta (IdentifierStyle, TokenParsing)
import qualified Text.Trifecta as Trifecta

-- | The default ED-E syntax.
--
-- Delimiters:
--
-- * Pragma: @{! ... !}@
--
-- * Inline: @{{ ... }}@
--
-- * Comments: @{# ... #}@
--
-- * Blocks: @{% ... %}@
defaultSyntax :: Syntax
defaultSyntax :: Syntax
defaultSyntax =
  Syntax :: Delim -> Delim -> Delim -> Delim -> Syntax
Syntax
    { _delimPragma :: Delim
_delimPragma = (String
"{!", String
"!}"),
      _delimInline :: Delim
_delimInline = (String
"{{", String
"}}"),
      _delimComment :: Delim
_delimComment = (String
"{#", String
"#}"),
      _delimBlock :: Delim
_delimBlock = (String
"{%", String
"%}")
    }

-- | An alternate syntax (based on Play/Scala templates) designed to
-- be used when the default is potentially ambiguous due to another encountered
-- smarty based syntax.
--
-- Delimiters:
--
-- * Inline: @\<\@ ... \@>@
--
-- * Comments: @\@* ... *\@@
--
-- * Blocks: @\@( ... )\@@
alternateSyntax :: Syntax
alternateSyntax :: Syntax
alternateSyntax =
  Syntax :: Delim -> Delim -> Delim -> Delim -> Syntax
Syntax
    { _delimPragma :: Delim
_delimPragma = (String
"@!", String
"!@"),
      _delimInline :: Delim
_delimInline = (String
"<@", String
"@>"),
      _delimComment :: Delim
_delimComment = (String
"@*", String
"*@"),
      _delimBlock :: Delim
_delimBlock = (String
"@(", String
")@")
    }

commentStyle :: String -> String -> CommentStyle
commentStyle :: String -> String -> CommentStyle
commentStyle String
s String
e =
  CommentStyle
Token.emptyCommentStyle CommentStyle -> (CommentStyle -> CommentStyle) -> CommentStyle
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> CommentStyle -> Identity CommentStyle
forall (f :: * -> *).
Functor f =>
(String -> f String) -> CommentStyle -> f CommentStyle
Token.commentStart ((String -> Identity String)
 -> CommentStyle -> Identity CommentStyle)
-> String -> CommentStyle -> CommentStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
s CommentStyle -> (CommentStyle -> CommentStyle) -> CommentStyle
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> CommentStyle -> Identity CommentStyle
forall (f :: * -> *).
Functor f =>
(String -> f String) -> CommentStyle -> f CommentStyle
Token.commentEnd ((String -> Identity String)
 -> CommentStyle -> Identity CommentStyle)
-> String -> CommentStyle -> CommentStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
e

operatorStyle :: TokenParsing m => IdentifierStyle m
operatorStyle :: IdentifierStyle m
operatorStyle =
  IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
Token.haskellOps IdentifierStyle m
-> (IdentifierStyle m -> IdentifierStyle m) -> IdentifierStyle m
forall a b. a -> (a -> b) -> b
& (m Char -> Identity (m Char))
-> IdentifierStyle m -> Identity (IdentifierStyle m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(m Char -> f (m Char))
-> IdentifierStyle m -> f (IdentifierStyle m)
Trifecta.styleLetter ((m Char -> Identity (m Char))
 -> IdentifierStyle m -> Identity (IdentifierStyle m))
-> m Char -> IdentifierStyle m -> IdentifierStyle m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
Trifecta.oneOf String
"-+!&|=><"

variableStyle :: TokenParsing m => IdentifierStyle m
variableStyle :: IdentifierStyle m
variableStyle =
  IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
keywordStyle IdentifierStyle m
-> (IdentifierStyle m -> IdentifierStyle m) -> IdentifierStyle m
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> IdentifierStyle m -> Identity (IdentifierStyle m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(String -> f String) -> IdentifierStyle m -> f (IdentifierStyle m)
Trifecta.styleName ((String -> Identity String)
 -> IdentifierStyle m -> Identity (IdentifierStyle m))
-> String -> IdentifierStyle m -> IdentifierStyle m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
"variable"

keywordStyle :: TokenParsing m => IdentifierStyle m
keywordStyle :: IdentifierStyle m
keywordStyle =
  IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
Token.haskellIdents
    IdentifierStyle m
-> (IdentifierStyle m -> IdentifierStyle m) -> IdentifierStyle m
forall a b. a -> (a -> b) -> b
& (HashSet String -> Identity (HashSet String))
-> IdentifierStyle m -> Identity (IdentifierStyle m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(HashSet String -> f (HashSet String))
-> IdentifierStyle m -> f (IdentifierStyle m)
Trifecta.styleReserved ((HashSet String -> Identity (HashSet String))
 -> IdentifierStyle m -> Identity (IdentifierStyle m))
-> HashSet String -> IdentifierStyle m -> IdentifierStyle m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashSet String
keywordSet
    IdentifierStyle m
-> (IdentifierStyle m -> IdentifierStyle m) -> IdentifierStyle m
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> IdentifierStyle m -> Identity (IdentifierStyle m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(String -> f String) -> IdentifierStyle m -> f (IdentifierStyle m)
Trifecta.styleName ((String -> Identity String)
 -> IdentifierStyle m -> Identity (IdentifierStyle m))
-> String -> IdentifierStyle m -> IdentifierStyle m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
"keyword"

keywordSet :: HashSet String
keywordSet :: HashSet String
keywordSet =
  [String] -> HashSet String
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
    [ String
"if",
      String
"elif",
      String
"else",
      String
"case",
      String
"when",
      String
"for",
      String
"include",
      String
"let",
      String
"endif",
      String
"endcase",
      String
"endfor",
      String
"endlet",
      String
"in",
      String
"with",
      String
"_",
      String
".",
      String
"true",
      String
"false"
    ]

pragmaStyle :: TokenParsing m => IdentifierStyle m
pragmaStyle :: IdentifierStyle m
pragmaStyle =
  IdentifierStyle m
forall (m :: * -> *). TokenParsing m => IdentifierStyle m
Token.haskellIdents
    IdentifierStyle m
-> (IdentifierStyle m -> IdentifierStyle m) -> IdentifierStyle m
forall a b. a -> (a -> b) -> b
& (HashSet String -> Identity (HashSet String))
-> IdentifierStyle m -> Identity (IdentifierStyle m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(HashSet String -> f (HashSet String))
-> IdentifierStyle m -> f (IdentifierStyle m)
Trifecta.styleReserved ((HashSet String -> Identity (HashSet String))
 -> IdentifierStyle m -> Identity (IdentifierStyle m))
-> HashSet String -> IdentifierStyle m -> IdentifierStyle m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HashSet String
pragmaSet
    IdentifierStyle m
-> (IdentifierStyle m -> IdentifierStyle m) -> IdentifierStyle m
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> IdentifierStyle m -> Identity (IdentifierStyle m)
forall (f :: * -> *) (m :: * -> *).
Functor f =>
(String -> f String) -> IdentifierStyle m -> f (IdentifierStyle m)
Trifecta.styleName ((String -> Identity String)
 -> IdentifierStyle m -> Identity (IdentifierStyle m))
-> String -> IdentifierStyle m -> IdentifierStyle m
forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
"pragma field"

pragmaSet :: HashSet String
pragmaSet :: HashSet String
pragmaSet =
  [String] -> HashSet String
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList
    [ String
"pragma",
      String
"inline",
      String
"comment",
      String
"block"
    ]