yi-mode-haskell (empty) → 0.13
raw patch · 15 files changed
+2505/−0 lines, 15 filesdep +QuickCheckdep +arraydep +basesetup-changed
Dependencies added: QuickCheck, array, base, binary, containers, data-default, filepath, hashable, hspec, microlens-platform, pointedlist, regex-base, regex-tdfa, template-haskell, text, transformers-base, unordered-containers, yi-core, yi-language, yi-mode-haskell, yi-rope
Files
- Setup.hs +4/−0
- src/Yi/Config/Default/HaskellMode.hs +13/−0
- src/Yi/Lexer/Haskell.x +265/−0
- src/Yi/Lexer/LiterateHaskell.x +224/−0
- src/Yi/Mode/GHCi.hs +85/−0
- src/Yi/Mode/Haskell.hs +470/−0
- src/Yi/Mode/Haskell/Dollarify.hs +186/−0
- src/Yi/Syntax/Haskell.hs +745/−0
- src/Yi/Syntax/Paren.hs +172/−0
- src/Yi/Syntax/Strokes/Haskell.hs +157/−0
- test/Spec.hs +1/−0
- test/Yi/Lexer/HaskellSpec.hs +64/−0
- test/Yi/Lexer/Helpers.hs +2/−0
- test/Yi/Lexer/Helpers/TH.hs +30/−0
- yi-mode-haskell.cabal +87/−0
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO ()+main = defaultMain
+ src/Yi/Config/Default/HaskellMode.hs view
@@ -0,0 +1,13 @@+module Yi.Config.Default.HaskellMode (configureHaskellMode) where++import Lens.Micro.Platform ((%=))+import Yi.Config.Simple (ConfigM, addMode)+import Yi.Config.Lens (modeTableA)+import Yi.Mode.Haskell+import Yi.Types (AnyMode (..))++configureHaskellMode :: ConfigM ()+configureHaskellMode = do+ addMode literateMode+ addMode preciseMode+ addMode cleverMode
+ src/Yi/Lexer/Haskell.x view
@@ -0,0 +1,265 @@+-- -*- haskell -*-+--+-- Lexical syntax for illiterate Haskell 98.+--+-- (c) Simon Marlow 2003, with the caveat that much of this is+-- translated directly from the syntax in the Haskell 98 report.+--++{+{-# OPTIONS -w #-}+module Yi.Lexer.Haskell ( initState, alexScanToken, tokenToStyle,+ tokenToText,+ TT, isErrorTok, isSpecial,+ startsLayout, isComment, Token(..), HlState, CommentType(..), ReservedType(..), OpType(..) ) where+import Yi.Lexer.Alex hiding (tokenToStyle)+import Yi.Style+}++$whitechar = [\ \t\n\r\f\v]+$special = [\(\)\,\;\[\]\`\{\}]++$ascdigit = 0-9+$unidigit = [] -- GHC 8.0.1 Doesn't support unicode decimal digits+$digit = [$ascdigit $unidigit]++$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]+$unisymbol = [\x9\xb\x1f\x24\x2b\x3c-\x3e\x5e\x60\x7c\x7e\xa2-\xa6\xa8\xa9\xac\xae-\xb1\xb4\xb8\xd7\xf7\x2c2-\x2c5\x2d2-\x2df\x2e5-\x2eb\x2ed\x2ef-\x2ff\x375\x384\x385\x3f6\x482\x58d-\x58f\x606-\x608\x60b\x60e\x60f\x6de\x6e9\x6fd\x6fe\x7f6\x9f2\x9f3\x9fa\x9fb\xaf1\xb70\xbf3-\xbfa\xc7f\xd4f\xd79\xe3f\xf01-\xf03\xf13\xf15-\xf17\xf1a-\xf1f\xf34\xf36\xf38\xfbe-\xfc5\xfc7-\xfcc\xfce\xfcf\xfd5-\xfd8\x109e\x109f\x1390-\x1399\x17db\x1940\x19de-\x19ff\x1b61-\x1b6a\x1b74-\x1b7c\x1fbd\x1fbf-\x1fc1\x1fcd-\x1fcf\x1fdd-\x1fdf\x1fed-\x1fef\x1ffd\x1ffe\x2044\x2052\x207a-\x207c\x208a-\x208c\x20a0-\x20be\x2100\x2101\x2103-\x2106\x2108\x2109\x2114\x2116-\x2118\x211e-\x2123\x2125\x2127\x2129\x212e\x213a\x213b\x2140-\x2144\x214a-\x214d\x214f\x218a\x218b\x2190-\x2307\x230c-\x2328\x232b-\x23fe\x2400-\x2426\x2440-\x244a\x249c-\x24e9\x2500-\x2767\x2794-\x27c4\x27c7-\x27e5\x27f0-\x2982\x2999-\x29d7\x29dc-\x29fb\x29fe-\x2b73\x2b76-\x2b95\x2b98-\x2bb9\x2bbd-\x2bc8\x2bca-\x2bd1\x2bec-\x2bef\x2ce5-\x2cea\x2e80-\x2e99\x2e9b-\x2ef3\x2f00-\x2fd5\x2ff0-\x2ffb\x3004\x3012\x3013\x3020\x3036\x3037\x303e\x303f\x309b\x309c\x3190\x3191\x3196-\x319f\x31c0-\x31e3\x3200-\x321e\x322a-\x3247\x3250\x3260-\x327f\x328a-\x32b0\x32c0-\x32fe\x3300-\x33ff\x4dc0-\x4dff\xa490-\xa4c6\xa700-\xa716\xa720\xa721\xa789\xa78a\xa828-\xa82b\xa836-\xa839\xaa77-\xaa79\xab5b\xfb29\xfbb2-\xfbc1\xfdfc\xfdfd\xfe62\xfe64-\xfe66\xfe69\xff04\xff0b\xff1c-\xff1e\xff3e\xff40\xff5c\xff5e\xffe0-\xffe6\xffe8-\xffee\xfffc\xfffd\x10137-\x1013f\x10179-\x10189\x1018c-\x1018e\x10190-\x1019b\x101a0\x101d0-\x101fc\x10877\x10878\x10ac8\x1173f\x16b3c-\x16b3f\x16b45\x1bc9c\x1d000-\x1d0f5\x1d100-\x1d126\x1d129-\x1d164\x1d16a-\x1d16c\x1d183\x1d184\x1d18c-\x1d1a9\x1d1ae-\x1d1e8\x1d200-\x1d241\x1d245\x1d300-\x1d356\x1d6c1\x1d6db\x1d6fb\x1d715\x1d735\x1d74f\x1d76f\x1d789\x1d7a9\x1d7c3\x1d800-\x1d9ff\x1da37-\x1da3a\x1da6d-\x1da74\x1da76-\x1da83\x1da85\x1da86\x1eef0\x1eef1\x1f000-\x1f02b\x1f030-\x1f093\x1f0a0-\x1f0ae\x1f0b1-\x1f0bf\x1f0c1-\x1f0cf\x1f0d1-\x1f0f5\x1f110-\x1f12e\x1f130-\x1f16b\x1f170-\x1f1ac\x1f1e6-\x1f202\x1f210-\x1f23b\x1f240-\x1f248\x1f250\x1f251\x1f300-\x1f6d2\x1f6e0-\x1f6ec\x1f6f0-\x1f6f6\x1f700-\x1f773\x1f780-\x1f7d4\x1f800-\x1f80b\x1f810-\x1f847\x1f850-\x1f859\x1f860-\x1f887\x1f890-\x1f8ad\x1f910-\x1f91e\x1f920-\x1f927\x1f930\x1f933-\x1f93e\x1f940-\x1f94b\x1f950-\x1f95e\x1f980-\x1f991\x1f9c0]+$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\']++$large = [\x41-\x5a\xc0-\xd6\xd8-\xde\x100\x102\x104\x106\x108\x10a\x10c\x10e\x110\x112\x114\x116\x118\x11a\x11c\x11e\x120\x122\x124\x126\x128\x12a\x12c\x12e\x130\x132\x134\x136\x139\x13b\x13d\x13f\x141\x143\x145\x147\x14a\x14c\x14e\x150\x152\x154\x156\x158\x15a\x15c\x15e\x160\x162\x164\x166\x168\x16a\x16c\x16e\x170\x172\x174\x176\x178\x179\x17b\x17d\x181\x182\x184\x186\x187\x189-\x18b\x18e-\x191\x193\x194\x196-\x198\x19c\x19d\x19f\x1a0\x1a2\x1a4\x1a6\x1a7\x1a9\x1ac\x1ae\x1af\x1b1-\x1b3\x1b5\x1b7\x1b8\x1bc\x1c4\x1c7\x1ca\x1cd\x1cf\x1d1\x1d3\x1d5\x1d7\x1d9\x1db\x1de\x1e0\x1e2\x1e4\x1e6\x1e8\x1ea\x1ec\x1ee\x1f1\x1f4\x1f6-\x1f8\x1fa\x1fc\x1fe\x200\x202\x204\x206\x208\x20a\x20c\x20e\x210\x212\x214\x216\x218\x21a\x21c\x21e\x220\x222\x224\x226\x228\x22a\x22c\x22e\x230\x232\x23a\x23b\x23d\x23e\x241\x243-\x246\x248\x24a\x24c\x24e\x370\x372\x376\x37f\x386\x388-\x38a\x38c\x38e\x38f\x391-\x3a1\x3a3-\x3ab\x3cf\x3d2-\x3d4\x3d8\x3da\x3dc\x3de\x3e0\x3e2\x3e4\x3e6\x3e8\x3ea\x3ec\x3ee\x3f4\x3f7\x3f9\x3fa\x3fd-\x42f\x460\x462\x464\x466\x468\x46a\x46c\x46e\x470\x472\x474\x476\x478\x47a\x47c\x47e\x480\x48a\x48c\x48e\x490\x492\x494\x496\x498\x49a\x49c\x49e\x4a0\x4a2\x4a4\x4a6\x4a8\x4aa\x4ac\x4ae\x4b0\x4b2\x4b4\x4b6\x4b8\x4ba\x4bc\x4be\x4c0\x4c1\x4c3\x4c5\x4c7\x4c9\x4cb\x4cd\x4d0\x4d2\x4d4\x4d6\x4d8\x4da\x4dc\x4de\x4e0\x4e2\x4e4\x4e6\x4e8\x4ea\x4ec\x4ee\x4f0\x4f2\x4f4\x4f6\x4f8\x4fa\x4fc\x4fe\x500\x502\x504\x506\x508\x50a\x50c\x50e\x510\x512\x514\x516\x518\x51a\x51c\x51e\x520\x522\x524\x526\x528\x52a\x52c\x52e\x531-\x556\x10a0-\x10c5\x10c7\x10cd\x13a0-\x13f5\x1e00\x1e02\x1e04\x1e06\x1e08\x1e0a\x1e0c\x1e0e\x1e10\x1e12\x1e14\x1e16\x1e18\x1e1a\x1e1c\x1e1e\x1e20\x1e22\x1e24\x1e26\x1e28\x1e2a\x1e2c\x1e2e\x1e30\x1e32\x1e34\x1e36\x1e38\x1e3a\x1e3c\x1e3e\x1e40\x1e42\x1e44\x1e46\x1e48\x1e4a\x1e4c\x1e4e\x1e50\x1e52\x1e54\x1e56\x1e58\x1e5a\x1e5c\x1e5e\x1e60\x1e62\x1e64\x1e66\x1e68\x1e6a\x1e6c\x1e6e\x1e70\x1e72\x1e74\x1e76\x1e78\x1e7a\x1e7c\x1e7e\x1e80\x1e82\x1e84\x1e86\x1e88\x1e8a\x1e8c\x1e8e\x1e90\x1e92\x1e94\x1e9e\x1ea0\x1ea2\x1ea4\x1ea6\x1ea8\x1eaa\x1eac\x1eae\x1eb0\x1eb2\x1eb4\x1eb6\x1eb8\x1eba\x1ebc\x1ebe\x1ec0\x1ec2\x1ec4\x1ec6\x1ec8\x1eca\x1ecc\x1ece\x1ed0\x1ed2\x1ed4\x1ed6\x1ed8\x1eda\x1edc\x1ede\x1ee0\x1ee2\x1ee4\x1ee6\x1ee8\x1eea\x1eec\x1eee\x1ef0\x1ef2\x1ef4\x1ef6\x1ef8\x1efa\x1efc\x1efe\x1f08-\x1f0f\x1f18-\x1f1d\x1f28-\x1f2f\x1f38-\x1f3f\x1f48-\x1f4d\x1f59\x1f5b\x1f5d\x1f5f\x1f68-\x1f6f\x1fb8-\x1fbb\x1fc8-\x1fcb\x1fd8-\x1fdb\x1fe8-\x1fec\x1ff8-\x1ffb\x2102\x2107\x210b-\x210d\x2110-\x2112\x2115\x2119-\x211d\x2124\x2126\x2128\x212a-\x212d\x2130-\x2133\x213e\x213f\x2145\x2183\x2c00-\x2c2e\x2c60\x2c62-\x2c64\x2c67\x2c69\x2c6b\x2c6d-\x2c70\x2c72\x2c75\x2c7e-\x2c80\x2c82\x2c84\x2c86\x2c88\x2c8a\x2c8c\x2c8e\x2c90\x2c92\x2c94\x2c96\x2c98\x2c9a\x2c9c\x2c9e\x2ca0\x2ca2\x2ca4\x2ca6\x2ca8\x2caa\x2cac\x2cae\x2cb0\x2cb2\x2cb4\x2cb6\x2cb8\x2cba\x2cbc\x2cbe\x2cc0\x2cc2\x2cc4\x2cc6\x2cc8\x2cca\x2ccc\x2cce\x2cd0\x2cd2\x2cd4\x2cd6\x2cd8\x2cda\x2cdc\x2cde\x2ce0\x2ce2\x2ceb\x2ced\x2cf2\xa640\xa642\xa644\xa646\xa648\xa64a\xa64c\xa64e\xa650\xa652\xa654\xa656\xa658\xa65a\xa65c\xa65e\xa660\xa662\xa664\xa666\xa668\xa66a\xa66c\xa680\xa682\xa684\xa686\xa688\xa68a\xa68c\xa68e\xa690\xa692\xa694\xa696\xa698\xa69a\xa722\xa724\xa726\xa728\xa72a\xa72c\xa72e\xa732\xa734\xa736\xa738\xa73a\xa73c\xa73e\xa740\xa742\xa744\xa746\xa748\xa74a\xa74c\xa74e\xa750\xa752\xa754\xa756\xa758\xa75a\xa75c\xa75e\xa760\xa762\xa764\xa766\xa768\xa76a\xa76c\xa76e\xa779\xa77b\xa77d\xa77e\xa780\xa782\xa784\xa786\xa78b\xa78d\xa790\xa792\xa796\xa798\xa79a\xa79c\xa79e\xa7a0\xa7a2\xa7a4\xa7a6\xa7a8\xa7aa-\xa7ae\xa7b0-\xa7b4\xa7b6\xff21-\xff3a\x10400-\x10427\x104b0-\x104d3\x10c80-\x10cb2\x118a0-\x118bf\x1d400-\x1d419\x1d434-\x1d44d\x1d468-\x1d481\x1d49c\x1d49e\x1d49f\x1d4a2\x1d4a5\x1d4a6\x1d4a9-\x1d4ac\x1d4ae-\x1d4b5\x1d4d0-\x1d4e9\x1d504\x1d505\x1d507-\x1d50a\x1d50d-\x1d514\x1d516-\x1d51c\x1d538\x1d539\x1d53b-\x1d53e\x1d540-\x1d544\x1d546\x1d54a-\x1d550\x1d56c-\x1d585\x1d5a0-\x1d5b9\x1d5d4-\x1d5ed\x1d608-\x1d621\x1d63c-\x1d655\x1d670-\x1d689\x1d6a8-\x1d6c0\x1d6e2-\x1d6fa\x1d71c-\x1d734\x1d756-\x1d76e\x1d790-\x1d7a8\x1d7ca\x1e900-\x1e921\x1c5\x1c8\x1cb\x1f2\x1f88-\x1f8f\x1f98-\x1f9f\x1fa8-\x1faf\x1fbc\x1fcc\x1ffc]+$small = [\x61-\x7a\xb5\xdf-\xf6\xf8-\xff\x101\x103\x105\x107\x109\x10b\x10d\x10f\x111\x113\x115\x117\x119\x11b\x11d\x11f\x121\x123\x125\x127\x129\x12b\x12d\x12f\x131\x133\x135\x137\x138\x13a\x13c\x13e\x140\x142\x144\x146\x148\x149\x14b\x14d\x14f\x151\x153\x155\x157\x159\x15b\x15d\x15f\x161\x163\x165\x167\x169\x16b\x16d\x16f\x171\x173\x175\x177\x17a\x17c\x17e-\x180\x183\x185\x188\x18c\x18d\x192\x195\x199-\x19b\x19e\x1a1\x1a3\x1a5\x1a8\x1aa\x1ab\x1ad\x1b0\x1b4\x1b6\x1b9\x1ba\x1bd-\x1bf\x1c6\x1c9\x1cc\x1ce\x1d0\x1d2\x1d4\x1d6\x1d8\x1da\x1dc\x1dd\x1df\x1e1\x1e3\x1e5\x1e7\x1e9\x1eb\x1ed\x1ef\x1f0\x1f3\x1f5\x1f9\x1fb\x1fd\x1ff\x201\x203\x205\x207\x209\x20b\x20d\x20f\x211\x213\x215\x217\x219\x21b\x21d\x21f\x221\x223\x225\x227\x229\x22b\x22d\x22f\x231\x233-\x239\x23c\x23f\x240\x242\x247\x249\x24b\x24d\x24f-\x293\x295-\x2af\x371\x373\x377\x37b-\x37d\x390\x3ac-\x3ce\x3d0\x3d1\x3d5-\x3d7\x3d9\x3db\x3dd\x3df\x3e1\x3e3\x3e5\x3e7\x3e9\x3eb\x3ed\x3ef-\x3f3\x3f5\x3f8\x3fb\x3fc\x430-\x45f\x461\x463\x465\x467\x469\x46b\x46d\x46f\x471\x473\x475\x477\x479\x47b\x47d\x47f\x481\x48b\x48d\x48f\x491\x493\x495\x497\x499\x49b\x49d\x49f\x4a1\x4a3\x4a5\x4a7\x4a9\x4ab\x4ad\x4af\x4b1\x4b3\x4b5\x4b7\x4b9\x4bb\x4bd\x4bf\x4c2\x4c4\x4c6\x4c8\x4ca\x4cc\x4ce\x4cf\x4d1\x4d3\x4d5\x4d7\x4d9\x4db\x4dd\x4df\x4e1\x4e3\x4e5\x4e7\x4e9\x4eb\x4ed\x4ef\x4f1\x4f3\x4f5\x4f7\x4f9\x4fb\x4fd\x4ff\x501\x503\x505\x507\x509\x50b\x50d\x50f\x511\x513\x515\x517\x519\x51b\x51d\x51f\x521\x523\x525\x527\x529\x52b\x52d\x52f\x561-\x587\x13f8-\x13fd\x1c80-\x1c88\x1d00-\x1d2b\x1d6b-\x1d77\x1d79-\x1d9a\x1e01\x1e03\x1e05\x1e07\x1e09\x1e0b\x1e0d\x1e0f\x1e11\x1e13\x1e15\x1e17\x1e19\x1e1b\x1e1d\x1e1f\x1e21\x1e23\x1e25\x1e27\x1e29\x1e2b\x1e2d\x1e2f\x1e31\x1e33\x1e35\x1e37\x1e39\x1e3b\x1e3d\x1e3f\x1e41\x1e43\x1e45\x1e47\x1e49\x1e4b\x1e4d\x1e4f\x1e51\x1e53\x1e55\x1e57\x1e59\x1e5b\x1e5d\x1e5f\x1e61\x1e63\x1e65\x1e67\x1e69\x1e6b\x1e6d\x1e6f\x1e71\x1e73\x1e75\x1e77\x1e79\x1e7b\x1e7d\x1e7f\x1e81\x1e83\x1e85\x1e87\x1e89\x1e8b\x1e8d\x1e8f\x1e91\x1e93\x1e95-\x1e9d\x1e9f\x1ea1\x1ea3\x1ea5\x1ea7\x1ea9\x1eab\x1ead\x1eaf\x1eb1\x1eb3\x1eb5\x1eb7\x1eb9\x1ebb\x1ebd\x1ebf\x1ec1\x1ec3\x1ec5\x1ec7\x1ec9\x1ecb\x1ecd\x1ecf\x1ed1\x1ed3\x1ed5\x1ed7\x1ed9\x1edb\x1edd\x1edf\x1ee1\x1ee3\x1ee5\x1ee7\x1ee9\x1eeb\x1eed\x1eef\x1ef1\x1ef3\x1ef5\x1ef7\x1ef9\x1efb\x1efd\x1eff-\x1f07\x1f10-\x1f15\x1f20-\x1f27\x1f30-\x1f37\x1f40-\x1f45\x1f50-\x1f57\x1f60-\x1f67\x1f70-\x1f7d\x1f80-\x1f87\x1f90-\x1f97\x1fa0-\x1fa7\x1fb0-\x1fb4\x1fb6\x1fb7\x1fbe\x1fc2-\x1fc4\x1fc6\x1fc7\x1fd0-\x1fd3\x1fd6\x1fd7\x1fe0-\x1fe7\x1ff2-\x1ff4\x1ff6\x1ff7\x210a\x210e\x210f\x2113\x212f\x2134\x2139\x213c\x213d\x2146-\x2149\x214e\x2184\x2c30-\x2c5e\x2c61\x2c65\x2c66\x2c68\x2c6a\x2c6c\x2c71\x2c73\x2c74\x2c76-\x2c7b\x2c81\x2c83\x2c85\x2c87\x2c89\x2c8b\x2c8d\x2c8f\x2c91\x2c93\x2c95\x2c97\x2c99\x2c9b\x2c9d\x2c9f\x2ca1\x2ca3\x2ca5\x2ca7\x2ca9\x2cab\x2cad\x2caf\x2cb1\x2cb3\x2cb5\x2cb7\x2cb9\x2cbb\x2cbd\x2cbf\x2cc1\x2cc3\x2cc5\x2cc7\x2cc9\x2ccb\x2ccd\x2ccf\x2cd1\x2cd3\x2cd5\x2cd7\x2cd9\x2cdb\x2cdd\x2cdf\x2ce1\x2ce3\x2ce4\x2cec\x2cee\x2cf3\x2d00-\x2d25\x2d27\x2d2d\xa641\xa643\xa645\xa647\xa649\xa64b\xa64d\xa64f\xa651\xa653\xa655\xa657\xa659\xa65b\xa65d\xa65f\xa661\xa663\xa665\xa667\xa669\xa66b\xa66d\xa681\xa683\xa685\xa687\xa689\xa68b\xa68d\xa68f\xa691\xa693\xa695\xa697\xa699\xa69b\xa723\xa725\xa727\xa729\xa72b\xa72d\xa72f-\xa731\xa733\xa735\xa737\xa739\xa73b\xa73d\xa73f\xa741\xa743\xa745\xa747\xa749\xa74b\xa74d\xa74f\xa751\xa753\xa755\xa757\xa759\xa75b\xa75d\xa75f\xa761\xa763\xa765\xa767\xa769\xa76b\xa76d\xa76f\xa771-\xa778\xa77a\xa77c\xa77f\xa781\xa783\xa785\xa787\xa78c\xa78e\xa791\xa793-\xa795\xa797\xa799\xa79b\xa79d\xa79f\xa7a1\xa7a3\xa7a5\xa7a7\xa7a9\xa7b5\xa7b7\xa7fa\xab30-\xab5a\xab60-\xab65\xab70-\xabbf\xfb00-\xfb06\xfb13-\xfb17\xff41-\xff5a\x10428-\x1044f\x104d8-\x104fb\x10cc0-\x10cf2\x118c0-\x118df\x1d41a-\x1d433\x1d44e-\x1d454\x1d456-\x1d467\x1d482-\x1d49b\x1d4b6-\x1d4b9\x1d4bb\x1d4bd-\x1d4c3\x1d4c5-\x1d4cf\x1d4ea-\x1d503\x1d51e-\x1d537\x1d552-\x1d56b\x1d586-\x1d59f\x1d5ba-\x1d5d3\x1d5ee-\x1d607\x1d622-\x1d63b\x1d656-\x1d66f\x1d68a-\x1d6a5\x1d6c2-\x1d6da\x1d6dc-\x1d6e1\x1d6fc-\x1d714\x1d716-\x1d71b\x1d736-\x1d74e\x1d750-\x1d755\x1d770-\x1d788\x1d78a-\x1d78f\x1d7aa-\x1d7c2\x1d7c4-\x1d7c9\x1d7cb\x1e922-\x1e943_]+$alpha = [$small $large]++$graphic = [$small $large $symbol $digit $special \:\"\']++$octit = 0-7+$hexit = [0-9 A-F a-f]+$idchar = [$alpha $digit \']+$symchar = [$symbol \:]+$nl = [\n\r]++@reservedid =+ case|default|else|if|+ infix|infixl|infixr|+ then|family|foreign|export|dynamic|+ safe|threadsafe|unsafe|stdcall|ccall|dotnet++@varid = $small $idchar* [\#]?+@conid = $large $idchar* [\#]?+@anyid = (@varid | @conid)+@anyTHid = [$small $large] [$alpha $digit]*+@qual = (@conid ".")*+@varsym = $symbol $symchar* | [⤜ ⤚ ⤛ ⤙ ★]+@consym = \: $symchar*++@decimal = $digit++@octal = $octit++@hexadecimal = $hexit++@exponent = [eE] [\-\+] @decimal++$cntrl = [$large \@\[\\\]\^\_]+@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK+ | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE+ | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM+ | SUB | ESC | FS | GS | RS | US | SP | DEL+$charesc = [abfnrtv\\\"\'\&]+@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal)+@gap = \\ $whitechar+ \\+@string = $graphic # [\"\\] | " " | @escape | @gap++haskell :-++<0> $white+ ;++<nestcomm> {+ "{-" { m (subtract 1) (Comment Open) }+ "-}" { m (+1) (Comment Close) }+ $white+ ; -- whitespace+ [^\-\{]+ { c $ Comment Text } -- rule to generate comments larger than 1 char+ . { c $ Comment Text }+}++<0> {+-- The first rule matches operators that begin with --, eg --++-- is a valid+-- operator and *not* a comment.+-- Note that we have to dissallow '-' as a symbol char for the first one+-- of these because we may have -------- which would stilljust be the+-- start of a comment.+ "--"\-* [$symbol # \-] $symchar* { cs Operator }+-- The next rule allows for the start of a comment basically+-- it is -- followed by anything which isn't a symbol character+-- (OR more '-'s). So for example "-----:" is still the start of a comment.+ "--"~[$symbol # \-][^$nl]* { c $ Comment Line }+-- Finally because the above rule had to add in a non symbol character+-- it's also possible that we have just finishing a line,+-- people sometimes do this for example when breaking up paragraphs+-- in a long comment.+ "--"$nl { c $ Comment Line }++ "{-" { m (subtract 1) $ Comment Open }++ ^"#".* { c $ CppDirective }+ $special { cs $ \(c:_) -> Special c }+ "deriving" { c (Reserved Deriving) }+ "forall" { c (Reserved Forall) }+ "∀" { c (Reserved Forall) }+ @reservedid { c (Reserved Other) }+ "hiding" { c (Reserved Hiding) }+ "module" { c (Reserved Module) }+ "type" { c (Reserved Type) }+ "newtype" { c (Reserved NewType) }+ "as" { c (Reserved As) }+ "import" { c (Reserved Import) }+ "data" { c (Reserved Data) }+ "where" { c (Reserved Where) }+ "qualified" { c (Reserved Qualified) }+ "let" { c (Reserved Let) }+ "in" { c (Reserved In) }+ "of" { c (Reserved Of) }+ "do" | "mdo" { c (Reserved Do) }+ "class" { c (Reserved Class) }+ "instance" { c (Reserved Instance) }+ `@qual @varid` { cs $ Operator . init . tail }+ `@qual @conid` { cs $ ConsOperator . init . tail }+ @qual @varid { c VarIdent }+ @qual @conid { c ConsIdent }++ "|" { c (ReservedOp Pipe) }+ "=" { c (ReservedOp Equal) }+ \\ { c (ReservedOp BackSlash) }+ "<-" | "←" { c (ReservedOp LeftArrow) }+ "->" | "→" { c (ReservedOp RightArrow) }+ ".." { c (ReservedOp DoubleDot) }+ "@" { c (ReservedOp Arobase) }+ "~" { c (ReservedOp Tilda) }+ "=>" | "⇒" { c (ReservedOp DoubleRightArrow) }+ "::" | "∷" { c (ReservedOp DoubleColon) }+ @qual @varsym { cs Operator }+ @qual @consym { cs ConsOperator }++ @decimal+ | 0[oO] @octal+ | 0[xX] @hexadecimal { c Number }++ @decimal \. @decimal @exponent?+ | @decimal @exponent { c Number }++ \'\' @anyid { c THQuote } -- type+ \' @anyTHid { c THQuote } -- expression+ \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok }+ \" @string* \" { c StringTok }+ . { c Unrecognized }+}++{++type HlState = Int++data CommentType = Open | Close | Text | Line+ deriving (Eq, Show)++data ReservedType = Hiding | Qualified | As | Import | Data | NewType | Type | Where+ | Let | In | Do | Of | OtherLayout | Deriving | Module | Forall | Other | Class | Instance+ deriving (Eq, Show)++data OpType = Pipe | Equal | BackSlash | LeftArrow | RightArrow | DoubleRightArrow | DoubleColon | DoubleDot | Arobase | Tilda+ deriving (Eq, Show)++data Token = Number | CharTok | StringTok | VarIdent | ConsIdent+ | Reserved !ReservedType | ReservedOp !OpType | Special Char+ | ConsOperator String | Operator String+ | Comment !CommentType+ | THQuote+ | CppDirective | Unrecognized+ deriving (Eq, Show)++tokenToStyle :: Token -> StyleName+tokenToStyle tok = case tok of+ CppDirective -> preprocessorStyle+ Number -> numberStyle+ CharTok -> stringStyle+ StringTok -> stringStyle+ VarIdent -> variableStyle+ ConsIdent -> typeStyle+ ReservedOp _ -> operatorStyle+ Reserved Import -> importStyle+ Reserved Qualified -> importStyle+ Reserved As -> importStyle+ Reserved Hiding -> importStyle+ Reserved _ -> keywordStyle+ Special _ -> defaultStyle+ ConsOperator _ -> operatorStyle+ Operator _ -> operatorStyle+ Comment _ -> commentStyle+ THQuote -> quoteStyle+ Unrecognized -> errorStyle++tokenToText :: Token -> Maybe String+tokenToText (ReservedOp BackSlash) = Just "λ"+tokenToText (ReservedOp RightArrow) = Just "→ "+tokenToText (ReservedOp DoubleRightArrow) = Just "⇒ "+tokenToText (ReservedOp LeftArrow) = Just "← "+tokenToText (ReservedOp DoubleColon) = Just "∷ "+-- missing: ++ >>=+tokenToText (Operator "*") = Just "×"+tokenToText (Operator "-") = Just "−"+-- tokenToText (Operator "-->") = Just " ⟶ "+tokenToText (Operator ".") = Just "·"+tokenToText (Operator "/=") = Just "≠ "+-- tokenToText (Operator "<--") = Just " ⟵ "+tokenToText (Operator "<-|") = Just " ↤ "+-- tokenToText (Operator "<<") = Just "⟪ "+tokenToText (Operator "<|") = Just "◃ "+tokenToText (Operator "<~") = Just "↜ "+tokenToText (Operator "==") = Just "≡ "+-- tokenToText (Operator "==>") = Just " ⟹ "+tokenToText (Operator "=?") = Just "≟ "+-- tokenToText (Operator ">>") = Just "⟫ "+tokenToText (Operator "|-->") = Just " ⟼ "+tokenToText (Operator "|->") = Just " ↦ "+tokenToText (Operator "|>") = Just "▹ "+tokenToText (Operator "~=") = Just "≃ "+tokenToText (Operator "~>") = Just "↝ "+tokenToText (Operator ">=") = Just "≥ "+tokenToText (Operator "<=") = Just "≤ "+tokenToText (Operator "-<") = Just "↢ "+tokenToText (Operator "&&") = Just "∧ "+tokenToText (Operator "||") = Just "∨ "+{- these are not operators+tokenToText (Operator "_|_") = Just " ⊥ "+tokenToText (Operator "exists") = Just " ∃ "+tokenToText (Operator "not") = Just " ¬ "+tokenToText (Operator "neg") = Just " ¬ "+-}+tokenToText (Reserved Forall) = Just " ∀ "+tokenToText _ = Nothing++startsLayout (Reserved Do) = True+startsLayout (Reserved Of) = True+startsLayout (Reserved Where) = True+startsLayout (Reserved Let) = True+startsLayout (Reserved OtherLayout) = True+startsLayout _ = False++isComment (Comment _) = True+isComment _ = False++stateToInit x | x < 0 = nestcomm+ | otherwise = 0++initState :: HlState+initState = 0++type TT = Tok Token++isSpecial :: String -> Token -> Bool+isSpecial cs (Special c) = c `elem` cs+isSpecial _ _ = False++isErrorTok :: Token -> Bool+isErrorTok = isSpecial "!"+++#include "common.hsinc"+}
+ src/Yi/Lexer/LiterateHaskell.x view
@@ -0,0 +1,224 @@+-- -*- haskell -*-+--+-- Lexical syntax for literate Haskell 98.+--+-- (c) Simon Marlow 2003, with the caveat that much of this is+-- translated directly from the syntax in the Haskell 98 report.+--+-- Adapted to literate Haskell 98 by Nicolas Pouillard+--++{+{-# OPTIONS -w #-}+module Yi.Lexer.LiterateHaskell ( initState, alexScanToken, HlState ) where+import Yi.Lexer.Alex hiding (tokenToStyle)+import Yi.Lexer.Haskell hiding (initState, alexScanToken, HlState)+import Yi.Style+}++$whitechar = [\ \t\n\r\f\v]+$special = [\(\)\,\;\[\]\`\{\}]++$ascdigit = 0-9+$unidigit = [] -- TODO+$digit = [$ascdigit $unidigit]++$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]+$unisymbol = [] -- TODO+$symbol = [$ascsymbol $unisymbol] # [$special \_\:\"\']++$large = [A-Z \xc0-\xd6 \xd8-\xde]+$small = [a-z \xdf-\xf6 \xf8-\xff \_]+$alpha = [$small $large]++$graphic = [$small $large $symbol $digit $special \:\"\']++$octit = 0-7+$hexit = [0-9 A-F a-f]+$idchar = [$alpha $digit \']+$symchar = [$symbol \:]+$nl = [\n\r]++@reservedid =+ as|case|class|data|default|else|hiding|if|+ import|in|infix|infixl|infixr|instance|newtype|+ qualified|then|type|family|foreign|export|dynamic|+ safe|threadsafe|unsafe|stdcall|ccall|dotnet++@layoutReservedId =+ of|let|do|mdo+++@reservedop =+ ".." | ":" | "::" | "=" | \\ | "|" | "<-" | "->" | "@" | "~" | "=>"++@varid = $small $idchar*+@conid = $large $idchar*+@qual = (@conid ".")*+@varsym = $symbol $symchar*+@consym = \: $symchar*++@decimal = $digit++@octal = $octit++@hexadecimal = $hexit++@exponent = [eE] [\-\+] @decimal++$cntrl = [$large \@\[\\\]\^\_]+@ascii = \^ $cntrl | NUL | SOH | STX | ETX | EOT | ENQ | ACK+ | BEL | BS | HT | LF | VT | FF | CR | SO | SI | DLE+ | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN | EM+ | SUB | ESC | FS | GS | RS | US | SP | DEL+$charesc = [abfnrtv\\\"\'\&]+@escape = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal)+@gap = \\ $whitechar+ \\+@string = $graphic # [\"\\] | " " | @escape | @gap++haskell :-++<0> $white+ ;++<nestcomm> {+ "{-" { m CommentBlock (Comment Open) }+ "-}" { m unComment (Comment Close) }+ $white+ ; -- whitespace+ [^\-\{]+ { c $ Comment Text } -- rule to generate comments larger than 1 char+ . { c $ Comment Text }+}++<0> {+ ^ "\begin{code}" { m (const CodeBlock) $ Reserved Other }+ ^ ">" { ms (const CodeLine) Operator }+ $white+ ; -- whitespace+ . { c $ Comment Text {-LaTeX-} }+}++<codeBlock> {+ "\end{code}" { m (const LaTeXBlock) $ Reserved Other }++ $white+ ; -- whitespace++-- The first rule matches operators that begin with --, eg --++-- is a valid+-- operator and *not* a comment.+-- Note that we have to dissallow '-' as a symbol char for the first one+-- of these because we may have -------- which would stilljust be the+-- start of a comment.+ "--"\-* [$symbol # \-] $symchar* { cs Operator }+-- The next rule allows for the start of a comment basically+-- it is -- followed by anything which isn't a symbol character+-- (OR more '-'s). So for example "-----:" is still the start of a comment.+ "--"~[$symbol # \-][^$nl]* { c $ Comment Line }+-- Finally because the above rule had to add in a non symbol character+-- it's also possible that we have just finishing a line,+-- people sometimes do this for example when breaking up paragraphs+-- in a long comment.+ "--"$nl { c $ Comment Line }++ "{-" { m CommentBlock $ Comment Open }++ ^"#".* { c $ CppDirective }+ $special { cs $ \(c:_) -> Special c }+ "deriving" { c (Reserved Deriving) }+ "forall" { c (Reserved Forall) }+ @reservedid { c (Reserved Other) }+ "module" { c (Reserved Module) }+ "where" { c (Reserved Where) }+ @layoutReservedId { c (Reserved OtherLayout) }+ `@qual @varid` { cs $ Operator . init . tail }+ `@qual @conid` { cs $ ConsOperator . init . tail }+ @qual @varid { c VarIdent }+ @qual @conid { c ConsIdent }++ "|" { c (ReservedOp Pipe) }+ "=" { c (ReservedOp Equal) }+ \\ { c (ReservedOp BackSlash) }+ "<-" { c (ReservedOp LeftArrow) }+ "->" { c (ReservedOp RightArrow) }+ "=>" { c (ReservedOp DoubleRightArrow) }+ ".." { c (ReservedOp DoubleDot) }+ "@" { c (ReservedOp Arobase) }+ "~" { c (ReservedOp Tilda) }+ "=>" { c (ReservedOp DoubleRightArrow) }+ "::" { c (ReservedOp DoubleColon) }+ @qual @varsym { cs Operator }+ @qual @consym { cs ConsOperator }++ @decimal+ | 0[oO] @octal+ | 0[xX] @hexadecimal { c Number }++ @decimal \. @decimal @exponent?+ | @decimal @exponent { c Number }++ \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok }+ \" @string* \" { c StringTok }+ . { c Unrecognized }+}++<codeLine> {+ [\t\n\r\f\v]+ { m (const LaTeXBlock) $ Reserved Other }++ [\ \t]+ ; -- whitespace++-- Same three rules for line comments as above (see above for explanation).+ "--"\-* [$symbol # \-] $symchar* { cs Operator }+ "--"~[$symbol # \-][^$nl]* { c $ Comment Line }+ "--"$nl { c $ Comment Line }++ "{-" { m CommentBlock $ Comment Open }++ ^"#".* { c $ CppDirective }+ $special { cs $ \(c:_) -> Special c }+ "deriving" { c (Reserved Deriving) }+ "forall" { c (Reserved Forall) }+ @reservedid { c (Reserved Other) }+ "module" { c (Reserved Module) }+ "where" { c (Reserved Where) }+ @layoutReservedId { c (Reserved OtherLayout) }+ `@qual @varid` { cs $ Operator . init . tail }+ `@qual @conid` { cs $ ConsOperator . init . tail }+ @qual @varid { c VarIdent }+ @qual @conid { c ConsIdent }++ "|" { c (ReservedOp Pipe) }+ "=" { c (ReservedOp Equal) }+ \\ { c (ReservedOp BackSlash) }+ "<-" { c (ReservedOp LeftArrow) }+ "->" { c (ReservedOp RightArrow) }+ "=>" { c (ReservedOp DoubleRightArrow) }+ ".." { c (ReservedOp DoubleDot) }+ "@" { c (ReservedOp Arobase) }+ "~" { c (ReservedOp Tilda) }+ "=>" { c (ReservedOp DoubleRightArrow) }+ "::" { c (ReservedOp DoubleColon) }+ @qual @varsym { cs Operator }+ @qual @consym { cs ConsOperator }++ @decimal+ | 0[oO] @octal+ | 0[xX] @hexadecimal { c Number }++ @decimal \. @decimal @exponent?+ | @decimal @exponent { c Number }++ \' ($graphic # [\'\\] | " " | @escape) \' { c CharTok }+ \" @string* \" { c StringTok }+ . { c Unrecognized }+}++{++data HlState = CodeBlock+ | CodeLine+ | CommentBlock { unComment :: HlState }+ | LaTeXBlock+ deriving (Eq, Show)++stateToInit (CommentBlock _) = nestcomm+stateToInit CodeBlock = codeBlock+stateToInit CodeLine = codeLine+stateToInit LaTeXBlock = 0++initState = LaTeXBlock++#include "common.hsinc"+}
+ src/Yi/Mode/GHCi.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Mode.GHCi+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- A mode for GHCi, implemented as tweaks on Interaction mode++module Yi.Mode.GHCi where++import GHC.Generics (Generic)++import Lens.Micro.Platform (makeLenses, (%~), (&), (.~))+import Data.Binary (Binary (..))+import Data.Default (Default (..))+import Data.Text ()+import qualified Data.Text as T (findIndex)+import Data.Typeable (Typeable)+import Yi.Buffer+import Yi.Keymap (YiM, topKeymapA)+import Yi.Keymap.Keys (Key (KHome), important, spec, (?>>!))+import Yi.Lexer.Alex (Tok)+import Yi.Lexer.Compilation (Token ())+import qualified Yi.Mode.Interactive as I (mode, spawnProcessMode)+import qualified Yi.Rope as R (toText)+import Yi.Syntax.OnlineTree (Tree)+import Yi.Types (YiVariable)++-- | The process name to use to spawn GHCi.+data GhciProcessName = GhciProcessName+ { _ghciProcessName :: FilePath+ -- ^ Command to run when spawning GHCi.+ , _ghciProcessArgs :: [String]+ -- ^ Args to pass to the process.+ } deriving (Typeable, Show, Generic)++-- | The process name defaults to @ghci@.+instance Default GhciProcessName where+ def = GhciProcessName { _ghciProcessName = "ghci"+ , _ghciProcessArgs = []+ }++instance Binary GhciProcessName++makeLenses ''GhciProcessName++-- | Setting this is a bit like '(setq haskell-program-name foo)' in+-- emacs' @haskell-mode@.+instance YiVariable GhciProcessName++-- | Mode used for GHCi. Currently it just overrides 'KHome' key to go+-- just before the prompt through the use of 'homeKey'.+mode :: Mode (Tree (Tok Token))+mode = I.mode+ & modeNameA .~ "ghci"+ & modeKeymapA .~ topKeymapA %~ important (spec KHome ?>>! homeKey)++-- | The GHCi prompt always begins with ">"; this goes to just before+-- it, or if one is already at the start of the prompt, goes to the+-- beginning of the line. (If at the beginning of the line, this+-- pushes you forward to it.)+homeKey :: BufferM ()+homeKey = readLnB >>= \l -> case T.findIndex ('>' ==) (R.toText l) of+ Nothing -> moveToSol+ Just pos -> do+ (_,mypos) <- getLineAndCol+ moveToSol >> if mypos == (pos + 2)+ then return ()+ else moveXorEol (pos + 2)++-- | Spawns an interactive process ("Yi.Mode.Interactive") with GHCi+-- 'mode' over it.+spawnProcess :: FilePath -- ^ Command to use.+ -> [String] -- ^ Process args.+ -> YiM BufferRef -- ^ Reference to the spawned buffer.+spawnProcess = I.spawnProcessMode mode
+ src/Yi/Mode/Haskell.hs view
@@ -0,0 +1,470 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Mode.Haskell+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Collection of 'Mode's for working with Haskell.++module Yi.Mode.Haskell+ (+ -- * Modes+ haskellAbstract,+ cleverMode,+ preciseMode,+ literateMode,+ fastMode,++ -- * IO-level operations+ ghciGet,+ ghciSend,+ ghciLoadBuffer,+ ghciInferType,+ ghciSetProcessName,+ ghciSetProcessArgs+ ) where++import Prelude hiding (all, concatMap, elem, error, notElem, exp)++import Lens.Micro.Platform ((&), (.~), (^.))+import Control.Monad (unless, void, when)+import Data.Binary (Binary)+import Data.Default (Default)+import Data.Foldable (all, concatMap, elem, forM_, notElem)+import Data.Maybe (isJust, listToMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T (any, concat, drop, pack, unpack, unwords)+import Data.Typeable (Typeable)+import Text.Read (readMaybe)+import Yi.Buffer+import Yi.Core (sendToProcess)+import Yi.Debug (error, trace)+import Yi.Editor+import Yi.File (fwriteE)+import qualified Yi.IncrementalParse as IncrParser (State, scanner)+import Yi.Keymap (YiM)+import Yi.Lexer.Alex+import Yi.Lexer.Haskell as Haskell+import qualified Yi.Lexer.LiterateHaskell as LiterateHaskell (HlState, alexScanToken, initState)+import Yi.MiniBuffer (noHint, withMinibufferFree, withMinibufferGen)+import qualified Yi.Mode.GHCi as GHCi (ghciProcessArgs, ghciProcessName, spawnProcess)+import qualified Yi.Mode.Interactive as Interactive (queryReply)+import Yi.Mode.Common (anyExtension, extensionOrContentsMatch, shebangParser)+import Yi.Monad (gets)+import qualified Yi.Rope as R+import Yi.String (fillText, showT)+import Yi.Syntax (ExtHL (..), Scanner, skipScanner)+import qualified Yi.Syntax.Driver as Driver (mkHighlighter)+import Yi.Syntax.Haskell as Hask+import Yi.Syntax.Layout (State)+import Yi.Syntax.OnlineTree as OnlineTree (Tree, manyToks)+import Yi.Syntax.Paren as Paren+import Yi.Syntax.Strokes.Haskell as HS (getStrokes)+import Yi.Syntax.Tree+import Yi.Types (YiVariable)+import Yi.Utils (groupBy')++-- | General ‘template’ for actual Haskell modes.+--+-- It applies over @extensions = ["hs", "x", "hsc", "hsinc"]@ which+-- may be a little questionable but for now Yi is mostly used by+-- Haskell hackers so it should be fine, at least for now.+haskellAbstract :: Mode (tree TT)+haskellAbstract = emptyMode+ & modeAppliesA .~ extensionOrContentsMatch extensions (shebangParser "runhaskell")+ & modeNameA .~ "haskell"+ & modeToggleCommentSelectionA .~ Just (toggleCommentB "--")+ where extensions = ["hs", "x", "hsc", "hsinc"]++-- | "Clever" haskell mode, using the paren-matching syntax.+cleverMode :: Mode (Paren.Tree (Tok Haskell.Token))+cleverMode = haskellAbstract+ & modeIndentA .~ cleverAutoIndentHaskellB+ & modeGetStrokesA .~ strokesOfParenTree+ & modeHLA .~ mkParenModeHL (skipScanner 50) haskellLexer+ & modeAdjustBlockA .~ adjustBlock+ & modePrettifyA .~ cleverPrettify . allToks++fastMode :: Mode (OnlineTree.Tree TT)+fastMode = haskellAbstract+ & modeNameA .~ "fast haskell"+ & modeHLA .~ mkOnlineModeHL haskellLexer+ & modeGetStrokesA .~ tokenBasedStrokes Paren.tokenToStroke++literateMode :: Mode (Paren.Tree TT)+literateMode = haskellAbstract+ & modeNameA .~ "literate haskell"+ & modeAppliesA .~ anyExtension ["lhs"]+ & modeHLA .~ mkParenModeHL id literateHaskellLexer+ & modeGetStrokesA .~ strokesOfParenTree+ -- FIXME I think that 'begin' should not be ignored+ & modeAdjustBlockA .~ adjustBlock+ & modeIndentA .~ cleverAutoIndentHaskellB+ & modePrettifyA .~ cleverPrettify . allToks++-- | Experimental Haskell mode, using a rather precise parser for the syntax.+preciseMode :: Mode (Hask.Tree TT)+preciseMode = haskellAbstract+ & modeNameA .~ "precise haskell"+ & modeIndentA .~ cleverAutoIndentHaskellC+ & modeGetStrokesA .~ (\ast point begin end -> HS.getStrokes point begin end ast)+ & modeHLA .~ mkHaskModeHL haskellLexer+ & modePrettifyA .~ cleverPrettify . allToks+--+strokesOfParenTree :: Paren.Tree TT -> Point -> Point -> Point -> [Stroke]+strokesOfParenTree t p b e = Paren.getStrokes p b e t++type CharToTTScanner s = CharScanner -> Scanner (AlexState s) TT++mkParenModeHL :: (IsTree tree, Show state)+ => (Scanner+ (IncrParser.State (State Token lexState) TT (Paren.Tree TT))+ (Paren.Tree TT)+ -> Scanner state (tree (Tok tt)))+ -> CharToTTScanner lexState+ -> ExtHL (tree (Tok tt))+mkParenModeHL f l = ExtHL $ Driver.mkHighlighter scnr+ where+ scnr = f . IncrParser.scanner Paren.parse . Paren.indentScanner . l++mkHaskModeHL :: Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token))+mkHaskModeHL l = ExtHL $ Driver.mkHighlighter scnr+ where+ scnr = IncrParser.scanner Hask.parse . Hask.indentScanner . l++mkOnlineModeHL :: Show st => (CharScanner -> Scanner st (Tok tt))+ -> ExtHL (OnlineTree.Tree (Tok tt))+mkOnlineModeHL l = ExtHL $ Driver.mkHighlighter scnr+ where+ scnr = IncrParser.scanner OnlineTree.manyToks . l++haskellLexer :: CharScanner -> Scanner (AlexState Haskell.HlState) TT+haskellLexer = lexScanner (commonLexer Haskell.alexScanToken Haskell.initState)++literateHaskellLexer :: CharScanner -> Scanner (AlexState LiterateHaskell.HlState) TT+literateHaskellLexer = lexScanner (commonLexer LiterateHaskell.alexScanToken LiterateHaskell.initState)++adjustBlock :: Paren.Tree (Tok Token) -> Int -> BufferM ()+adjustBlock e len = do+ p <- pointB+ l <- curLn+ let t = Paren.getIndentingSubtree e p l+ case t of+ Nothing -> return ()+ Just it -> savingExcursionB $ do+ let (_startOfs, height) = Paren.getSubtreeSpan it+ col <- curCol+ forM_ [1..height] $ const $ do+ lineDown+ indent <- indentOfB =<< readLnB+ -- it might be that we have 1st column comments in the block,+ -- which should not be changed.+ when (indent > col) $+ if len >= 0+ then do+ insertN $ R.replicateChar len ' '+ leftN len+ else deleteN (negate len)++-- | Returns true if the token should be indented to look as "inside"+-- the group.+insideGroup :: Token -> Bool+insideGroup (Special c) = T.any (== c) "',;})]"+insideGroup _ = True++-- | Helper method for taking information needed for both Haskell auto-indenters:+indentInfoB :: BufferM (Int, Int, Int, Point, Point)+indentInfoB = do+ indentLevel <- shiftWidth <$> indentSettingsB+ previousIndent <- indentOfB =<< getNextNonBlankLineB Backward+ nextIndent <- indentOfB =<< getNextNonBlankLineB Forward+ solPnt <- pointAt moveToSol+ eolPnt <- pointAt moveToEol+ return (indentLevel, previousIndent, nextIndent, solPnt, eolPnt)++cleverAutoIndentHaskellB :: Paren.Tree TT -> IndentBehaviour -> BufferM ()+cleverAutoIndentHaskellB e behaviour = do+ (indentLevel, previousIndent, nextIndent, solPnt, eolPnt) <- indentInfoB+ let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt+ firstTokNotOnLine = listToMaybe .+ filter (not . onThisLine . posnOfs . tokPosn) .+ filter (not . isErrorTok . tokT) . concatMap allToks+ let stopsOf :: [Paren.Tree TT] -> [Int]+ stopsOf (g@(Paren.Paren open ctnt close):ts')+ | isErrorTok (tokT close) || getLastOffset g >= solPnt+ = [groupIndent open ctnt] -- stop here: we want to be "inside" that group.+ | otherwise = stopsOf ts' -- this group is closed before this line; just skip it.+ stopsOf (Paren.Atom (Tok {tokT = t}):_) | startsLayout t = [nextIndent, previousIndent + indentLevel]+ -- of; where; etc. we want to start the block here.+ -- Also use the next line's indent:+ -- maybe we are putting a new 1st statement in the block here.+ stopsOf (Paren.Atom _:ts) = stopsOf ts+ -- any random part of expression, we ignore it.+ stopsOf (t@(Paren.Block _):ts) = shiftBlock + maybe 0 (posnCol . tokPosn) (getFirstElement t) : stopsOf ts+ stopsOf (_:ts) = stopsOf ts+ stopsOf [] = []+ firstTokOnLine = fmap tokT $ listToMaybe $+ dropWhile ((solPnt >) . tokBegin) $+ takeWhile ((eolPnt >) . tokBegin) $ -- for laziness.+ filter (not . isErrorTok . tokT) $ allToks e+ shiftBlock = case firstTokOnLine of+ Just (Reserved t) | t `elem` [Where, Deriving] -> indentLevel+ Just (ReservedOp Haskell.Pipe) -> indentLevel+ Just (ReservedOp Haskell.Equal) -> indentLevel+ _ -> 0+ deepInGroup = maybe True insideGroup firstTokOnLine+ groupIndent (Tok {tokT = Special openChar, tokPosn = Posn _ _ openCol}) ctnt+ | deepInGroup = case firstTokNotOnLine ctnt of+ -- examine the first token of the group (but not on the line we are indenting!)+ Nothing -> openCol + nominalIndent openChar -- no such token: indent normally.+ Just t -> posnCol . tokPosn $ t -- indent along that other token+ | otherwise = openCol+ groupIndent (Tok {}) _ = error "unable to indent code"+ case getLastPath [e] solPnt of+ Nothing -> return ()+ Just path -> let stops = stopsOf path+ in trace ("Stops = " <> showT stops) $+ trace ("firstTokOnLine = " <> showT firstTokOnLine) $+ cycleIndentsB behaviour stops++cleverAutoIndentHaskellC :: Exp TT -> IndentBehaviour -> BufferM ()+cleverAutoIndentHaskellC e behaviour = do+ (indentLevel, previousIndent, nextIndent, solPnt, eolPnt) <- indentInfoB+ let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt+ firstTokNotOnLine = listToMaybe .+ filter (not . onThisLine . posnOfs . tokPosn) .+ filter (not . isErrorTok . tokT) . concatMap allToks+ let stopsOf :: [Hask.Exp TT] -> [Int]+ stopsOf (g@(Hask.Paren (Hask.PAtom open _) ctnt (Hask.PAtom close _)):ts)+ | isErrorTok (tokT close) || getLastOffset g >= solPnt+ = [groupIndent open ctnt]+ -- stop here: we want to be "inside" that group.+ | otherwise = stopsOf ts+ -- this group is closed before this line; just skip it.+ stopsOf (Hask.PAtom (Tok {tokT = t}) _:_) | startsLayout t || (t == ReservedOp Equal)+ = [nextIndent, previousIndent + indentLevel]+ -- of; where; etc. ends the previous line. We want to start the block here.+ -- Also use the next line's indent:+ -- maybe we are putting a new 1st statement in the block here.+ stopsOf (l@(Hask.PLet _ (Hask.Block _) _):ts') = [colOf' l | lineStartsWith (Reserved Haskell.In)] <> stopsOf ts'+ -- offer to align with let only if this is an "in"+ stopsOf (t@(Hask.Block _):ts') = (shiftBlock + colOf' t) : stopsOf ts'+ -- offer add another statement in the block+ stopsOf (Hask.PGuard' (PAtom pipe _) _ _:ts') = [tokCol pipe | lineStartsWith (ReservedOp Haskell.Pipe)] <> stopsOf ts'+ -- offer to align against another guard+ stopsOf (d@(Hask.PData {}):ts') = colOf' d + indentLevel+ : stopsOf ts' --FIXME!+ stopsOf (Hask.RHS (Hask.PAtom{}) exp:ts')+ = [case firstTokOnLine of+ Just (Operator op') -> opLength op' (colOf' exp) -- Usually operators are aligned against the '=' sign+ -- case of an operator should check so that value always is at least 1+ _ -> colOf' exp | lineIsExpression ] <> stopsOf ts'+ -- offer to continue the RHS if this looks like an expression.+ stopsOf [] = [0] -- maybe it's new declaration in the module+ stopsOf (_:ts) = stopsOf ts -- by default, there is no reason to indent against an expression.+ -- calculate indentation of operator (must be at least 1 to be valid)+ opLength ts' r = let l = r - (length ts' + 1) -- I find this dubious...+ in if l > 0 then l else 1++ lineStartsWith tok = firstTokOnLine == Just tok+ lineIsExpression = all (`notElem` [ReservedOp Haskell.Pipe, ReservedOp Haskell.Equal, ReservedOp RightArrow]) toksOnLine+ && not (lineStartsWith (Reserved Haskell.In))+ -- TODO: check the tree instead of guessing by looking at tokens+ firstTokOnLine = listToMaybe toksOnLine+ toksOnLine = fmap tokT $+ dropWhile ((solPnt >) . tokBegin) $+ takeWhile ((eolPnt >) . tokBegin) $ -- for laziness.+ filter (not . isErrorTok . tokT) $ allToks e+ shiftBlock = case firstTokOnLine of+ Just (Reserved t) | t `elem` [Where, Deriving] -> indentLevel+ Just (ReservedOp Haskell.Pipe) -> indentLevel+ Just (ReservedOp Haskell.Equal) -> indentLevel+ _ -> 0+ deepInGroup = maybe True insideGroup firstTokOnLine+ groupIndent (Tok {tokT = Special openChar, tokPosn = Posn _ _ openCol}) ctnt+ | deepInGroup = case firstTokNotOnLine ctnt of+ -- examine the first token of the group+ -- (but not on the line we are indenting!)+ Nothing -> openCol + nominalIndent openChar+ -- no such token: indent normally.+ Just t -> posnCol . tokPosn $ t -- indent along that other token+ | otherwise = openCol+ groupIndent (Tok{}) _ = error "unable to indent code"+ case getLastPath [e] solPnt of+ Nothing -> return ()+ Just path ->let stops = stopsOf path+ in trace ("Path = " <> showT path) $+ trace ("Stops = " <> showT stops) $+ trace ("Previous indent = " <> showT previousIndent) $+ trace ("Next indent = " <> showT nextIndent) $+ trace ("firstTokOnLine = " <> showT firstTokOnLine) $+ cycleIndentsB behaviour stops++colOf' :: Foldable t => t TT -> Int+colOf' = maybe 0 tokCol . getFirstElement++tokCol :: Tok t -> Int+tokCol = posnCol . tokPosn+++nominalIndent :: Char -> Int+nominalIndent '{' = 2+nominalIndent _ = 1++tokText :: Tok t -> BufferM R.YiString+tokText = readRegionB . tokRegion++tokRegion :: Tok t -> Region+tokRegion t = mkRegion (tokBegin t) (tokEnd t)++isLineComment :: TT -> Bool+isLineComment = (Just Haskell.Line ==) . tokTyp . tokT++contiguous :: Tok t -> Tok t -> Bool+contiguous a b = lb - la <= 1+ where [la,lb] = fmap (posnLine . tokPosn) [a,b]++coalesce :: Tok Token -> Tok Token -> Bool+coalesce a b = isLineComment a && isLineComment b && contiguous a b++cleverPrettify :: [TT] -> BufferM ()+cleverPrettify toks = do+ pnt <- pointB+ let groups = groupBy' coalesce toks+ isCommentGroup g = tokTyp (tokT $ head g) `elem` fmap Just [Haskell.Line]+ thisCommentGroup = listToMaybe $ dropWhile ((pnt >) . tokEnd . last) $ filter isCommentGroup groups+ -- FIXME: laziness+ case thisCommentGroup of+ Nothing -> return ()+ Just g -> do+ text <- T.unwords . fmap (T.drop 2 . R.toText) <$> mapM tokText g+ let region = mkRegion (tokBegin . head $ g) (tokEnd . last $ g)+ mkGrp = const . R.unlines $ R.append "-- " <$> fillText 80 (R.fromText text)+ modifyRegionB mkGrp region++tokTyp :: Token -> Maybe Haskell.CommentType+tokTyp (Comment t) = Just t+tokTyp _ = Nothing++-- TODO: export or remove+-- -- Keyword-based auto-indenter for haskell.+-- autoIndentHaskellB :: IndentBehaviour -> BufferM ()+-- autoIndentHaskellB =+-- autoIndentWithKeywordsB [ "if"+-- , "then"+-- , "else"+-- , "|"+-- , "->"+-- , "case" -- hmm+-- , "in"+-- -- Note tempted by having '=' in here that would+-- -- potentially work well for 'data' declarations+-- -- but I think '=' is so common in other places+-- -- that it would introduce many spurious/annoying+-- -- hints.+-- ]+-- [ "where"+-- , "let"+-- , "do"+-- , "mdo"+-- , "{-"+-- , "{-|"+-- , "--"+-- ]+--+---------------------------+-- * Interaction with GHCi++-- | Variable storing the possibe buffer reference where GHCi is+-- currently running.+newtype GhciBuffer = GhciBuffer {_ghciBuffer :: Maybe BufferRef}+ deriving (Default, Typeable, Binary)++instance YiVariable GhciBuffer++-- | Start GHCi in a buffer+ghci :: YiM BufferRef+ghci = do+ g <- getEditorDyn+ b <- GHCi.spawnProcess (g ^. GHCi.ghciProcessName) (g ^. GHCi.ghciProcessArgs)+ withEditor . putEditorDyn . GhciBuffer $ Just b+ return b++-- | Return GHCi's buffer; create it if necessary.+-- Show it in another window.+ghciGet :: YiM BufferRef+ghciGet = withOtherWindow $ do+ GhciBuffer mb <- withEditor getEditorDyn+ case mb of+ Nothing -> ghci+ Just b -> do+ stillExists <- isJust <$> findBuffer b+ if stillExists+ then do withEditor $ switchToBufferE b+ return b+ else ghci++-- | Send a command to GHCi+ghciSend :: String -> YiM ()+ghciSend cmd = do+ b <- ghciGet+ withGivenBuffer b botB+ sendToProcess b (cmd <> "\n")++-- | Load current buffer in GHCi+ghciLoadBuffer :: YiM ()+ghciLoadBuffer = do+ void fwriteE+ f <- withCurrentBuffer (gets file)+ case f of+ Nothing -> error "Couldn't get buffer filename in ghciLoadBuffer"+ Just filename -> ghciSend $ ":load " <> show filename++-- Tells ghci to infer the type of the identifier at point. Doesn't+-- check for errors (yet)+ghciInferType :: YiM ()+ghciInferType = do+ nm <- withCurrentBuffer (readUnitB unitWord)+ unless (R.null nm) $+ withMinibufferGen (R.toText nm) noHint "Insert type of which identifier?"+ return (const $ return ()) (ghciInferTypeOf . R.fromText)++ghciInferTypeOf :: R.YiString -> YiM ()+ghciInferTypeOf nm = do+ buf <- ghciGet+ result <- Interactive.queryReply buf (":t " <> R.toString nm)+ let successful = (not . R.null) nm && nm == result+ when successful . withCurrentBuffer $+ moveToSol *> insertB '\n' *> leftB+ *> insertN result *> rightB++ghciSetProcessName :: YiM ()+ghciSetProcessName = do+ g <- getEditorDyn+ let nm = g ^. GHCi.ghciProcessName+ prompt = T.concat [ "Command to call for GHCi, currently ‘"+ , T.pack nm, "’: " ]+ withMinibufferFree prompt $ \s ->+ putEditorDyn $ g & GHCi.ghciProcessName .~ T.unpack s++ghciSetProcessArgs :: YiM ()+ghciSetProcessArgs = do+ g <- getEditorDyn+ let nm = g ^. GHCi.ghciProcessName+ args = g ^. GHCi.ghciProcessArgs+ prompt = T.unwords [ "List of args to call "+ , T.pack nm+ , "with, currently"+ , T.pack $ show args+ , ":"+ ]+ withMinibufferFree prompt $ \arg ->+ case readMaybe $ T.unpack arg of+ Nothing -> printMsg "Could not parse as [String], keep old args."+ Just arg' -> putEditorDyn $ g & GHCi.ghciProcessArgs .~ arg'
+ src/Yi/Mode/Haskell/Dollarify.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Mode.Haskell.Dollarify+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Mode.Haskell.Dollarify where++import Control.Monad (unless)+import Data.Function (on)+import Data.List (sortBy)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Text ()+import Yi.Buffer hiding (Block)+import Yi.Debug (trace)+import Yi.Lexer.Alex (Tok (..), posnOfs)+import Yi.Lexer.Haskell (TT, Token (..), isComment)+import qualified Yi.Rope as R (YiString, null)+import Yi.String (showT)+import qualified Yi.Syntax.Haskell as H (Exp (..), Tree)+import Yi.Syntax.Paren (Expr, Tree (..))+import Yi.Syntax.Tree (getAllSubTrees, getFirstOffset, getLastOffset, getLastPath)++dollarify :: Tree TT -> BufferM ()+dollarify t = maybe (return ()) dollarifyWithin . selectedTree [t] =<< getSelectRegionB++dollarifyWithin :: Tree TT -> BufferM ()+dollarifyWithin = trace . ("dollarifyWithin: " <>) . showT <*> runQ . (dollarifyTop =<<) . getAllSubTrees++data QueuedUpdate = QueuedUpdate { qUpdatePoint :: Point+ , qInsert :: R.YiString+ , qDelete :: Int+ } deriving (Eq, Ord, Show)++runQ :: [QueuedUpdate] -> BufferM ()+runQ = trace . ("runQ: " <>) . showT <*> mapM_ run1Q . sortBy (flip compare)+ where+ run1Q :: QueuedUpdate -> BufferM ()+ run1Q (QueuedUpdate { qUpdatePoint = p, qInsert = i, qDelete = d })+ = do deleteNAt Forward d p+ unless (R.null i) $ insertNAt i p++openParen, closeParen :: Token+openParen = Special '('+closeParen = Special ')'++isNormalParen :: Tree TT -> Bool+isNormalParen (Paren t1 xs t2) =+ tokT t1 == openParen && tokT t2 == closeParen && not (any isTuple xs)+isNormalParen _ = False++isTuple ::Tree TT -> Bool+isTuple (Atom t) = tokT t == Special ','+isTuple _ = False++-- Assumes length of token is one character+queueDelete :: TT -> QueuedUpdate+queueDelete = queueReplaceWith ""++-- Assumes length of token is one character+queueReplaceWith :: R.YiString -> TT -> QueuedUpdate+queueReplaceWith s t = QueuedUpdate { qUpdatePoint = posnOfs $ tokPosn t+ , qInsert = s+ , qDelete = 1+ }++-- Only strips comments from the top level+stripComments :: Expr TT -> Expr TT+stripComments = filter $ \t -> case t of { (Atom x) -> not (isComment $ tokT x); _ -> True }++dollarifyTop :: Tree TT -> [QueuedUpdate]+dollarifyTop p@(Paren t1 e t2)+ | isNormalParen p = case stripComments e of+ [Paren{}] -> [queueDelete t2, queueDelete t1]+ e' -> dollarifyExpr e'+dollarifyTop (Block blk) = dollarifyExpr . stripComments =<< [x | Expr x <- blk]+dollarifyTop _ = []++-- Expression must not contain comments+dollarifyExpr :: Expr TT -> [QueuedUpdate]+dollarifyExpr e@(_:_)+ | p@(Paren t e2 t2) <- last e+ , isNormalParen p+ , all isSimple e+ = let dollarifyLoop :: Expr TT -> [QueuedUpdate]+ dollarifyLoop [] = []+ dollarifyLoop e3@[Paren{}] = dollarifyExpr e3+ dollarifyLoop e3 = if isCollapsible e3 then [queueDelete t2, queueReplaceWith "$ " t] else []+ in dollarifyLoop $ stripComments e2+dollarifyExpr _ = []++isSimple :: Tree TT -> Bool+isSimple (Paren{}) = True+isSimple (Block{}) = False+isSimple (Atom t) = tokT t `elem` [Number, CharTok, StringTok, VarIdent, ConsIdent]+isSimple _ = False++-- Expression must not contain comments+isCollapsible :: Expr TT -> Bool+isCollapsible = ((&&) `on` isSimple) . head <*> last++selectedTree :: Expr TT -> Region -> Maybe (Tree TT)+selectedTree e r = findLargestWithin r <$> getLastPath e (regionLast r)++-- List must be non-empty+findLargestWithin :: Region -> [Tree TT] -> Tree TT+findLargestWithin r = fromMaybe . head <*> safeLast . takeWhile (within r)++within :: Region -> Tree TT -> Bool+within r t = includedRegion ((mkRegion . getFirstOffset <*> getLastOffset) t) r++safeLast :: [a] -> Maybe a+safeLast [] = Nothing+safeLast s = return $ last s++-- Here follows code for the precise haskell mode++dollarifyP :: H.Tree TT -> BufferM ()+dollarifyP e = maybe (return ()) dollarifyWithinP . selectedTreeP [e] =<< getSelectRegionB++dollarifyWithinP :: H.Exp TT -> BufferM ()+dollarifyWithinP = trace . ("dollarifyWithin: " <>) . showT <*> runQ . (dollarifyTopP =<<) . getAllSubTrees++isNormalParenP :: H.Exp TT -> Bool+isNormalParenP (H.Paren (H.PAtom r _) xs (H.PAtom r' _)) =+ tokT r == openParen && tokT r' == closeParen && not (any isTupleP xs)+isNormalParenP _ = False++isTupleP :: H.Exp TT -> Bool+isTupleP (H.PAtom t _) = tokT t == Special ','+isTupleP _ = False++-- Only strips comments from the top level+stripCommentsP :: [H.Exp TT] -> [H.Exp TT]+stripCommentsP = filter $ \t -> case t of { (H.PAtom x _) -> not (isComment $ tokT x); _ -> True }++dollarifyTopP :: H.Exp TT -> [QueuedUpdate]+dollarifyTopP p@(H.Paren (H.PAtom t1 _) e (H.PAtom t2 _))+ | isNormalParenP p = case stripCommentsP e of+ [H.Paren{}] -> [queueDelete t2, queueDelete t1]+ e' -> dollarifyExprP e'+dollarifyTopP (H.Block bList) = dollarifyExprP . stripCommentsP $ bList+dollarifyTopP _ = []++-- Expression must not contain comments+dollarifyExprP :: [H.Exp TT] -> [QueuedUpdate]+dollarifyExprP e@(_:_)+ | p@(H.Paren (H.PAtom t _) e2 (H.PAtom t2 _)) <- last e+ , isNormalParenP p+ , all isSimpleP e+ = let dollarifyLoop :: [H.Exp TT] -> [QueuedUpdate]+ dollarifyLoop [] = []+ dollarifyLoop e3@[H.Paren{}] = dollarifyExprP e3+ dollarifyLoop e3 = if isCollapsibleP e3 then [queueDelete t2, queueReplaceWith "$ " t] else []+ in dollarifyLoop $ stripCommentsP e2+dollarifyExprP _ = []++isSimpleP :: H.Exp TT -> Bool+isSimpleP (H.Paren{}) = True+isSimpleP (H.Block{}) = False+isSimpleP (H.PAtom t _) = tokT t `elem` [Number, CharTok, StringTok, VarIdent, ConsIdent]+isSimpleP _ = False++-- Expression must not contain comments+isCollapsibleP :: [H.Exp TT] -> Bool+isCollapsibleP = ((&&) `on` isSimpleP) . head <*> last++selectedTreeP :: [H.Exp TT] -> Region -> Maybe (H.Exp TT)+selectedTreeP e r = findLargestWithinP r <$> getLastPath e (regionLast r)++-- List must be non-empty+findLargestWithinP :: Region -> [H.Exp TT] -> H.Exp TT+findLargestWithinP r = fromMaybe . head <*> safeLast . takeWhile (withinP r)++withinP :: Region -> H.Exp TT -> Bool+withinP r t = includedRegion ((mkRegion . getFirstOffset <*> getLastOffset) t) r++safeLastP :: [a] -> Maybe a+safeLastP [] = Nothing+safeLastP s = return $ last s
+ src/Yi/Syntax/Haskell.hs view
@@ -0,0 +1,745 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++-- we have lots of parsers which don't want signatures; and we have+-- uniplate patterns+{-# OPTIONS_GHC -fno-warn-missing-signatures+ -fno-warn-incomplete-patterns+ -fno-warn-name-shadowing #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Syntax.Haskell+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- NOTES:+-- Note if the layout of the first line (not comments)+-- is wrong the parser will only parse what is in the blocks given by Layout.hs++module Yi.Syntax.Haskell ( PModule+ , PModuleDecl+ , PImport+ , Exp (..)+ , Tree+ , parse+ , indentScanner+ ) where++import Control.Applicative (Alternative ((<|>), empty, many, some), optional)+import Control.Arrow ((&&&))+import Data.List ((\\))+import Data.Maybe (fromJust, isNothing)+import Yi.IncrementalParse+import Yi.Lexer.Alex (Posn (Posn, posnOfs), Tok (Tok, tokT),+ startPosn, tokBegin)+import Yi.Lexer.Haskell+import Yi.Syntax (Scanner)+import Yi.Syntax.Layout (State, layoutHandler)+import Yi.Syntax.Tree (IsTree (emptyNode, uniplate), sepBy1)++indentScanner :: Scanner (AlexState lexState) TT+ -> Scanner (Yi.Syntax.Layout.State Token lexState) TT+indentScanner = layoutHandler startsLayout [(Special '(', Special ')'),+ (Reserved Let, Reserved In),+ (Special '[', Special ']'),+ (Special '{', Special '}')]+ ignoredToken+ (Special '<', Special '>', Special '.')+ isBrace++-- HACK: We insert the Special '<', '>', '.', which do not occur in+-- normal haskell parsing.++-- | Check if a token is a brace, this function is used to+-- fix the layout so that do { works correctly+isBrace :: TT -> Bool+isBrace (Tok br _ _) = Special '{' == br++-- | Theese are the tokens ignored by the layout handler.+ignoredToken :: TT -> Bool+ignoredToken (Tok t _ (Posn{})) = isComment t || t == CppDirective++type Tree = PModule+type PAtom = Exp+type Block = Exp+type PGuard = Exp+type PModule = Exp+type PModuleDecl = Exp+type PImport = Exp+++-- | Exp can be expression or declaration+data Exp t+ = PModule { comments :: [t]+ , progMod :: Maybe (PModule t)+ }+ | ProgMod { modDecl :: PModuleDecl t+ , body :: PModule t -- ^ The module declaration part+ }+ | Body { imports :: Exp t -- [PImport t]+ , content :: Block t+ , extraContent :: Block t -- ^ The body of the module+ }+ | PModuleDecl { moduleKeyword :: PAtom t+ , name :: PAtom t+ , exports :: Exp t+ , whereKeyword :: Exp t+ }+ | PImport { importKeyword :: PAtom t+ , qual :: Exp t+ , name' :: PAtom t+ , as :: Exp t+ , specification :: Exp t+ }++ | TS t [Exp t] -- ^ Type signature+ | PType { typeKeyword :: PAtom t+ , typeCons :: Exp t+ , equal :: PAtom t+ , btype :: Exp t+ } -- ^ Type declaration+ | PData { dataKeyword :: PAtom t+ , dtypeCons :: Exp t+ , dEqual :: Exp t+ , dataRhs :: Exp t+ } -- ^ Data declaration+ | PData' { dEqual :: PAtom t+ , dataCons :: Exp t -- ^ Data declaration RHS+ }+ | PClass { cKeyword :: PAtom t -- Can be class or instance+ , cHead :: Exp t+ , cwhere :: Exp t -- ^ Class declaration+ }+ -- declaration+ -- declarations and parts of them follow+ | Paren (PAtom t) [Exp t] (PAtom t) -- ^ A parenthesized, bracked or braced+ | Block [Exp t] -- ^ A block of things separated by layout+ | PAtom t [t] -- ^ An atom is a token followed by many comments+ | Expr [Exp t] -- ^+ | PWhere (PAtom t) (Exp t) (Exp t) -- ^ Where clause+ | Bin (Exp t) (Exp t)+ -- an error with comments following so we never color comments in wrong+ -- color. The error has an extra token, the Special '!' token to+ -- indicate that it contains an error+ | PError { errorTok :: t+ , marker :: t+ , commentList :: [t] -- ^ An wrapper for errors+ }+ -- rhs that begins with Equal+ | RHS (PAtom t) (Exp t) -- ^ Righthandside of functions with =+ | Opt (Maybe (Exp t)) -- ^ An optional+ | Modid t [t] -- ^ Module identifier+ | Context (Exp t) (Exp t) (PAtom t) -- ^+ | PGuard [PGuard t] -- ^ Righthandside of functions with |+ -- the PAtom in PGuard' does not contain any comments+ | PGuard' (PAtom t) (Exp t) (PAtom t)+ -- type constructor is just a wrapper to indicate which highlightning to+ -- use.+ | TC (Exp t) -- ^ Type constructor+ -- data constructor same as with the TC constructor+ | DC (Exp t) -- ^ Data constructor+ | PLet (PAtom t) (Exp t) (Exp t) -- ^ let expression+ | PIn t [Exp t]+ deriving (Show, Foldable)++instance IsTree Exp where+ emptyNode = Expr []+ uniplate tree = case tree of+ (ProgMod a b) -> ([a,b], \[a,b] -> ProgMod a b)+ (Body x exp exp') -> ([x, exp, exp'], \[x, exp, exp'] -> Body x exp exp')+ (PModule x (Just e)) -> ([e],\[e] -> PModule x (Just e))+ (Paren l g r) -> -- TODO: improve+ (l:g ++ [r], \(l:gr) -> Paren l (init gr) (last gr))+ (RHS l g) -> ([l,g],\[l,g] -> (RHS l g))+ (Block s) -> (s,Block)+ (PLet l s i) -> ([l,s,i],\[l,s,i] -> PLet l s i)+ (PIn x ts) -> (ts,PIn x)+ (Expr a) -> (a,Expr)+ (PClass a b c) -> ([a,b,c],\[a,b,c] -> PClass a b c)+ (PWhere a b c) -> ([a,b,c],\[a,b,c] -> PWhere a b c)+ (Opt (Just x)) -> ([x],\[x] -> (Opt (Just x)))+ (Bin a b) -> ([a,b],\[a,b] -> (Bin a b))+ (PType a b c d) -> ([a,b,c,d],\[a,b,c,d] -> PType a b c d)+ (PData a b c d) -> ([a,b,c,d],\[a,b,c,d] -> PData a b c d)+ (PData' a b) -> ([a,b] ,\[a,b] -> PData' a b)+ (Context a b c) -> ([a,b,c],\[a,b,c] -> Context a b c)+ (PGuard xs) -> (xs,PGuard)+ (PGuard' a b c) -> ([a,b,c],\[a,b,c] -> PGuard' a b c)+ (TC e) -> ([e],\[e] -> TC e)+ (DC e) -> ([e],\[e] -> DC e)+ PModuleDecl a b c d -> ([a,b,c,d],\[a,b,c,d] -> PModuleDecl a b c d)+ PImport a b c d e -> ([a,b,c,d,e],\[a,b,c,d,e] -> PImport a b c d e)+ t -> ([],const t)++-- | The parser+parse :: P TT (Tree TT)+parse = pModule <* eof++-- | @pModule@ parse a module+pModule :: Parser TT (PModule TT)+pModule = PModule <$> pComments <*> optional+ (pBlockOf' (ProgMod <$> pModuleDecl+ <*> pModBody <|> pBody))++-- | Parse a body that follows a module+pModBody :: Parser TT (PModule TT)+pModBody = (exact [startBlock] *>+ (Body <$> pImports+ <*> ((pTestTok elems *> pBod)+ <|> pEmptyBL) <* exact [endBlock]+ <*> pBod+ <|> Body <$> noImports+ <*> ((pBod <|> pEmptyBL) <* exact [endBlock])+ <*> pBod))+ <|> (exact [nextLine] *> pBody)+ <|> Body <$> pure emptyNode <*> pEmptyBL <*> pEmptyBL+ where pBod = Block <$> pBlocks pTopDecl+ elems = [Special ';', nextLine, startBlock]++-- | @pEmptyBL@ A parser returning an empty block+pEmptyBL :: Parser TT (Exp TT)+pEmptyBL = Block <$> pEmpty++-- | Parse a body of a program+pBody :: Parser TT (PModule TT)+pBody = Body <$> noImports <*> (Block <$> pBlocks pTopDecl) <*> pEmptyBL+ <|> Body <$> pImports <*> ((pTestTok elems *> (Block <$> pBlocks pTopDecl))+ <|> pEmptyBL) <*> pEmptyBL+ where elems = [nextLine, startBlock]++noImports :: Parser TT (Exp TT)+noImports = notNext [Reserved Import] *> pure emptyNode+ where notNext f = testNext $ uncurry (||) . (&&&) isNothing+ (flip notElem f . tokT . fromJust)++-- Helper functions for parsing follows+-- | Parse Variables+pVarId :: Parser TT (Exp TT)+pVarId = pAtom [VarIdent, Reserved Other, Reserved As]++-- | Parse VarIdent and ConsIdent+pQvarid :: Parser TT (Exp TT)+pQvarid = pAtom [VarIdent, ConsIdent, Reserved Other, Reserved As]++-- | Parse an operator using please+pQvarsym :: Parser TT (Exp TT)+pQvarsym = pParen ((:) <$> please (PAtom <$> sym isOperator <*> pComments)+ <*> pEmpty)++-- | Parse any operator+isOperator :: Token -> Bool+isOperator (Operator _) = True+isOperator (ReservedOp _) = True+isOperator (ConsOperator _) = True+isOperator _ = False++-- | Parse a consident+pQtycon :: Parser TT (Exp TT)+pQtycon = pAtom [ConsIdent]++-- | Parse many variables+pVars :: Parser TT (Exp TT)+pVars = pMany pVarId++-- | Parse a nextline token (the nexLine token is inserted by Layout.hs)+nextLine :: Token+nextLine = Special '.'++-- | Parse a startBlock token+startBlock :: Token+startBlock = Special '<'++-- | Parse a endBlock token+endBlock :: Token+endBlock = Special '>'++pEmpty :: Applicative f => f [a]+pEmpty = pure []++pToList :: Applicative f => f a -> f [a]+pToList = (box <$>)+ where box x = [x]++-- | @sym f@ returns a parser parsing @f@ as a special symbol+sym :: (Token -> Bool) -> Parser TT TT+sym f = symbol (f . tokT)++-- | @exact tokList@ parse anything that is in @tokList@+exact :: [Token] -> Parser TT TT+exact = sym . flip elem+++-- | @please p@ returns a parser parsing either @p@ or recovers with the+-- (Special '!') token.+please :: Parser TT (Exp TT) -> Parser TT (Exp TT)+please = (<|>) (PError <$> recoverWith errTok+ <*> errTok+ <*> pEmpty)++-- | Parse anything, as errors+pErr :: Parser TT (Exp TT)+pErr = PError <$> recoverWith (sym $ not . uncurry (||) . (&&&) isComment+ (== CppDirective))+ <*> errTok+ <*> pComments++-- | Parse an ConsIdent+ppCons :: Parser TT (Exp TT)+ppCons = ppAtom [ConsIdent]++-- | Parse a keyword+pKW :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT)+pKW k r = Bin <$> pAtom k <*> r++-- | Parse an unary operator with and without using please+pOP :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT)+pOP op r = Bin <$> pAtom op <*> r++--ppOP op r = Bin <$> ppAtom op <*> r++-- | Parse comments+pComments :: Parser TT [TT]+pComments = many $ sym $ uncurry (||) . (&&&) isComment (== CppDirective)++-- | Parse something thats optional+pOpt :: Parser TT (Exp TT) -> Parser TT (Exp TT)+pOpt x = Opt <$> optional x++-- | Parse an atom with, and without using please+pAtom, ppAtom :: [Token] -> Parser TT (Exp TT)+pAtom = flip pCAtom pComments++ppAtom at = pAtom at <|> recoverAtom++recoverAtom :: Parser TT (Exp TT)+recoverAtom = PAtom <$> recoverWith errTok <*> pEmpty++-- | Parse an atom with optional comments+pCAtom :: [Token] -> Parser TT [TT] -> Parser TT (Exp TT)+pCAtom r c = PAtom <$> exact r <*> c++pBareAtom a = pCAtom a pEmpty++-- | @pSepBy p sep@ parse /zero/ or more occurences of @p@, separated+-- by @sep@, with optional ending @sep@,+-- this is quite similar to the sepBy function provided in+-- Parsec, but this one allows an optional extra separator at the end.+--+-- > commaSep p = p `pSepBy` (symbol (==(Special ',')))++pSepBy :: Parser TT (Exp TT) -> Parser TT (Exp TT) -> Parser TT [Exp TT]+pSepBy p sep = pEmpty+ <|> (:) <$> p <*> (pSepBy1 p sep <|> pEmpty)+ <|> pToList sep -- optional ending separator+ where pSepBy1 r p' = (:) <$> p' <*> (pEmpty <|> pSepBy1 p' r)++-- | Separate a list of things separated with comma inside of parenthesis+pParenSep :: Parser TT (Exp TT) -> Parser TT (Exp TT)+pParenSep = pParen . flip pSepBy pComma++-- | Parse a comma separator+pComma :: Parser TT (Exp TT)+pComma = pAtom [Special ',']++-- End of helper functions Parsing different parts follows++-- | Parse a Module declaration+pModuleDecl :: Parser TT (PModuleDecl TT)+pModuleDecl = PModuleDecl <$> pAtom [Reserved Module]+ <*> ppAtom [ConsIdent]+ <*> pOpt (pParenSep pExport)+ <*> (optional (exact [nextLine]) *>+ (Bin <$> ppAtom [Reserved Where])+ <*> pMany pErr) <* pTestTok elems+ where elems = [nextLine, startBlock, endBlock]++pExport :: Parser TT (Exp TT)+pExport = optional (exact [nextLine]) *> please+ ( pVarId+ <|> pEModule+ <|> Bin <$> pQvarsym <*> (DC <$> pOpt expSpec) -- typeOperator+ <|> Bin <$> (TC <$> pQtycon) <*> (DC <$> pOpt expSpec)+ )+ where expSpec = pParen (pToList (please (pAtom [ReservedOp DoubleDot]))+ <|> pSepBy pQvarid pComma)++-- | Check if next token is in given list+pTestTok :: [Token] -> Parser TT ()+pTestTok f = testNext (uncurry (||) . (&&&) isNothing+ (flip elem f . tokT . fromJust))++-- | Parse several imports+pImports :: Parser TT (Exp TT) -- [PImport TT]+pImports = Expr <$> many (pImport+ <* pTestTok pEol+ <* optional (some $ exact [nextLine, Special ';']))+ where pEol = [Special ';', nextLine, endBlock]++-- | Parse one import+pImport :: Parser TT (PImport TT)+pImport = PImport <$> pAtom [Reserved Import]+ <*> pOpt (pAtom [Reserved Qualified])+ <*> ppAtom [ConsIdent]+ <*> pOpt (pKW [Reserved As] ppCons)+ <*> (TC <$> pImpSpec)+ where pImpSpec = Bin <$> pKW [Reserved Hiding]+ (please pImpS) <*> pMany pErr+ <|> Bin <$> pImpS <*> pMany pErr+ <|> pMany pErr+ pImpS = DC <$> pParenSep pExp'+ pExp' = Bin+ <$> (PAtom <$> sym+ (uncurry (||) . (&&&)+ (`elem` [VarIdent, ConsIdent])+ isOperator) <*> pComments+ <|> pQvarsym)+ <*> pOpt pImpS++-- | Parse simple type synonyms+pType :: Parser TT (Exp TT)+pType = PType <$> (Bin <$> pAtom [Reserved Type]+ <*> pOpt (pAtom [Reserved Instance]))+ <*> (TC . Expr <$> pTypeExpr')+ <*> ppAtom [ReservedOp Equal]+ <*> (TC . Expr <$> pTypeExpr')++-- | Parse data declarations+pData :: Parser TT (Exp TT)+pData = PData <$> pAtom [Reserved Data, Reserved NewType]+ <*> (TC . Expr <$> pTypeExpr')+ <*> pOpt (pDataRHS <|> pGadt)+ <*> pOpt pDeriving+++pGadt :: Parser TT (Exp TT)+pGadt = pWhere pTypeDecl++-- | Parse second half of the data declaration, if there is one+pDataRHS :: Parser TT (Exp TT)+pDataRHS = PData' <$> pAtom [ReservedOp Equal] <*> pConstrs+++-- | Parse a deriving+pDeriving :: Parser TT (Exp TT)+pDeriving = pKW [Reserved Deriving] (TC . Expr <$> pTypeExpr')++pAtype :: Parser TT (Exp TT)+pAtype = pAtype'+ <|> pErr++pAtype' :: Parser TT (Exp TT)+pAtype' = pTypeCons+ <|> pParen (many $ pExprElem [])+ <|> pBrack (many $ pExprElem [])++pTypeCons :: Parser TT (Exp TT)+pTypeCons = Bin <$> pAtom [ConsIdent]+ <*> please (pMany $ pAtom [VarIdent, ConsIdent])++pContext :: Parser TT (Exp TT)+pContext = Context <$> pOpt pForAll+ <*> (TC <$> (pClass' <|> pParenSep pClass'))+ <*> ppAtom [ReservedOp DoubleRightArrow]+ where pClass' :: Parser TT (Exp TT)+ pClass' = Bin <$> pQtycon+ <*> (please pVarId+ <|> pParen ((:) <$> please pVarId+ <*> many pAtype'))++-- | Parse for all+pForAll :: Parser TT (Exp TT)+pForAll = pKW [Reserved Forall]+ (Bin <$> pVars <*> ppAtom [Operator "."])++pConstrs :: Parser TT (Exp TT)+pConstrs = Bin <$> (Bin <$> pOpt pContext <*> pConstr)+ <*> pMany (pOP [ReservedOp Pipe]+ (Bin <$> pOpt pContext <*> please pConstr))++pConstr :: Parser TT (Exp TT)+pConstr = Bin <$> pOpt pForAll+ <*> (Bin <$>+ (Bin <$> (DC <$> pAtype) <*>+ (TC <$> pMany (strictF pAtype))) <*> pOpt st)+ <|> Bin <$> lrHs <*> pMany (strictF pAtype)+ <|> pErr+ where lrHs = pOP [Operator "!"] pAtype+ st = pEBrace (pTypeDecl `sepBy1` pBareAtom [Special ','])+ -- named fields declarations++-- | Parse optional strict variables+strictF :: Parser TT (Exp TT) -> Parser TT (Exp TT)+strictF a = Bin <$> pOpt (pAtom [Operator "!"]) <*> a+++-- | Exporting module+pEModule ::Parser TT (Exp TT)+pEModule = pKW [Reserved Module]+ $ please (Modid <$> exact [ConsIdent] <*> pComments)++-- | Parse a Let expression+pLet :: Parser TT (Exp TT)+pLet = PLet <$> pAtom [Reserved Let]+ <*> pBlock pFunDecl+ <*> pOpt (pBareAtom [Reserved In])++-- | Parse a Do block+pDo :: Parser TT (Exp TT)+pDo = Bin <$> pAtom [Reserved Do]+ <*> pBlock (pExpr ((Special ';' : recognizedSometimes)+ \\ [ReservedOp LeftArrow]))++-- | Parse part of a lambda binding.+pLambda :: Parser TT (Exp TT)+pLambda = Bin <$> pAtom [ReservedOp BackSlash]+ <*> (Bin <$> (Expr <$> pPattern)+ <*> please (pBareAtom [ReservedOp RightArrow]))++-- | Parse an Of block+pOf :: Parser TT (Exp TT)+pOf = Bin <$> pAtom [Reserved Of]+ <*> pBlock pAlternative++pAlternative = Bin <$> (Expr <$> pPattern)+ <*> please (pFunRHS (ReservedOp RightArrow))++-- | Parse classes and instances+-- This is very imprecise, but shall suffice for now.+-- At least is does not complain too often.+pClass :: Parser TT (Exp TT)+pClass = PClass <$> pAtom [Reserved Class, Reserved Instance]+ <*> (TC . Expr <$> pTypeExpr')+ <*> pOpt (please (pWhere pTopDecl))+ -- use topDecl since we have associated types and such.+++-- | Parse some guards and a where clause+pGuard :: Token -> Parser TT (Exp TT)+pGuard equalSign = PGuard+ <$> some (PGuard' <$> pCAtom [ReservedOp Pipe] pEmpty <*>+ -- comments are by default parsed after this+ pExpr (recognizedSometimes+ -- these two symbols can appear in guards.+ \\ [ReservedOp LeftArrow, Special ','])+ <*> please (pEq equalSign))+ -- this must be -> if used in case++-- | Right-hand-side of a function or case equation (after the pattern)+pFunRHS :: Token -> Parser TT (Exp TT)+pFunRHS equalSign =+ Bin <$> (pGuard equalSign <|> pEq equalSign) <*> pOpt (pWhere pFunDecl)++pWhere :: Parser TT (Exp TT) -> Parser TT (Exp TT)+pWhere p =+ PWhere <$> pAtom [Reserved Where] <*> please (pBlock p) <*> pMany pErr+-- After a where there might "misaligned" code that do not "belong" to anything.+-- Here we swallow it as errors.++-- Note that this can both parse an equation and a type declaration.+-- Since they can start with the same token, the left part is factored here.+pDecl :: Bool -> Bool -> Parser TT (Exp TT)+pDecl acceptType acceptEqu =+ Expr <$> ((Yuck $+ Enter "missing end of type or equation declaration" $ pure [])+ <|> ((:) <$> pElem False recognizedSometimes+ <*> pToList (pDecl acceptType acceptEqu))+ <|> ((:) <$> pBareAtom [Special ',']+ <*> pToList (pDecl acceptType False))+ -- if a comma is found, then the rest must be a type+ -- declaration.+ <|> (if acceptType then pTypeEnding else empty)+ <|> (if acceptEqu then pEquEnding else empty))+ where pTypeEnding = (:) <$> (TS <$> exact [ReservedOp DoubleColon]+ <*> pTypeExpr') <*> pure []+ pEquEnding = (:) <$> pFunRHS (ReservedOp Equal) <*> pure []++pFunDecl = pDecl True True+pTypeDecl = pDecl True False+--pEquation = pDecl False True+++-- | The RHS of an equation.+pEq :: Token -> Parser TT (Exp TT)+pEq equalSign = RHS <$> pBareAtom [equalSign] <*> pExpr'++-- | Parse many of something+pMany :: Parser TT (Exp TT) -> Parser TT (Exp TT)+pMany p = Expr <$> many p++-- | Parse a some of something separated by the token (Special '.')+pBlocks :: Parser TT r -> Parser TT [r]+pBlocks p = p `sepBy1` exact [nextLine]++-- | Parse a some of something separated by the token (Special '.'), or nothing+--pBlocks' :: Parser TT r -> Parser TT (BL.BList r)+pBlocks' p = pBlocks p <|> pure []++-- | Parse a block of some something separated by the tok (Special '.')+pBlockOf :: Parser TT (Exp TT) -> Parser TT (Exp TT)+pBlockOf p = Block <$> pBlockOf' (pBlocks p) -- see HACK above+++pBlock :: Parser TT (Exp TT) -> Parser TT (Exp TT)+pBlock p = pBlockOf' (Block <$> pBlocks' p)+ <|> pEBrace (p `sepBy1` exact [Special ';'] <|> pure [])+ <|> (Yuck $ Enter "block expected" pEmptyBL)++-- | Parse something surrounded by (Special '<') and (Special '>')+pBlockOf' :: Parser TT a -> Parser TT a+pBlockOf' p = exact [startBlock] *> p <* exact [endBlock] -- see HACK above+-- note that, by construction, '<' and '>' will always be matched, so+-- we don't try to recover errors with them.++-- | Parse something that can contain a data, type declaration or a class+pTopDecl :: Parser TT (Exp TT)+pTopDecl = pFunDecl+ <|> pType+ <|> pData+ <|> pClass+ <|> pure emptyNode+++-- | A "normal" expression, where none of the following symbols are acceptable.+pExpr' = pExpr recognizedSometimes++recognizedSometimes = [ReservedOp DoubleDot,+ Special ',',+ ReservedOp Pipe,+ ReservedOp Equal,+ ReservedOp LeftArrow,+ ReservedOp RightArrow,+ ReservedOp DoubleRightArrow,+ ReservedOp BackSlash,+ ReservedOp DoubleColon+ ]++-- | Parse an expression, as a concatenation of elements.+pExpr :: [Token] -> Parser TT (Exp TT)+pExpr at = Expr <$> pExprOrPattern True at++-- | Parse an expression, as a concatenation of elements.+pExprOrPattern :: Bool -> [Token] -> Parser TT [Exp TT]+pExprOrPattern isExpresssion at =+ pure []+ <|> ((:) <$> pElem isExpresssion at <*> pExprOrPattern True at)+ <|> ((:) <$> (TS <$> exact [ReservedOp DoubleColon] <*> pTypeExpr')+ <*> pure [])+ -- TODO: not really correct: in (x :: X , y :: Z), all after the+ -- first :: will be a "type".++pPattern = pExprOrPattern False recognizedSometimes++pExprElem = pElem True++-- | Parse an "element" of an expression or a pattern.+-- "at" is a list of symbols that, if found, should be considered errors.+pElem :: Bool -> [Token] -> Parser TT (Exp TT)+pElem isExpresssion at =+ pCParen (pExprOrPattern isExpresssion+ -- might be a tuple, so accept commas as noise+ (recognizedSometimes \\ [Special ','])) pEmpty+ <|> pCBrack (pExprOrPattern isExpresssion+ (recognizedSometimes \\ [ ReservedOp DoubleDot, ReservedOp Pipe+ , ReservedOp LeftArrow+ , Special ','])) pEmpty -- list thing+ <|> pCBrace (many $ pElem isExpresssion+ -- record: TODO: improve+ (recognizedSometimes \\ [ ReservedOp Equal, Special ','+ , ReservedOp Pipe])) pEmpty+ <|> (Yuck $ Enter "incorrectly placed block" $+ -- no error token, but the previous keyword will be one. (of, where, ...)+ pBlockOf (pExpr recognizedSometimes))+ <|> (PError <$> recoverWith+ (sym $ flip elem $ isNoiseErr at) <*> errTok <*> pEmpty)+ <|> (PAtom <$> sym (`notElem` isNotNoise at) <*> pEmpty)+ <|> if isExpresssion then pLet <|> pDo <|> pOf <|> pLambda else empty+ -- TODO: support type expressions++pTypeExpr at = many (pTypeElem at)+pTypeExpr' = pTypeExpr (recognizedSometimes \\ [ReservedOp RightArrow,+ ReservedOp DoubleRightArrow])++pTypeElem :: [Token] -> Parser TT (Exp TT)+pTypeElem at+ = pCParen (pTypeExpr (recognizedSometimes+ \\ [ ReservedOp RightArrow,+ ReservedOp DoubleRightArrow,+ -- might be a tuple, so accept commas as noise+ Special ','])) pEmpty+ <|> pCBrack pTypeExpr' pEmpty+ <|> pCBrace pTypeExpr' pEmpty -- TODO: this is an error: mark as such.+ <|> (Yuck $ Enter "incorrectly placed block" $+ pBlockOf (pExpr recognizedSometimes))+ <|> (PError <$> recoverWith+ (sym $ flip elem $ isNoiseErr at) <*> errTok <*> pEmpty)+ <|> (PAtom <$> sym (`notElem` isNotNoise at) <*> pEmpty)++-- | List of things that always should be parsed as errors+isNoiseErr :: [Token] -> [Token]+isNoiseErr r = recoverableSymbols ++ r++recoverableSymbols = recognizedSymbols \\ fmap Special "([{<>."+-- We just don't recover opening symbols (only closing are "fixed").+-- Layout symbols "<>." are never recovered, because layout is+-- constructed correctly.++-- | List of things that should not be parsed as noise+isNotNoise :: [Token] -> [Token]+isNotNoise r = recognizedSymbols ++ r++-- | These symbols are always properly recognized, and therefore they+-- should never be accepted as "noise" inside expressions.+recognizedSymbols =+ [ Reserved Let+ , Reserved In+ , Reserved Do+ , Reserved Of+ , Reserved Class+ , Reserved Instance+ , Reserved Deriving+ , Reserved Module+ , Reserved Import+ , Reserved Type+ , Reserved Data+ , Reserved NewType+ , Reserved Where] ++ fmap Special "()[]{}<>."++-- | Parse parenthesis, brackets and braces containing+-- an expression followed by possible comments+pCParen, pCBrace, pCBrack+ :: Parser TT [Exp TT] -> Parser TT [TT] -> Parser TT (Exp TT)++pCParen p c = Paren <$> pCAtom [Special '('] c+ <*> p <*> (recoverAtom <|> pCAtom [Special ')'] c)++pCBrace p c = Paren <$> pCAtom [Special '{'] c+ <*> p <*> (recoverAtom <|> pCAtom [Special '}'] c)++pCBrack p c = Paren <$> pCAtom [Special '['] c+ <*> p <*> (recoverAtom <|> pCAtom [Special ']'] c)++pParen, pBrack :: Parser TT [Exp TT] -> Parser TT (Exp TT)++pParen = flip pCParen pComments++--pBrace = flip pCBrace pComments++pBrack = flip pCBrack pComments++-- pEBrace parse an opening brace, followed by zero comments+-- then followed by an closing brace and some comments+pEBrace p = Paren <$> pCAtom [Special '{'] pEmpty+ <*> p <*> (recoverAtom <|> pCAtom [Special '}'] pComments)++-- | Create a special error token. (e.g. fill in where there is no+-- correct token to parse) Note that the position of the token has to+-- be correct for correct computation of node spans.+errTok = mkTok <$> curPos+ where curPos = tB <$> lookNext+ tB Nothing = maxBound+ tB (Just x) = tokBegin x+ mkTok p = Tok (Special '!') 0 (startPosn {posnOfs = p})
+ src/Yi/Syntax/Paren.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Syntax.Paren+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Parser for Haskell that only cares about parenthesis and layout.++module Yi.Syntax.Paren where++import Prelude hiding (elem)++import Control.Applicative (Alternative ((<|>), many))+import Data.Foldable (elem, toList)+import Data.Maybe (listToMaybe)+import Data.Monoid (Endo (Endo, appEndo), (<>))+import Yi.IncrementalParse (P, Parser, eof, lookNext, recoverWith, symbol)+import Yi.Lexer.Alex hiding (tokenToStyle)+import Yi.Lexer.Haskell+import Yi.Style (StyleName, errorStyle, hintStyle)+import Yi.Syntax (Point, Scanner, Span)+import Yi.Syntax.Layout (State, layoutHandler)+import Yi.Syntax.Tree++indentScanner :: Scanner (AlexState lexState) TT+ -> Scanner (Yi.Syntax.Layout.State Token lexState) TT+indentScanner = layoutHandler startsLayout [(Special '(', Special ')'),+ (Special '[', Special ']'),+ (Special '{', Special '}')] ignoredToken+ (Special '<', Special '>', Special '.') isBrace++-- HACK: We insert the Special '<', '>', '.', that don't occur in normal haskell+-- parsing.++isBrace :: TT -> Bool+isBrace (Tok b _ _) = Special '{' == b++ignoredToken :: TT -> Bool+ignoredToken (Tok t _ _) = isComment t || t == CppDirective++isNoise :: Token -> Bool+isNoise (Special c) = c `elem` (";,`" :: String)+isNoise _ = True++type Expr t = [Tree t]++data Tree t+ = Paren t (Expr t) t -- A parenthesized expression (maybe with [ ] ...)+ | Block ([Tree t]) -- A list of things separated by layout (as in do; etc.)+ | Atom t+ | Error t+ | Expr [Tree t]+ deriving (Show, Foldable, Functor)++instance IsTree Tree where+ emptyNode = Expr []+ uniplate (Paren l g r) = (g,\g' -> Paren l g' r)+ uniplate (Expr g) = (g,Expr)+ uniplate (Block s) = (s,Block)+ uniplate t = ([],const t)++-- | Search the given list, and return the 1st tree after the given+-- point on the given line. This is the tree that will be moved if+-- something is inserted at the point. Precondition: point is in the+-- given line.++-- TODO: this should be optimized by just giving the point of the end+-- of the line+getIndentingSubtree :: Tree TT -> Point -> Int -> Maybe (Tree TT)+getIndentingSubtree root offset line =+ listToMaybe [t | (t,posn) <- takeWhile ((<= line) . posnLine . snd) allSubTreesPosn,+ -- it's very important that we do a linear search+ -- here (takeWhile), so that the tree is evaluated+ -- lazily and therefore parsing it can be lazy.+ posnOfs posn > offset, posnLine posn == line]+ where allSubTreesPosn = [(t',posn) | t'@(Block _) <-filter (not . null . toList) (getAllSubTrees root),+ let (tok:_) = toList t',+ let posn = tokPosn tok]++-- | Given a tree, return (first offset, number of lines).+getSubtreeSpan :: Tree TT -> (Point, Int)+getSubtreeSpan tree = (posnOfs first, lastLine - firstLine)+ where bounds@[first, _last] = fmap (tokPosn . assertJust) [getFirstElement tree, getLastElement tree]+ [firstLine, lastLine] = fmap posnLine bounds+ assertJust (Just x) = x+ assertJust _ = error "assertJust: Just expected"++-- dropWhile' f = foldMap (\x -> if f x then mempty else Endo (x :))+--+-- isBefore l (Atom t) = isBefore' l t+-- isBefore l (Error t) = isBefore l t+-- isBefore l (Paren l g r) = isBefore l r+-- isBefore l (Block s) = False+--+-- isBefore' l (Tok {tokPosn = Posn {posnLn = l'}}) =+++parse :: P TT (Tree TT)+parse = Expr <$> parse' tokT tokFromT++parse' :: (TT -> Token) -> (Token -> TT) -> P TT [Tree TT]+parse' toTok _ = pExpr <* eof+ where+ -- parse a special symbol+ sym c = symbol (isSpecial [c] . toTok)++ pleaseSym c = recoverWith errTok <|> sym c++ pExpr :: P TT (Expr TT)+ pExpr = many pTree++ pBlocks = (Expr <$> pExpr) `sepBy1` sym '.' -- the '.' is generated by the layout, see HACK above+ -- note that we can have empty statements, hence we use sepBy1.++ pTree :: P TT (Tree TT)+ pTree = (Paren <$> sym '(' <*> pExpr <*> pleaseSym ')')+ <|> (Paren <$> sym '[' <*> pExpr <*> pleaseSym ']')+ <|> (Paren <$> sym '{' <*> pExpr <*> pleaseSym '}')++ <|> (Block <$> (sym '<' *> pBlocks <* sym '>')) -- see HACK above++ <|> (Atom <$> symbol (isNoise . toTok))+ <|> (Error <$> recoverWith (symbol (isSpecial "})]" . toTok)))++ -- note that, by construction, '<' and '>' will always be matched, so+ -- we don't try to recover errors with them.++getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]+getStrokes point _begin _end t0 = -- trace (show t0)+ result+ where getStrokes' (Atom t) = one (ts t)+ getStrokes' (Error t) = one (modStroke errorStyle (ts t)) -- paint in red+ getStrokes' (Block s) = getStrokesL s+ getStrokes' (Expr g) = getStrokesL g+ getStrokes' (Paren l g r)+ | isErrorTok $ tokT r = one (modStroke errorStyle (ts l)) <> getStrokesL g+ -- left paren wasn't matched: paint it in red.+ -- note that testing this on the "Paren" node actually forces the parsing of the+ -- right paren, undermining online behaviour.+ | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1+ = one (modStroke hintStyle (ts l)) <> getStrokesL g <> one (modStroke hintStyle (ts r))+ | otherwise = one (ts l) <> getStrokesL g <> one (ts r)+ getStrokesL = foldMap getStrokes'+ ts = tokenToStroke+ result = appEndo (getStrokes' t0) []+ one x = Endo (x :)+++tokenToStroke :: TT -> Stroke+tokenToStroke = fmap tokenToStyle . tokToSpan++modStroke :: StyleName -> Stroke -> Stroke+modStroke f = fmap (f `mappend`)++tokenToAnnot :: TT -> Maybe (Span String)+tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText+++-- | Create a special error token. (e.g. fill in where there is no correct token to parse)+-- Note that the position of the token has to be correct for correct computation of+-- node spans.+errTok :: Parser (Tok t) (Tok Token)+errTok = mkTok <$> curPos+ where curPos = tB <$> lookNext+ tB Nothing = maxBound+ tB (Just x) = tokBegin x+ mkTok p = Tok (Special '!') 0 (startPosn {posnOfs = p})
+ src/Yi/Syntax/Strokes/Haskell.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Syntax.Strokes.Haskell+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Produces 'Stroke's from a tree of tokens, used by some of the+-- Haskell modes.++module Yi.Syntax.Strokes.Haskell (getStrokes, tokenToAnnot) where++import Prelude hiding (any, error, exp)++import Data.Foldable (any)+import Data.Monoid (Endo (..), (<>))+import Yi.Debug (error, trace)+import Yi.Lexer.Alex (Posn (posnOfs), Stroke, Tok (tokPosn, tokT), tokToSpan)+import Yi.Lexer.Haskell+import Yi.String (showT)+import Yi.Style+import Yi.Syntax (Point, Span)+import Yi.Syntax.Haskell+import Yi.Syntax.Tree (subtrees)++-- TODO: (optimization) make sure we take in account the begin, so we+-- don't return useless strokes+getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]+getStrokes point begin _end t0 = trace (showT t0) result+ where result = appEndo (getStr tkDConst point begin _end t0) []++-- | Get strokes Module for module+getStrokeMod :: Point -> Point -> Point -> PModuleDecl TT -> Endo [Stroke]+getStrokeMod point begin _end tm@(PModuleDecl m na e w)+ = pKW tm m <> getStr tkImport point begin _end na+ <> getStrokes' e <> getStrokes' w+ where getStrokes' = getStr tkDConst point begin _end+ pKW b word | isErrN b = paintAtom errorStyle word+ | otherwise = getStrokes' word++-- | Get strokes for Imports+getStrokeImp :: Point -> Point -> Point -> PImport TT -> Endo [Stroke]+getStrokeImp point begin _end imp@(PImport m qu na t t')+ = pKW imp m <> paintQu qu+ <> getStr tkImport point begin _end na <> paintAs t <> paintHi t'+ where getStrokes' = getStr tkDConst point begin _end+ paintAs (Opt (Just (Bin (PAtom n c) tw)))+ = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c+ <> getStr tkImport point begin _end tw+ paintAs a = getStrokes' a+ paintQu (Opt (Just (PAtom n c))) = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c+ paintQu a = getStrokes' a+ paintHi (TC (Bin (Bin (PAtom n c) tw) r)) = one ((fmap (const keywordStyle) . tokToSpan) n)+ <> com c <> getStr tkImport point begin _end tw+ <> getStrokes' r+ paintHi a = getStrokes' a+ pKW b word | isErrN b = paintAtom errorStyle word+ | otherwise = getStrokes' word++-- | Get strokes for expressions and declarations+getStr :: (TT -> Endo [Stroke]) -> Point -> Point -> Point -> Exp TT+ -> Endo [Stroke]+getStr tk point begin _end = getStrokes'+ where getStrokes' :: Exp TT -> Endo [Stroke]+ getStrokes' t@(PImport {}) = getStrokeImp point begin _end t+ getStrokes' t@(PModuleDecl {}) = getStrokeMod point begin _end t+ getStrokes' (PModule c m) = com c <> foldMap getStrokes' m+ getStrokes' (PAtom t c) = tk t <> com c+ getStrokes' (TS col ts') = tk col <> foldMap (getStr tkTConst point begin _end) ts'+ getStrokes' (Modid t c) = tkImport t <> com c+ getStrokes' (Paren (PAtom l c) g (PAtom r c'))+ | isErr r = errStyle l <> getStrokesL g+ -- left paren wasn't matched: paint it in red.+ -- note that testing this on the "Paren" node actually forces the parsing of the+ -- right paren, undermining online behaviour.+ | posnOfs (tokPosn l) ==+ point || posnOfs (tokPosn r) == point - 1+ = pStyle hintStyle l <> com c <> getStrokesL g+ <> pStyle hintStyle r <> com c'+ | otherwise = tk l <> com c <> getStrokesL g+ <> tk r <> com c'+ getStrokes' (PError t _ c) = errStyle t <> com c+ getStrokes' da@(PData kw na exp eq)+ = pKW da kw <> getStrokes' na+ <> getStrokes' exp <> getStrokes' eq+ getStrokes' (PIn t l) = tk t <> getStrokesL l+ getStrokes' (TC l) = getStr tkTConst point begin _end l+ getStrokes' (DC (PAtom l c)) = tkDConst l <> com c+ getStrokes' (DC r) = getStrokes' r -- do not color operator dc+ getStrokes' g@(PGuard' t e t')+ = pKW g t <> getStrokes' e <> getStrokes' t'+ getStrokes' cl@(PClass e e' exp)+ = pKW cl e <> getStrokes' e'+ <> getStrokes' exp+ getStrokes' t = foldMap getStrokes' (subtrees t) -- by default deal with subtrees+ getStrokesL = foldMap getStrokes'+ pKW b word | isErrN b = paintAtom errorStyle word+ | otherwise = getStrokes' word++-- Stroke helpers follows++tokenToAnnot :: TT -> Maybe (Span String)+tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText++ts :: TT -> Stroke+ts = tokenToStroke++pStyle :: StyleName -> TT -> Endo [Stroke]+pStyle style = one . modStroke style . ts++one :: Stroke -> Endo [Stroke]+one x = Endo (x :)++paintAtom :: StyleName -> Exp TT -> Endo [Stroke]+paintAtom col (PAtom a c) = pStyle col a <> com c+paintAtom _ _ = error "wrong usage of paintAtom"++isErr :: TT -> Bool+isErr = isErrorTok . tokT++isErrN :: (Foldable v) => v TT -> Bool+isErrN = any isErr+--+-- || not $ null $ isError' t++errStyle :: TT -> Endo [Stroke]+errStyle = pStyle errorStyle++tokenToStroke :: TT -> Stroke+tokenToStroke = fmap tokenToStyle . tokToSpan++modStroke :: StyleName -> Stroke -> Stroke+modStroke f = fmap (f `mappend`)++com :: [TT] -> Endo [Stroke]+com = foldMap tkDConst++tk' :: (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]+tk' f s t | isErr t = errStyle t+ | tokT t `elem` fmap Reserved [As, Qualified, Hiding]+ = one $ (fmap (const variableStyle) . tokToSpan) t+ | f t = s t+ | otherwise = one (ts t)++tkTConst :: TT -> Endo [Stroke]+tkTConst = tk' (const False) (const (Endo id))+++tkDConst :: TT -> Endo [Stroke]+tkDConst = tk' ((== ConsIdent) . tokT) (pStyle dataConstructorStyle)++tkImport :: TT -> Endo [Stroke]+tkImport = tk' ((== ConsIdent) . tokT) (pStyle importStyle)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Yi/Lexer/HaskellSpec.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances #-}+{-# LANGUAGE IncoherentInstances, UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving, QuasiQuotes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Yi.Lexer.HaskellSpec (main, spec) where+++import Control.Applicative ((<$>))+import Prelude hiding (lex)+import System.FilePath ((</>))+import Test.Hspec+import Yi.Buffer.Basic (Point(..))+import Yi.Lexer.Alex+import Yi.Lexer.Haskell+import Yi.Lexer.Helpers.TH+++deriving instance Read OpType+deriving instance Read ReservedType+deriving instance Read CommentType+deriving instance Read Token+deriving instance Read Posn+deriving instance Read Size+deriving instance Read Point+deriving instance Read a => Read (Tok a)++newState :: AlexState HlState+newState = AlexState initState 0 startPosn++mkIndx :: String -> IndexedStr+mkIndx = zip [1 ..]++newInput :: String -> AlexInput+newInput s = ('\n', [], mkIndx s)++lex :: String -> [(AlexState HlState, TT)]+lex s = unfoldLexer alexScanToken (newState, newInput s)++lexTok :: String -> [TT]+lexTok = map snd . lex++lexToks :: String -> [Token]+lexToks = map tokT . lexTok++shouldLexToS :: FilePath -> [Token] -> Expectation+shouldLexToS fp t = lexToks <$> readSample fp `shouldReturn` t++lexesToS :: String -> [Token] -> Spec+lexesToS s tt = it s $ s `shouldLexToS` tt++readSample :: FilePath -> IO String+readSample x = readFile $ "test" </> "test_data" </> x++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "lexer tests" $ do+ it "fill me in" pending+ -- "Simple1.hs" `lexesToS` [ritFile|test/test_data/Simple1.hs_Token|]+ -- "Simple1Unicode.hs" `lexesToS` [ritFile|test/test_data/Simple1Unicode.hs_Token|]+ -- "UnicodeLiteral.hs" `lexesTo` [ritFile|test/test_data/UnicodeLiteral.hs_TToken|]
+ test/Yi/Lexer/Helpers.hs view
@@ -0,0 +1,2 @@+{-# LANGUAGE QuasiQuotes #-}+module Yi.Lexer.Helpers where
+ test/Yi/Lexer/Helpers/TH.hs view
@@ -0,0 +1,30 @@+module Yi.Lexer.Helpers.TH where++import Language.Haskell.TH+import Language.Haskell.TH.Quote++literally :: String -> Q Exp+literally = return . LitE . StringL++withRead :: String -> Q Exp+withRead s = return $ AppE (VarE $ mkName "read") (LitE $ StringL s)++lit :: QuasiQuoter+lit = QuasiQuoter { quoteExp = literally+ , quotePat = \s -> error s $ "quotePat: " ++ s+ , quoteType = \s -> error $ "quoteType: " ++ s+ , quoteDec = \s -> error $ "quoteDec: " ++ s}++rlit :: QuasiQuoter+rlit = QuasiQuoter { quoteExp = withRead+ , quotePat = \s -> error s $ "quotePat: " ++ s+ , quoteType = \s -> error $ "quoteType: " ++ s+ , quoteDec = \s -> error $ "quoteDec: " ++ s}+++-- | Read file as-is.+litFile :: QuasiQuoter+litFile = quoteFile lit++ritFile :: QuasiQuoter+ritFile = quoteFile rlit
+ yi-mode-haskell.cabal view
@@ -0,0 +1,87 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name: yi-mode-haskell+version: 0.13+synopsis: Yi editor haskell mode+category: Yi+homepage: https://github.com/yi-editor/yi#readme+bug-reports: https://github.com/yi-editor/yi/issues+maintainer: Yi developers <yi-devel@googlegroups.com>+license: GPL-2+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/yi-editor/yi++library+ hs-source-dirs:+ src+ ghc-options: -Wall -ferror-spans+ include-dirs:+ src/Yi/Lexer+ build-depends:+ base >= 4.8 && < 5+ , array+ , binary >= 0.7+ , data-default+ , microlens-platform+ , text+ , yi-core+ , yi-language+ , yi-rope+ exposed-modules:+ Yi.Config.Default.HaskellMode+ Yi.Lexer.Haskell+ Yi.Lexer.LiterateHaskell+ Yi.Mode.GHCi+ Yi.Mode.Haskell+ Yi.Mode.Haskell.Dollarify+ Yi.Syntax.Haskell+ Yi.Syntax.Paren+ Yi.Syntax.Strokes.Haskell+ other-modules:+ Paths_yi_mode_haskell+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -Wall -ferror-spans -Wall+ include-dirs:+ src/Yi/Lexer+ build-depends:+ base >= 4.8 && < 5+ , array+ , binary >= 0.7+ , data-default+ , microlens-platform+ , text+ , yi-core+ , yi-language+ , yi-rope+ , base+ , array+ , binary+ , containers+ , data-default+ , filepath+ , hashable >=1.1.2.5+ , hspec+ , microlens-platform+ , pointedlist >= 0.5+ , regex-base ==0.93.*+ , regex-tdfa >= 1.1 && <1.3+ , template-haskell >= 2.4+ , transformers-base+ , unordered-containers >= 0.1.3 && < 0.3+ , QuickCheck == 2.*+ , yi-mode-haskell+ other-modules:+ Yi.Lexer.HaskellSpec Yi.Lexer.Helpers Yi.Lexer.Helpers.TH+ default-language: Haskell2010