emacs-keys (empty) → 0.0.1.0

raw patch · 8 files changed

+207/−0 lines, 8 filesdep +basedep +doctestdep +emacs-keyssetup-changed

Dependencies added: base, doctest, emacs-keys, split, tasty, tasty-hspec, tasty-quickcheck, template-haskell, th-lift, xkbcommon

Files

• LICENSE +13/−0
• Setup.hs +2/−0
• emacs-keys.cabal +56/−0
• src/EmacsKeys.hs +8/−0
• src/EmacsKeys/Parser.hs +56/−0
• src/EmacsKeys/TH.hs +22/−0
• test/Doctests.hs +9/−0
• test/Test.hs +41/−0

@@ -0,0 +1,13 @@+Copyright (c) 2015 Moritz Kiefer++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,56 @@+name:                emacs-keys+version:             0.0.1.0+synopsis:            library to parse emacs style keybinding into the modifiers and the chars+description:         Allows parsing emacs style keybindings like "M-a", "C-M-a" or+                     "M-Return". For convenience a TH helper that turns parse+                     errors into compile errors is also provided.+homepage:            https://github.com/cocreature/emacs-keys+bug-reports:         https://github.com/cocreature/emacs-keys+license:             ISC+license-file:        LICENSE+author:              Moritz Kiefer+maintainer:          moritz.kiefer@purelyfunctional.org+-- copyright:           +category:            Parsing+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10+++source-repository    head+  type:              git+  location:          https://github.com/cocreature/emacs-keys.git++library+  exposed-modules:     EmacsKeys+  other-modules:       EmacsKeys.Parser+                     , EmacsKeys.TH+  build-depends:       base >=4.8 && < 4.9+                     , template-haskell >= 2.10 && < 2.11+                     , xkbcommon >= 0.0 && < 0.1+                     , th-lift >= 0.7 && < 0.8+                     , split >= 0.2 && < 0.3+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall++test-suite tasty+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Test.hs+  build-depends:       emacs-keys+                     , base >= 4.8 && < 4.9+                     , tasty >= 0.10 && < 0.11+                     , tasty-hspec >= 1.1 && < 1.2+                     , tasty-quickcheck >= 0.8 && < 0.9+                     , xkbcommon >= 0.0 && < 0.1+  ghc-options:         -Wall++test-suite doctests+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Doctests.hs+  build-depends:       base >= 4.8 && < 4.9+                     , doctest >= 0.10 && < 0.11

@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}+-- | Main module that reexports the other ones+module EmacsKeys+  (module EmacsKeys.Parser+  ,module EmacsKeys.TH) where++import EmacsKeys.Parser+import EmacsKeys.TH

@@ -0,0 +1,56 @@+{-# LANGUAGE TemplateHaskell #-}+-- | provides the parser functions+module EmacsKeys.Parser +  (Modifier(..)+  ,parseEmacsKeys)+  where++import Data.Char+import Data.Either+import Data.List.Split+import Language.Haskell.TH.Lift+import Text.XkbCommon++-- | Represents the accepted modifiers 'C','M','S'+data Modifier = Ctrl | Meta | Shift deriving (Show,Eq,Ord)++deriveLift ''Modifier++parseModifier :: String -> Either Modifier String+parseModifier s = case lookup s modifiers of+                    Just m -> Left m+                    Nothing -> Right s++parseKeys :: [Either Modifier String] -> Either String ([Modifier],[Keysym])+parseKeys keys =+  fmap (\keysyms -> (mods,keysyms)) $+  sequence $+  fmap (parseKeysym .+        if shift+           then fmap toUpper+           else id) $+  unparsedSyms+  where (mods,unparsedSyms) = partitionEithers keys+        shift = Shift `elem` mods++parseKeysym :: String -> Either String Keysym+parseKeysym s =  case keysymFromName s of+                   Just ks -> Right ks+                   Nothing -> Left $ "Invalid key: \"" ++ s ++ "\""++-- | Parse a string into a list of modifiers and keysyms+-- If Shift is part of the modifiers, the keysyms are converted to upper case+--+-- >>> parseEmacsKeys "M-a"+-- Right ([Meta],[Keysym 97])+--+-- >>> parseEmacsKeys "Return"+-- Right ([],[Keysym 65293])+--+-- >>> parseEmacsKeys "S-a"+-- Right ([Shift],[Keysym 65])+parseEmacsKeys :: String -> Either String ([Modifier],[Keysym])+parseEmacsKeys = parseKeys . fmap parseModifier . splitOn "-"++modifiers :: [(String,Modifier)]+modifiers = [("C",Ctrl),("M",Meta),("S",Shift)]

@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell #-}+-- | provides TH helpers+module EmacsKeys.TH+  (mkEmacsKeys)+  where+import EmacsKeys.Parser+import Language.Haskell.TH+import Language.Haskell.TH.Lift+import Text.XkbCommon++-- | TH helper, to turn parse errors into compile time errors+mkEmacsKeys :: String -> Q Exp+mkEmacsKeys s =+  case parseEmacsKeys s of+    Left err -> error (show err)+    Right (mods,keysyms) ->+      [|($(lift mods)+        ,$(ListE <$>+           traverse (\(Keysym x) ->+                       AppE (VarE (mkName "Keysym")) <$>+                       lift x)+                    keysyms))|]

@@ -0,0 +1,9 @@+module Main where++import Test.DocTest++main =+  doctest ["-isrc"+          ,"src/EmacsKeys.hs"+          ,"src/EmacsKeys/Parser.hs"+          ,"src/EmacsKeys/TH.hs"]

@@ -0,0 +1,41 @@+module Main where++import Data.Char+import Data.Function+import EmacsKeys+import Test.Tasty+import Test.Tasty.Hspec+import Test.Tasty.QuickCheck as QC+import Text.XkbCommon.KeysymList++main :: IO ()+main = defaultMain =<< tests++tests :: IO TestTree+tests = fmap (testGroup "tests") $ sequence [hspecTests, pure properties]++hspecTests :: IO TestTree+hspecTests = testSpec "hspec" $+  describe "parseEmacsKeys" $ do+    it "should parse M-Return" $+      parseEmacsKeys "M-Return" `shouldBe` Right ([Meta],[keysym_Return])+    it "should parse M-n" $+      parseEmacsKeys "M-n" `shouldBe` Right ([Meta],[keysym_n])+    it "should parse M-S-n" $+      parseEmacsKeys "M-S-N" `shouldBe` Right ([Meta,Shift],[keysym_N])+    it "should parse M-S-1" $+      parseEmacsKeys "M-S-1" `shouldBe` Right ([Meta,Shift],[keysym_1])++properties :: TestTree+properties =+  testGroup "properties"+            [QC.testProperty "shift converts to upper" $+             \char ->+               on (==)+                  (fmap snd)+                  (parseEmacsKeys+                     ("S-" +++                      [char]))+                  (parseEmacsKeys [toUpper char]) ||+               char `elem`+               ['c','s','m']]