branch: elpa/haskell-tng-mode
commit 49611c613f26ac342599e570c672fe0b892cca52
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
regression tests for fontification
---
Cask | 2 +
haskell-tng-font-lock.el | 26 ++++----
haskell-tng-mode.el | 6 +-
test/faces/medley.hs | 127 +++++++++++++++++++++++++++++++++++++
test/faces/medley.hs.faceup | 127 +++++++++++++++++++++++++++++++++++++
test/haskell-tng-font-lock-test.el | 22 +++++++
6 files changed, 292 insertions(+), 18 deletions(-)
diff --git a/Cask b/Cask
index 26fb0f0..4f3f54c 100644
--- a/Cask
+++ b/Cask
@@ -20,10 +20,12 @@
;;; Code:
(source melpa-stable)
+(source melpa) ;; for faceup
(package-file "haskell-tng-mode.el")
(development
+ (depends-on "faceup")
(depends-on "ert-runner")
(depends-on "undercover"))
diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index 24fc9cb..117af4f 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -34,9 +34,6 @@
;;
;;; Code:
-;; TODO: regression tests https://github.com/Lindydancer/faceup
-;; TODO use levels so users can turn off type fontification
-
(require 'dash)
(require 'haskell-tng-util)
@@ -73,7 +70,8 @@
;; Here are `rx' patterns that are reused as a very simple form of BNF grammar
(defconst haskell-tng:rx:conid '(: upper (* wordchar)))
(defconst haskell-tng:rx:qual `(: (+ (: ,haskell-tng:rx:conid (char ?.)))))
-(defconst haskell-tng:rx:consym '(: ":" (+ (syntax symbol)))) ;; TODO exclude
::, limited symbol set
+(defconst haskell-tng:rx:consym '(: ":" (+ (syntax symbol))))
+;; TODO restrictive consym, e.g. no :: , @
(defconst haskell-tng:rx:toplevel
`(: line-start (group (| (: (any lower ?_) (* wordchar))
(: "(" (+? (syntax symbol)) ")")))
@@ -114,9 +112,10 @@
(: symbol-start (char ?\\))))
. 'haskell-tng:keyword)
- ;; some things look nicer without faces
+ ;; Some things are not technically keywords but are always special so make
+ ;; sense to be fontified as such.
(,(rx (any ?\( ?\) ?\[ ?\] ?\{ ?\} ?,))
- (0 'default))
+ (0 'haskell-tng:keyword))
;; TypeFamilies
(,(rx word-start "type" (+ space) (group "family") word-end)
@@ -133,15 +132,12 @@
(haskell-tng:font:deriving:keyword
(1 'haskell-tng:keyword keep)
(2 'haskell-tng:type keep))
- ;; TODO don't colour parens
- ;; TypeApplications: Unfortunately it is not possible to disambiguate
- ;; between type applications when the following type is in parentheses, as
- ;; it could also be a value extractor in a pattern. We could add more
hacks
- (,(rx-to-string `(: symbol-start "@" (* space)
- ;; TODO: support type parameters here
- (group (opt ,qual) (| ,conid ,consym))))
- (1 'haskell-tng:type))
+ ;; EXT:TypeApplications: It is not easy to disambiguate between type
+ ;; applications and value extractor in a pattern. Needs work.
+ ;; (,(rx-to-string `(: symbol-start "@" (* space)
+ ;; (group (opt ,qual) (| ,conid ,consym))))
+ ;; (1 'haskell-tng:type))
;; imports
(haskell-tng:font:import:keyword
@@ -252,7 +248,7 @@ Some complexity to avoid matching on operators."
"Used in `font-lock-extend-region-functions'.
Automatically populated by `haskell-tng:font:multiline'")
-;; TODO (perf) don't extend if the TRIGGER has a multiline prop
+;; TODO (perf) don't extend if the TRIGGER has a multiline prop already
(defmacro haskell-tng:font:multiline (name trigger find &rest limiters)
"Defines `font-lock-keywords' / `font-lock-extend-region-functions' entries.
diff --git a/haskell-tng-mode.el b/haskell-tng-mode.el
index bec845f..f053a14 100644
--- a/haskell-tng-mode.el
+++ b/haskell-tng-mode.el
@@ -60,9 +60,9 @@
:group 'haskell-tng
:type 'hook)
-;; (progn
-;; (add-to-list 'auto-mode-alist '("\\.hs\\'" . haskell-tng-mode))
-;; (modify-coding-system-alist 'file "\\.hs\\'" 'utf-8))
+(progn
+ (add-to-list 'auto-mode-alist '("\\.hs\\'" . haskell-tng-mode))
+ (modify-coding-system-alist 'file "\\.hs\\'" 'utf-8))
(provide 'haskell-tng-mode)
;;; haskell-tng-mode.el ends here
diff --git a/test/faces/medley.hs b/test/faces/medley.hs
new file mode 100644
index 0000000..5b950e5
--- /dev/null
+++ b/test/faces/medley.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | This file is a medley of various constructs and some corner cases
+module Foo.Bar.Main
+ ( Wibble(..), Wobble(Wobb, (!!!)), Woo
+ -- * Operations
+ , getFooByBar, getWibbleByWobble
+ , module Bloo.Foo
+ ) where
+
+import Control.Applicative (many, optional, pure, (<*>), (<|>))
+import Data.Foldable (traverse_)
+import Data.Functor ((<$>))
+import Data.List (intercalate)
+import Data.Monoid ((<>))
+import qualified Options.Monad
+import qualified Options.Applicative as Opts
+import qualified Options.Divisible -- wibble (wobble)
+ as Div
+import qualified ProfFile.App hiding (as, hiding, qualified)
+import ProfFile.App (as, hiding, qualified)
+import ProfFile.App hiding (as, hiding, qualified)
+import qualified ProfFile.App (as, hiding, qualified)
+import System.Exit (ExitCode (..), exitFailure, qualified,
+ Typey,
+ wibble,
+ Wibble)
+import System.FilePath (replaceExtension, Foo(Bar, (:<))
+import System.IO (IOMode (..), hClose, hGetContents,
+ hPutStr, hPutStrLn, openFile, stderr,
+ stdout, MoarTypey)
+import System.Process (CreateProcess (..), StdStream (..),
+ createProcess, proc, waitForProcess)
+
+-- some chars that should be propertized
+'c' '\n' '\''
+
+foo = "wobble (wibble)"
+
+class Get a s where
+ get :: Set s -> a
+
+instance {-# OVERLAPS #-} Get a (a ': s) where
+ get (Ext a _) = a
+
+instance {-# OVERLAPPABLE #-} Get a s => Get a (b ': s) where
+ get (Ext _ xs) = get xs
+
+data Options = Options
+ { optionsReportType :: ReportType
+ , optionsProfFile :: Maybe FilePath
+ , optionsOutputFile :: Maybe FilePath
+ , optionsFlamegraphFlags :: [String]
+ } deriving (Eq, Show)
+
+class (Eq a) => Ord a where
+ (<), (<=), (>=), (>) :: a -> a -> Bool
+ max @Foo, min :: a -> a -> a
+
+instance (Eq a) => Eq (Tree a) where
+ Leaf a == Leaf b = a == b
+ (Branch l1 r1) == (Branch l2 r2) = (l1==l2) && (r1==r2)
+ _ == _ = False
+
+data ReportType = Alloc -- ^ Report allocations, percent
+ | Entries -- ^ Report entries, number
+ | Time -- ^ Report time spent in closure, percent
+ | Ticks -- ^ Report ticks, number
+ | Bytes -- ^ Report bytes allocated, number
+ deriving (Eq, Show)
+
+type family G a where
+ G Int = Bool
+ G a = Char
+
+data Flobble = Flobble
+ deriving (Eq) via (NonNegative (Large Int))
+ deriving stock (Floo)
+ deriving anyclass (WibblyWoo, OtherlyWoo)
+
+newtype Flobby = Flobby
+
+foo ::
+ Wibble -- wibble
+ -> Wobble -- wobble
+ -> Wobble -- wobble
+ -> Wobble -- wobble
+ -> (wob :: Wobble)
+ -> (Wobble -- wobble
+ a b c)
+
+(foo :: (Wibble Wobble)) foo
+
+newtype TestApp
+ (logger :: TestLogger)
+ (scribe :: TestScribe)
+ config
+ a
+ = TestApp a
+
+optionsParser :: Opts.Parser Options
+optionsParser = Options
+ <$> (Opts.flag' Alloc (Opts.long "alloc" <> Opts.help "wibble")
+ <|> Opts.flag' Entries (Opts.long "entry" <> Opts.help "wobble")
+ <|> Opts.flag' Bytes (Opts.long "bytes" <> Opts.help "i'm a fish"))
+ <*> optional
+ (Opts.strArgument
+ (Opts.metavar "MY-FILE" <>
+ Opts.help "meh"))
+
+type PhantomThing
+
+type SomeApi =
+ "thing" :> Capture "bar" Index :> QueryParam "wibble" Text
+ :> QueryParam "wobble" Natural
+ :> Header TracingHeader
TracingId
+ :> ThingHeader
+ :> Get '[JSON] (The ReadResult)
+ :<|> "thing" :> ReqBody '[JSON] Request
+ :> Header TracingHeader TracingId
+ :> SpecialHeader
+ :> Post '[JSON] (The Response)
+
+deriving instance FromJSONKey StateName
+deriving anyclass instance FromJSON Base
+deriving newtype instance FromJSON Treble
diff --git a/test/faces/medley.hs.faceup b/test/faces/medley.hs.faceup
new file mode 100644
index 0000000..822121c
--- /dev/null
+++ b/test/faces/medley.hs.faceup
@@ -0,0 +1,127 @@
+«x:{-# LANGUAGE OverloadedStrings #-}»
+«x:{-# LANGUAGE ScopedTypeVariables #-}»
+
+«x:-- | This file is a medley of various constructs and some corner cases
+»«:haskell-tng:keyword:module» «:haskell-tng:module:Foo.Bar.Main»
+ «:haskell-tng:keyword:(»
«:haskell-tng:type:Wibble»«:haskell-tng:keyword:(..),»
«:haskell-tng:type:Wobble»«:haskell-tng:keyword:(»«:haskell-tng:constructor:Wobb»«:haskell-tng:keyword:,»«:haskell-tng:constructor:
»«:haskell-tng:keyword:(»«:haskell-tng:constructor:!!!»«:haskell-tng:keyword:)),»
«:haskell-tng:type:Woo»
+ «x:-- * Operations
+» «:haskell-tng:keyword:,» getFooByBar«:haskell-tng:keyword:,»
getWibbleByWobble
+ «:haskell-tng:keyword:,» «:haskell-tng:keyword:module»
«:haskell-tng:module:Bloo.Foo»
+ «:haskell-tng:keyword:)» «:haskell-tng:keyword:where»
+
+«:haskell-tng:keyword:import»
«:haskell-tng:module:Control.Applicative»
«:haskell-tng:keyword:(»many«:haskell-tng:keyword:,»
optional«:haskell-tng:keyword:,» pure«:haskell-tng:keyword:,»
«:haskell-tng:keyword:(»<*>«:haskell-tng:keyword:),»
«:haskell-tng:keyword:(»<|>«:haskell-tng:keyword:))»
+«:haskell-tng:keyword:import» «:haskell-tng:module:Data.Foldable»
«:haskell-tng:keyword:(»traverse_«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:Data.Functor»
«:haskell-tng:keyword:((»<$>«:haskell-tng:keyword:))»
+«:haskell-tng:keyword:import» «:haskell-tng:module:Data.List»
«:haskell-tng:keyword:(»intercalate«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:Data.Monoid»
«:haskell-tng:keyword:((»<>«:haskell-tng:keyword:))»
+«:haskell-tng:keyword:import» «:haskell-tng:keyword:qualified»
«:haskell-tng:module:Options.Monad»
+«:haskell-tng:keyword:import» «:haskell-tng:keyword:qualified»
«:haskell-tng:module:Options.Applicative» «:haskell-tng:keyword:as»
«:haskell-tng:module:Opts»
+«:haskell-tng:keyword:import» «:haskell-tng:keyword:qualified»
«:haskell-tng:module:Options.Divisible» «x:-- wibble (wobble)
+» «:haskell-tng:keyword:as» «:haskell-tng:module:Div»
+«:haskell-tng:keyword:import» «:haskell-tng:keyword:qualified»
«:haskell-tng:module:ProfFile.App» «:haskell-tng:keyword:hiding»
«:haskell-tng:keyword:(»as«:haskell-tng:keyword:,»
hiding«:haskell-tng:keyword:,» qualified«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:ProfFile.App»
«:haskell-tng:keyword:(»as«:haskell-tng:keyword:,»
hiding«:haskell-tng:keyword:,» qualified«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:ProfFile.App»
«:haskell-tng:keyword:hiding»
«:haskell-tng:keyword:(»as«:haskell-tng:keyword:,»
hiding«:haskell-tng:keyword:,» qualified«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:keyword:qualified»
«:haskell-tng:module:ProfFile.App»
«:haskell-tng:keyword:(»as«:haskell-tng:keyword:,»
hiding«:haskell-tng:keyword:,» qualified«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:System.Exit»
«:haskell-tng:keyword:(»«:haskell-tng:type:ExitCode»
«:haskell-tng:keyword:(..),» exitFailure«:haskell-tng:keyword:,»
qualified«:haskell-tng:keyword:,»
+
«:haskell-tng:type:Typey»«:haskell-tng:keyword:,»
+ wibble«:haskell-tng:keyword:,»
+
«:haskell-tng:type:Wibble»«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:System.FilePath»
«:haskell-tng:keyword:(»replaceExtension«:haskell-tng:keyword:,»
«:haskell-tng:type:Foo»«:haskell-tng:keyword:(»«:haskell-tng:constructor:Bar»«:haskell-tng:keyword:,»«:haskell-tng:constructor:
»«:haskell-tng:keyword:(»«:haskell-tng:constructor::<»«:haskell-tng:keyword:))»
+«:haskell-tng:keyword:import» «:haskell-tng:module:System.IO»
«:haskell-tng:keyword:(»«:haskell-tng:type:IOMode»
«:haskell-tng:keyword:(..),» hClose«:haskell-tng:keyword:,»
hGetContents«:haskell-tng:keyword:,»
+ hPutStr«:haskell-tng:keyword:,»
hPutStrLn«:haskell-tng:keyword:,» openFile«:haskell-tng:keyword:,»
stderr«:haskell-tng:keyword:,»
+ stdout«:haskell-tng:keyword:,»
«:haskell-tng:type:MoarTypey»«:haskell-tng:keyword:)»
+«:haskell-tng:keyword:import» «:haskell-tng:module:System.Process»
«:haskell-tng:keyword:(»«:haskell-tng:type:CreateProcess»
«:haskell-tng:keyword:(..),» «:haskell-tng:type:StdStream»
«:haskell-tng:keyword:(..),»
+ createProcess«:haskell-tng:keyword:,»
proc«:haskell-tng:keyword:,» waitForProcess«:haskell-tng:keyword:)»
+
+«x:-- some chars that should be propertized
+»«s:'c'» «s:'\n'» «s:'\''»
+
+«:haskell-tng:toplevel:foo» «:haskell-tng:keyword:=» «s:"wobble (wibble)"»
+
+«:haskell-tng:keyword:class»«:haskell-tng:type: Get a s
»«:haskell-tng:keyword:where»
+ get «:haskell-tng:keyword:::»«:haskell-tng:type: Set s
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
+»
+«:haskell-tng:keyword:instance»«:haskell-tng:type: »«x:{-# OVERLAPS
#-}»«:haskell-tng:type: Get a »«:haskell-tng:keyword:(»«:haskell-tng:type:a ':
s»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
+ get «:haskell-tng:keyword:(»«:haskell-tng:constructor:Ext» a
«:haskell-tng:keyword:_)» «:haskell-tng:keyword:=» a
+
+«:haskell-tng:keyword:instance»«:haskell-tng:type: »«x:{-# OVERLAPPABLE
#-}»«:haskell-tng:type: Get a s »«:haskell-tng:keyword:=>»«:haskell-tng:type:
Get a »«:haskell-tng:keyword:(»«:haskell-tng:type:b ':
s»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
+ get «:haskell-tng:keyword:(»«:haskell-tng:constructor:Ext»
«:haskell-tng:keyword:_» xs«:haskell-tng:keyword:)» «:haskell-tng:keyword:=»
get xs
+
+«:haskell-tng:keyword:data»«:haskell-tng:type: Options
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Options»
+ «:haskell-tng:keyword:{» optionsReportType
«:haskell-tng:keyword:::»«:haskell-tng:type: ReportType
+» «:haskell-tng:keyword:,» optionsProfFile
«:haskell-tng:keyword:::»«:haskell-tng:type: Maybe FilePath
+» «:haskell-tng:keyword:,» optionsOutputFile
«:haskell-tng:keyword:::»«:haskell-tng:type: Maybe FilePath
+» «:haskell-tng:keyword:,» optionsFlamegraphFlags
«:haskell-tng:keyword:::»«:haskell-tng:type:
»«:haskell-tng:keyword:[»«:haskell-tng:type:String»«:haskell-tng:keyword:]»«:haskell-tng:type:
+» «:haskell-tng:keyword:}» «:haskell-tng:keyword:deriving»
«:haskell-tng:keyword:(»«:haskell-tng:type:Eq»«:haskell-tng:keyword:,»«:haskell-tng:type:
Show»«:haskell-tng:keyword:)»
+
+«:haskell-tng:keyword:class»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:Eq
a»«:haskell-tng:keyword:)»«:haskell-tng:type:
»«:haskell-tng:keyword:=>»«:haskell-tng:type: Ord a
»«:haskell-tng:keyword:where»
+ «:haskell-tng:keyword:(»<«:haskell-tng:keyword:),»
«:haskell-tng:keyword:(»<=«:haskell-tng:keyword:),»
«:haskell-tng:keyword:(»>=«:haskell-tng:keyword:),»
«:haskell-tng:keyword:(»>«:haskell-tng:keyword:)»
«:haskell-tng:keyword:::»«:haskell-tng:type: a
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
»«:haskell-tng:keyword:->»«:haskell-tng:type: Bool
+» max @Foo«:haskell-tng:keyword:,» min
«:haskell-tng:keyword:::»«:haskell-tng:type: a
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
+»
+«:haskell-tng:keyword:instance»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:Eq
a»«:haskell-tng:keyword:)»«:haskell-tng:type:
»«:haskell-tng:keyword:=>»«:haskell-tng:type: Eq
»«:haskell-tng:keyword:(»«:haskell-tng:type:Tree
a»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
+ «:haskell-tng:constructor:Leaf» a == «:haskell-tng:constructor:Leaf»
b «:haskell-tng:keyword:=» a == b
+ «:haskell-tng:keyword:(»«:haskell-tng:constructor:Branch» l1
r1«:haskell-tng:keyword:)» ==
«:haskell-tng:keyword:(»«:haskell-tng:constructor:Branch» l2
r2«:haskell-tng:keyword:)» «:haskell-tng:keyword:=»
«:haskell-tng:keyword:(»l1==l2«:haskell-tng:keyword:)» &&
«:haskell-tng:keyword:(»r1==r2«:haskell-tng:keyword:)»
+ «:haskell-tng:keyword:_» == «:haskell-tng:keyword:_»
«:haskell-tng:keyword:=» «:haskell-tng:constructor:False»
+
+«:haskell-tng:keyword:data»«:haskell-tng:type: ReportType
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Alloc» «x:-- ^ Report
allocations, percent
+» «:haskell-tng:keyword:|» «:haskell-tng:constructor:Entries»
«x:-- ^ Report entries, number
+» «:haskell-tng:keyword:|» «:haskell-tng:constructor:Time»
«x:-- ^ Report time spent in closure, percent
+» «:haskell-tng:keyword:|» «:haskell-tng:constructor:Ticks»
«x:-- ^ Report ticks, number
+» «:haskell-tng:keyword:|» «:haskell-tng:constructor:Bytes»
«x:-- ^ Report bytes allocated, number
+» «:haskell-tng:keyword:deriving»
«:haskell-tng:keyword:(»«:haskell-tng:type:Eq»«:haskell-tng:keyword:,»«:haskell-tng:type:
Show»«:haskell-tng:keyword:)»
+
+«:haskell-tng:keyword:type»«:haskell-tng:type:
»«:haskell-tng:keyword:family»«:haskell-tng:type: G a
»«:haskell-tng:keyword:where»«:haskell-tng:type:
+ G Int »«:haskell-tng:keyword:=»«:haskell-tng:type: Bool
+ G a »«:haskell-tng:keyword:=»«:haskell-tng:type: Char
+»
+«:haskell-tng:keyword:data»«:haskell-tng:type: Flobble
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Flobble»
+ «:haskell-tng:keyword:deriving»
«:haskell-tng:keyword:(»«:haskell-tng:type:Eq»«:haskell-tng:keyword:)»«:haskell-tng:type:
via »«:haskell-tng:keyword:(»«:haskell-tng:type:NonNegative
»«:haskell-tng:keyword:(»«:haskell-tng:type:Large Int»«:haskell-tng:keyword:))»
+ «:haskell-tng:keyword:deriving» «:haskell-tng:keyword:stock»
«:haskell-tng:keyword:(»«:haskell-tng:type:Floo»«:haskell-tng:keyword:)»
+ «:haskell-tng:keyword:deriving» «:haskell-tng:keyword:anyclass»
«:haskell-tng:keyword:(»«:haskell-tng:type:WibblyWoo»«:haskell-tng:keyword:,»«:haskell-tng:type:
OtherlyWoo»«:haskell-tng:keyword:)»
+
+«:haskell-tng:keyword:newtype»«:haskell-tng:type: Flobby
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Flobby»
+
+«:haskell-tng:toplevel:foo» «:haskell-tng:keyword:::»«:haskell-tng:type:
+ Wibble »«x:-- wibble
+»«:haskell-tng:type: »«:haskell-tng:keyword:->»«:haskell-tng:type: Wobble
»«x:-- wobble
+»«:haskell-tng:type: »«:haskell-tng:keyword:->»«:haskell-tng:type: Wobble
»«x:-- wobble
+»«:haskell-tng:type: »«:haskell-tng:keyword:->»«:haskell-tng:type: Wobble
»«x:-- wobble
+»«:haskell-tng:type: »«:haskell-tng:keyword:->»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:wob
»«:haskell-tng:keyword:::»«:haskell-tng:type:
Wobble»«:haskell-tng:keyword:)»«:haskell-tng:type:
+ »«:haskell-tng:keyword:->»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:Wobble »«x:-- wobble
+»«:haskell-tng:type: a b c»«:haskell-tng:keyword:)»«:haskell-tng:type:
+»
+«:haskell-tng:keyword:(»foo «:haskell-tng:keyword:::»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:Wibble
Wobble»«:haskell-tng:keyword:))» foo
+
+«:haskell-tng:keyword:newtype»«:haskell-tng:type: TestApp
+ »«:haskell-tng:keyword:(»«:haskell-tng:type:logger
»«:haskell-tng:keyword:::»«:haskell-tng:type:
TestLogger»«:haskell-tng:keyword:)»«:haskell-tng:type:
+ »«:haskell-tng:keyword:(»«:haskell-tng:type:scribe
»«:haskell-tng:keyword:::»«:haskell-tng:type:
TestScribe»«:haskell-tng:keyword:)»«:haskell-tng:type:
+ config
+ a
+ »«:haskell-tng:keyword:=» «:haskell-tng:constructor:TestApp» a
+
+«:haskell-tng:toplevel:optionsParser»
«:haskell-tng:keyword:::»«:haskell-tng:type: Opts.Parser Options
+»«:haskell-tng:toplevel:optionsParser» «:haskell-tng:keyword:=»
«:haskell-tng:constructor:Options»
+ <$> «:haskell-tng:keyword:(»«:haskell-tng:module:Opts.»flag'
«:haskell-tng:constructor:Alloc»
«:haskell-tng:keyword:(»«:haskell-tng:module:Opts.»long «s:"alloc"» <>
«:haskell-tng:module:Opts.»help «s:"wibble"»«:haskell-tng:keyword:)»
+ <|> «:haskell-tng:module:Opts.»flag' «:haskell-tng:constructor:Entries»
«:haskell-tng:keyword:(»«:haskell-tng:module:Opts.»long «s:"entry"» <>
«:haskell-tng:module:Opts.»help «s:"wobble"»«:haskell-tng:keyword:)»
+ <|> «:haskell-tng:module:Opts.»flag' «:haskell-tng:constructor:Bytes»
«:haskell-tng:keyword:(»«:haskell-tng:module:Opts.»long «s:"bytes"» <>
«:haskell-tng:module:Opts.»help «s:"i'm a fish"»«:haskell-tng:keyword:))»
+ <*> optional
+ «:haskell-tng:keyword:(»«:haskell-tng:module:Opts.»strArgument
+ «:haskell-tng:keyword:(»«:haskell-tng:module:Opts.»metavar
«s:"MY-FILE"» <>
+ «:haskell-tng:module:Opts.»help «s:"meh"»«:haskell-tng:keyword:))»
+
+«:haskell-tng:keyword:type»«:haskell-tng:type: PhantomThing
+»
+«:haskell-tng:keyword:type»«:haskell-tng:type: SomeApi
»«:haskell-tng:keyword:=»«:haskell-tng:type:
+ »«s:"thing"»«:haskell-tng:type: :> Capture
»«s:"bar"»«:haskell-tng:type: Index :> QueryParam
»«s:"wibble"»«:haskell-tng:type: Text
+ :> QueryParam
»«s:"wobble"»«:haskell-tng:type: Natural
+ :> Header TracingHeader
TracingId
+ :> ThingHeader
+ :> Get
'»«:haskell-tng:keyword:[»«:haskell-tng:type:JSON»«:haskell-tng:keyword:]»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:The
ReadResult»«:haskell-tng:keyword:)»«:haskell-tng:type:
+ :<|> »«s:"thing"»«:haskell-tng:type: :> ReqBody
'»«:haskell-tng:keyword:[»«:haskell-tng:type:JSON»«:haskell-tng:keyword:]»«:haskell-tng:type:
Request
+ :> Header TracingHeader TracingId
+ :> SpecialHeader
+ :> Post
'»«:haskell-tng:keyword:[»«:haskell-tng:type:JSON»«:haskell-tng:keyword:]»«:haskell-tng:type:
»«:haskell-tng:keyword:(»«:haskell-tng:type:The
Response»«:haskell-tng:keyword:)»«:haskell-tng:type:
+»
+«:haskell-tng:keyword:deriving» «:haskell-tng:keyword:instance»
«:haskell-tng:constructor:FromJSONKey» «:haskell-tng:constructor:StateName»
+«:haskell-tng:keyword:deriving» anyclass «:haskell-tng:keyword:instance»
«:haskell-tng:constructor:FromJSON» «:haskell-tng:constructor:Base»
+«:haskell-tng:keyword:deriving» «:haskell-tng:keyword:newtype»
«:haskell-tng:keyword:instance» «:haskell-tng:constructor:FromJSON»
«:haskell-tng:constructor:Treble»
diff --git a/test/haskell-tng-font-lock-test.el
b/test/haskell-tng-font-lock-test.el
new file mode 100644
index 0000000..afaba90
--- /dev/null
+++ b/test/haskell-tng-font-lock-test.el
@@ -0,0 +1,22 @@
+;;; haskell-tng-font-lock-test.el --- Tests for fontification -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2018 Tseen She
+;; License: GPL 3 or any later version
+
+(require 'haskell-tng-mode)
+
+(require 'ert)
+(require 'faceup)
+
+(defun have-expected-faces (file)
+ (faceup-test-font-lock-file
+ 'haskell-tng-mode
+ (expand-file-name
+ file
+ (eval-when-compile (faceup-this-file-directory)))))
+(faceup-defexplainer have-expected-faces)
+
+(ert-deftest haskell-tng-font-lock-file-tests ()
+ (should (have-expected-faces "faces/medley.hs")) )
+
+;;; haskell-tng-font-lock-test.el ends here
