{-# options_haddock prune #-}

-- |Internal combinators for syntax.
module Ribosome.Internal.Syntax where

import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import Exon (exon)

import Ribosome.Data.Syntax (
  HiLink (HiLink),
  Highlight (Highlight),
  Syntax (Syntax),
  SyntaxItem (SyntaxItem),
  SyntaxItemDetail (Keyword, Match, Region, Verbatim),
  )
import qualified Ribosome.Host.Api.Data as Data
import Ribosome.Host.Data.RpcCall (RpcCall)

joinEquals :: Map Text Text -> Text
joinEquals :: Map Text Text -> Text
joinEquals =
  [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords ([Text] -> Text)
-> (Map Text Text -> [Text]) -> Map Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> Text
forall {a}. Exon ExonDefault a => (a, a) -> a
equals ([(Text, Text)] -> [Text])
-> (Map Text Text -> [(Text, Text)]) -> Map Text Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList
  where
    equals :: (a, a) -> a
equals (a
a, a
b) =
      [exon|#{a}=#{b}|]

synPattern :: Text -> Text
synPattern :: Text -> Text
synPattern Text
pat =
  [exon|/#{pat}/|]

namedPattern :: Text -> Text -> Text -> Text
namedPattern :: Text -> Text -> Text -> Text
namedPattern Text
param Text
pat Text
offset =
  [exon|#{param}=#{synPattern pat}#{offset}|]

syntaxItemDetailCmd :: SyntaxItemDetail -> [Text]
syntaxItemDetailCmd :: SyntaxItemDetail -> [Text]
syntaxItemDetailCmd (Keyword Text
group' Text
keyword [Text]
keywords) =
  [Item [Text]
"syntax", Item [Text]
"keyword", Text
Item [Text]
group', Text
Item [Text]
keyword, [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords [Text]
keywords]
syntaxItemDetailCmd (Match Text
group' Text
pat) =
  [Item [Text]
"syntax", Item [Text]
"match", Text
Item [Text]
group', Text -> Text
synPattern Text
pat]
syntaxItemDetailCmd (Region Text
group' Text
start Text
end Maybe Text
skip Text
ms Text
me) =
  [Item [Text]
"syntax", Item [Text]
"region", Text
Item [Text]
group', Text -> Text -> Text -> Text
namedPattern Text
"start" Text
start Text
ms] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text]) -> Maybe Text -> [Text]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> [Text]
forall {l}. (IsList l, Item l ~ Text) => Text -> l
skipArg Maybe Text
skip [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Text -> Text -> Text
namedPattern Text
"end" Text
end Text
me]
  where
    skipArg :: Text -> l
skipArg Text
a = [Text -> Text -> Text -> Text
namedPattern Text
"skip" Text
a Text
""]
syntaxItemDetailCmd (Verbatim Text
cmd) =
  [Text
Item [Text]
cmd]

syntaxItemCmd :: SyntaxItem -> [Text]
syntaxItemCmd :: SyntaxItem -> [Text]
syntaxItemCmd (SyntaxItem SyntaxItemDetail
detail [Text]
options Map Text Text
params) =
  SyntaxItemDetail -> [Text]
syntaxItemDetailCmd SyntaxItemDetail
detail [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [[Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords [Text]
options, Map Text Text -> Text
joinEquals Map Text Text
params]

highlightCmd :: Highlight -> [Text]
highlightCmd :: Highlight -> [Text]
highlightCmd (Highlight Text
group' Map Text Text
values) =
  [Item [Text]
"highlight", Item [Text]
"default", Text
Item [Text]
group', Map Text Text -> Text
joinEquals Map Text Text
values]

hilinkCmd :: HiLink -> [Text]
hilinkCmd :: HiLink -> [Text]
hilinkCmd (HiLink Text
group' Text
target) =
  [Item [Text]
"highlight", Item [Text]
"default", Item [Text]
"link", Text
Item [Text]
group', Text
Item [Text]
target]

syntaxCmds :: Syntax -> [[Text]]
syntaxCmds :: Syntax -> [[Text]]
syntaxCmds (Syntax [SyntaxItem]
items [Highlight]
highlights [HiLink]
hilinks) =
  (SyntaxItem -> [Text]
syntaxItemCmd (SyntaxItem -> [Text]) -> [SyntaxItem] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SyntaxItem]
items) [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> (Highlight -> [Text]
highlightCmd (Highlight -> [Text]) -> [Highlight] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Highlight]
highlights) [[Text]] -> [[Text]] -> [[Text]]
forall a. Semigroup a => a -> a -> a
<> (HiLink -> [Text]
hilinkCmd (HiLink -> [Text]) -> [HiLink] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HiLink]
hilinks)

catCmd :: [Text] -> RpcCall ()
catCmd :: [Text] -> RpcCall ()
catCmd =
  Text -> RpcCall ()
Data.nvimCommand (Text -> RpcCall ()) -> ([Text] -> Text) -> [Text] -> RpcCall ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unwords

catCmds :: [[Text]] -> RpcCall ()
catCmds :: [[Text]] -> RpcCall ()
catCmds =
  ([Text] -> RpcCall ()) -> [[Text]] -> RpcCall ()
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Text] -> RpcCall ()
catCmd