module Proteome.Buffers.Syntax where

import qualified Data.Map.Strict as Map (fromList)
import Ribosome.Data.SyntaxItem (SyntaxItem (options, params))
import Ribosome.Syntax (HiLink (HiLink), Syntax (Syntax), syntaxMatch, syntaxVerbatim)
import Text.RawString.QQ (r)

asterisk :: SyntaxItem
asterisk :: SyntaxItem
asterisk =
  SyntaxItem
item {[Text]
options :: [Text]
$sel:options:SyntaxItem :: [Text]
options, Map Text Text
params :: Map Text Text
$sel:params:SyntaxItem :: Map Text Text
params}
  where
    item :: SyntaxItem
item = SyntaxGroup -> Text -> SyntaxItem
syntaxMatch SyntaxGroup
"ProBuffersAsterisk" [r|^ \*|]
    options :: [Text]
options = [Item [Text]
"skipwhite"]
    params :: Map Text Text
params = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"nextgroup", Text
"ProBuffersNumber")]

number :: SyntaxItem
number :: SyntaxItem
number =
  SyntaxItem
item {[Text]
options :: [Text]
$sel:options:SyntaxItem :: [Text]
options, Map Text Text
params :: Map Text Text
$sel:params:SyntaxItem :: Map Text Text
params}
  where
    item :: SyntaxItem
item = SyntaxGroup -> Text -> SyntaxItem
syntaxMatch SyntaxGroup
"ProBuffersNumber" [r|\d\+|]
    options :: [Text]
options = [Item [Text]
"contained", Item [Text]
"skipwhite"]
    params :: Map Text Text
params = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"nextgroup", Text
"ProBuffersName")]

line :: SyntaxItem
line :: SyntaxItem
line =
  SyntaxItem
item {[Text]
options :: [Text]
$sel:options:SyntaxItem :: [Text]
options}
  where
    item :: SyntaxItem
item = SyntaxGroup -> Text -> SyntaxItem
syntaxMatch SyntaxGroup
"ProBuffersName" Text
".*$"
    options :: [Text]
options = [Item [Text]
"contained"]

sync :: SyntaxItem
sync :: SyntaxItem
sync =
  Text -> SyntaxItem
syntaxVerbatim Text
"syntax sync minlines=1"

hlAsterisk :: HiLink
hlAsterisk :: HiLink
hlAsterisk =
  SyntaxGroup -> SyntaxGroup -> HiLink
HiLink SyntaxGroup
"ProBuffersAsterisk" SyntaxGroup
"Todo"

hlNumber :: HiLink
hlNumber :: HiLink
hlNumber =
  SyntaxGroup -> SyntaxGroup -> HiLink
HiLink SyntaxGroup
"ProBuffersNumber" SyntaxGroup
"Directory"

hlName :: HiLink
hlName :: HiLink
hlName =
  SyntaxGroup -> SyntaxGroup -> HiLink
HiLink SyntaxGroup
"ProBuffersName" SyntaxGroup
"Type"

buffersSyntax :: Syntax
buffersSyntax :: Syntax
buffersSyntax =
  [SyntaxItem] -> [Highlight] -> [HiLink] -> Syntax
Syntax [SyntaxItem]
items [] [HiLink]
links
  where
    items :: [SyntaxItem]
items =
      [Item [SyntaxItem]
SyntaxItem
asterisk, Item [SyntaxItem]
SyntaxItem
number, Item [SyntaxItem]
SyntaxItem
line, Item [SyntaxItem]
SyntaxItem
sync]
    links :: [HiLink]
links =
      [Item [HiLink]
HiLink
hlAsterisk, Item [HiLink]
HiLink
hlNumber, Item [HiLink]
HiLink
hlName]