Update megaparsec to version 6

keyboard-layout-files-creator.cabal

@@ -23,7 +23,7 @@ executable klfc
                    microlens-platform,
                    base-unicode-symbols,
                    containers-unicode-symbols,
-                   megaparsec,
+                   megaparsec >= 6,
                    filepath,
                    directory,
                    optparse-applicative,

scripts/ActionToMd.hs

@@ -6,12 +6,11 @@ module ActionToMd where
 import Prelude.Unicode
 import ToMarkdownList
 import System.IO (hPutStrLn, stderr)
-import qualified Data.Text.Lazy.IO as L (getContents)
 import Text.Megaparsec (parse)
 
 main ∷ IO ()
 main = do
-    text ← L.getContents
+    text ← getContents
     let list = haskellListToMdList <$> parse (haskellList Data "Action") "" text
     let info = mdListToMd "The supported actions are:" <$> list
     either (hPutStrLn stderr ∘ show) (mapM_ putStrLn) info

scripts/PosToMd.hs

@@ -6,12 +6,11 @@ module PosToMd where
 import Prelude.Unicode
 import ToMarkdownList
 import System.IO (hPutStrLn, stderr)
-import qualified Data.Text.Lazy.IO as L (getContents)
 import Text.Megaparsec (parse)
 
 main ∷ IO ()
 main = do
-    text ← L.getContents
+    text ← getContents
     let list = haskellListToMdList <$> parse (haskellList List "posAndString") "" text
     let info = mdListToMd "The supported positions are:" <$> list
     either (hPutStrLn stderr ∘ show) (mapM_ putStrLn) info

scripts/ToMarkdownList.hs

@@ -8,11 +8,14 @@ import Data.Monoid.Unicode ((⊕))
 
 import Data.Maybe (fromMaybe)
 import Data.Char (isLetter)
+import Data.Void (Void)
 import Data.List (intercalate, groupBy)
 import Data.Function (on)
 import Text.Read (readMaybe)
 import Text.Megaparsec
-import Text.Megaparsec.Text.Lazy (Parser)
+import Text.Megaparsec.Char
+
+type Parser = Parsec Void String
 
 type MdList = [Either Category PartOfMdList]
 type Category = String

src/KlcParse.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
 
 module KlcParse
     ( parseKlcLayout
@@ -17,17 +17,20 @@ import Control.Monad.Trans (lift)
 import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Writer (runWriterT, writer, tell)
 import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Void (Void)
 import qualified Data.Text.Lazy as L (Text)
 import Lens.Micro.Platform (ASetter, view, set, over, makeLenses, ix, _1)
 import Text.Megaparsec hiding (Pos)
-import Text.Megaparsec.Prim (MonadParsec)
+import Text.Megaparsec.Char
 
 import Layout.Key (Key(..))
 import Layout.Layout (Layout(..))
 import Layout.Types
 import Lookup.Windows
 import WithBar (WithBar(..))
 
+type Parser = MonadParsec Void L.Text
+
 data KlcParseLayout = KlcParseLayout
     { __parseInformation ∷ Information
     , __parseShiftstates ∷ [Shiftstate]
@@ -41,7 +44,7 @@ instance Monoid KlcParseLayout where
     KlcParseLayout a1 a2 a3 a4 a5 `mappend` KlcParseLayout b1 b2 b3 b4 b5 =
         KlcParseLayout (a1 ⊕ b1) (a2 ⊕ b2) (a3 ⊕ b3) (a4 ⊕ b4) (a5 ⊕ b5)
 
-layout ∷ (Logger m, MonadParsec Dec s m, Token s ~ Char) ⇒ m Layout
+layout ∷ (Logger m, Parser m) ⇒ m Layout
 layout = do
     KlcParseLayout info states keys ligs deads ← klcLayout
     ($ keys) $
@@ -71,7 +74,7 @@ setLigatures' xs key = foldr setLigature key ligs
     ligs = filter ((≡) (view _pos key) ∘ view _1) xs
     setLigature (_, i, s) = set (_letters ∘ ix i) (Ligature Nothing s)
 
-klcLayout ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m KlcParseLayout
+klcLayout ∷ (Logger m, Parser m) ⇒ m KlcParseLayout
 klcLayout = many >$> mconcat $
         set' _parseInformation <$> try kbdField
     <|> set' _parseShiftstates <$> try shiftstates
@@ -92,27 +95,27 @@ klcLayout = many >$> mconcat $
     field "VERSION" = pure ∘ set' _version ∘ Just
     field f = const $ (∅) <$ tell ["unknown field ‘" ⊕ f ⊕ "’"]
 
-kbdField ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m Information
+kbdField ∷ Parser m ⇒ m Information
 kbdField = do
     ["KBD", l1, l2] ← readLine
     pure ∘ set _name l1 ∘ set _fullName l2 $ (∅)
 
-shiftstates ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m [Shiftstate]
+shiftstates ∷ Parser m ⇒ m [Shiftstate]
 shiftstates = do
     ["SHIFTSTATE"] ← readLine
     map shiftstateFromWinShiftstate <$> many (try shiftstate)
 
-shiftstate ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m Int
+shiftstate ∷ Parser m ⇒ m Int
 shiftstate = do
     [i] ← readLine
     maybe (fail $ "‘" ⊕ show i ⊕ "’ is not an integer") pure (readMaybe i)
 
-klcKeys ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m [Key]
+klcKeys ∷ (Logger m, Parser m) ⇒ m [Key]
 klcKeys = do
     try $ spacing *> string "LAYOUT" *> endLine *> pure ()
     catMaybes <$> many (isHex *> klcKey)
 
-klcKey ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m (Maybe Key)
+klcKey ∷ (Logger m, Parser m) ⇒ m (Maybe Key)
 klcKey = runMaybeT $ do
     sc:vk:caps:letters ← lift readLine
     Key
@@ -149,12 +152,12 @@ parseLetter xs
           Just c → pure (Char c)
           Nothing → LNothing <$ tell ["unknown letter ‘" ⊕ xs ⊕ "’"]
 
-ligatures ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m [(Pos, Int, String)]
+ligatures ∷ (Logger m, Parser m) ⇒ m [(Pos, Int, String)]
 ligatures = do
     ["LIGATURE"] ← readLine
     catMaybes <$> many (try ligature)
 
-ligature ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m (Maybe (Pos, Int, String))
+ligature ∷ (Logger m, Parser m) ⇒ m (Maybe (Pos, Int, String))
 ligature = runMaybeT $ do
     sc:i:chars ← lift readLine
     guard (not (null chars))
@@ -166,60 +169,60 @@ ligature = runMaybeT $ do
     letterToChar (Char c) = Just c
     letterToChar _ = Nothing
 
-deadKey ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m [(Char, StringMap)]
+deadKey ∷ (Logger m, Parser m) ⇒ m [(Char, StringMap)]
 deadKey = do
     ["DEADKEY", s] ← readLine
     let i = maybeToList (readMaybe ('0':'x':s))
     c ← chr <$> i <$ when (null i) (tell ["unknown dead key ‘" ⊕ s ⊕ "’"])
     m ← many (isHex *> deadPair)
     pure (zip c [m])
 
-deadPair ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m (String, String)
+deadPair ∷ Parser m ⇒ m (String, String)
 deadPair = do
     [x, y] ← map (\s → maybe '\0' chr (readMaybe ('0':'x':s))) <$> readLine
     pure ([x], [y])
 
-keyName ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m [(String, String)]
+keyName ∷ Parser m ⇒ m [(String, String)]
 keyName = do
     ['K':'E':'Y':'N':'A':'M':'E':_] ← readLine
     many (try nameValue)
 
-endKbd ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m ()
+endKbd ∷ Parser m ⇒ m ()
 endKbd = do
     ["ENDKBD"] ← readLine
     pure ()
 
-nameValue ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m (String, String)
+nameValue ∷ Parser m ⇒ m (String, String)
 nameValue = do
     [name, value] ← readLine
     pure (name, value)
 
-readLine ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m [String]
+readLine ∷ Parser m ⇒ m [String]
 readLine = takeWhile (not ∘ isComment) <$> some (klcValue <* spacing) <* emptyOrCommentLines
   where
     isComment (';':_) = True
     isComment ('/':'/':_) = True
     isComment _ = False
 
-klcValue ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
-klcValue = try (char '"' *> manyTill anyChar (char '"')) <|> try (some (noneOf " \t\r\n")) <?> "klc value"
+klcValue ∷ Parser m ⇒ m String
+klcValue = try (char '"' *> manyTill anyChar (char '"')) <|> try (some (noneOf [' ','\t','\r','\n'])) <?> "klc value"
 
-isHex ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m Char
+isHex ∷ Parser m ⇒ m Char
 isHex = (lookAhead ∘ try) (spacing *> satisfy ((∧) <$> isHexDigit <*> not ∘ isUpper))
 
-spacing ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
-spacing = many (oneOf " \t")
+spacing ∷ Parser m ⇒ m String
+spacing = many (oneOf [' ','\t'])
 
-comment ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+comment ∷ Parser m ⇒ m String
 comment = spacing *> (string ";" <|> string "//") *> manyTill anyChar (try eol)
 
-endLine ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+endLine ∷ Parser m ⇒ m String
 endLine = manyTill anyChar (try eol) <* emptyOrCommentLines
 
-emptyLine ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+emptyLine ∷ Parser m ⇒ m String
 emptyLine = spacing <* eol
 
-emptyOrCommentLines ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m [String]
+emptyOrCommentLines ∷ Parser m ⇒ m [String]
 emptyOrCommentLines = many (try emptyLine <|> try comment)
 
 parseKlcLayout ∷ Logger m ⇒ String → L.Text → Either String (m Layout)

src/PklParse.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE UnicodeSyntax, NoImplicitPrelude #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
 
 module PklParse
     ( parsePklLayout
@@ -17,9 +17,10 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Control.Monad.Writer (runWriterT, writer, tell)
 import Data.List.NonEmpty (NonEmpty((:|)))
 import qualified Data.Text.Lazy as L (Text)
+import Data.Void (Void)
 import Lens.Micro.Platform (set, (<&>))
 import Text.Megaparsec hiding (Pos)
-import Text.Megaparsec.Prim (MonadParsec)
+import Text.Megaparsec.Char
 
 import Layout.Key (Key(Key))
 import Layout.Layout (Layout(Layout))
@@ -28,7 +29,9 @@ import Layout.Types
 import Lookup.Windows
 import WithBar (WithBar(..))
 
-layout ∷ (Logger m, MonadParsec Dec s m, Token s ~ Char) ⇒ m Layout
+type Parser = MonadParsec Void L.Text
+
+layout ∷ (Logger m, Parser m) ⇒ m Layout
 layout = do
     PklParseLayout info states keys specialKeys deads ← pklLayout
     ($ keys) $
@@ -58,11 +61,11 @@ instance Monoid PklParseLayout where
     PklParseLayout a1 a2 a3 a4 a5 `mappend` PklParseLayout b1 b2 b3 b4 b5 =
         PklParseLayout (a1 ⊕ b1) (a2 ⊕ b2) (a3 ⊕ b3) (a4 ⊕ b4) (a5 ⊕ b5)
 
-pklLayout ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m PklParseLayout
+pklLayout ∷ (Logger m, Parser m) ⇒ m PklParseLayout
 pklLayout = mconcat <$> many ((sectionName >>= section) <* many nonSectionLine)
   where
     sectionName = char '[' *> manyTill anyChar (char ']') <* endLine
-    section ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ String → m PklParseLayout
+    section ∷ (Logger m, Parser m) ⇒ String → m PklParseLayout
     section "informations" = (\l → (∅) { parseInformation = l }) <$> informationsSection
     section "global" = globalSection
     section "layout" = (\ks → (∅) { parseKeys = ks }) <$> layoutSection
@@ -74,7 +77,7 @@ pklLayout = mconcat <$> many ((sectionName >>= section) <* many nonSectionLine)
         where num = readMaybe (drop 7 xs) ∷ Maybe Int
     nonSectionLine = lookAhead (noneOf "[") *> many (noneOf "\r\n") *> eol
 
-informationsSection ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m Information
+informationsSection ∷ (Logger m, Parser m) ⇒ m Information
 informationsSection = mconcat <$> (many nameValue >>= traverse (uncurry field))
   where
     field ∷ Logger m ⇒ String → String → m Information
@@ -90,12 +93,12 @@ informationsSection = mconcat <$> (many nameValue >>= traverse (uncurry field))
     field "modified_after_generate" = pure ∘ const (∅)
     field name = const $ (∅) <$ tell ["unknown information ‘" ⊕ name ⊕ "’"]
 
-nameValue ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m (String, String)
+nameValue ∷ Parser m ⇒ m (String, String)
 nameValue = liftA2 (,)
             (lookAhead (noneOf "[") *> some (noneOf "= \t"))
             (spacing *> char '=' *> spacing *> endLine)
 
-globalSection ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m PklParseLayout
+globalSection ∷ Parser m ⇒ m PklParseLayout
 globalSection = mconcat ∘ map (uncurry field) <$> many nameValue
   where
     field ∷ String → String → PklParseLayout
@@ -110,12 +113,12 @@ shiftstates xs =
     (s, [])   → [s]
     (s, _:ss) → s : shiftstates ss
 
-layoutSection ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m [Key]
+layoutSection ∷ (Logger m, Parser m) ⇒ m [Key]
 layoutSection = catMaybes <$> many (try key <|> Nothing <$ unknownLine)
   where
     unknownLine = lookAhead (noneOf "[") *> eol
 
-key ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m (Maybe Key)
+key ∷ (Logger m, Parser m) ⇒ m (Maybe Key)
 key = runMaybeT $ do
     pos ← parseScancode =<< lift (oneOf "sS" *> oneOf "cC" *> some hexDigitChar)
     void ∘ lift $ spacing *> char '=' *> spacing
@@ -171,14 +174,14 @@ parseLetter s' = maybe (LNothing <$ tell ["unknown letter ‘" ⊕ s' ⊕ "’"]
     parseDead _ = Nothing
     parseAction = fmap Action ∘ asum ∘ map (`lookupR` actionAndPklAction) ∘ ap [Simple] ∘ pure
 
-deadkeySection ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m DeadKey
+deadkeySection ∷ Parser m ⇒ m DeadKey
 deadkeySection = do
     deadkeyMap ← many deadkeyValue
     let name = maybe "" snd (listToMaybe deadkeyMap)
     let c = listToMaybe name
     pure (DeadKey name c deadkeyMap)
 
-deadkeyValue ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m (String, String)
+deadkeyValue ∷ Parser m ⇒ m (String, String)
 deadkeyValue = do
     from ← readMaybe <$> many digitChar
     void $ spacing >> char '=' >> spacing
@@ -187,7 +190,7 @@ deadkeyValue = do
     maybe (fail "could not parse deadkey") pure $
         (,) <$> fmap (pure ∘ chr) from <*> fmap (pure ∘ chr) to
 
-extendSection ∷ (Logger m, MonadParsec e s m, Token s ~ Char) ⇒ m PklParseLayout
+extendSection ∷ (Logger m, Parser m) ⇒ m PklParseLayout
 extendSection = many nameValue >>= traverse (uncurry field) <&> (\ks → (∅)
                     { parseShiftstates = [WP.singleton M.Extend]
                     , parseKeys = catMaybes ks
@@ -203,19 +206,19 @@ extendSection = many nameValue >>= traverse (uncurry field) <&> (\ks → (∅)
                 <*> pure Nothing
     field _ xs = Nothing <$ tell ["unknown letter ‘" ⊕ xs ⊕ "’"]
 
-spacing ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+spacing ∷ Parser m ⇒ m String
 spacing = many (oneOf " \t")
 
-endLine ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+endLine ∷ Parser m ⇒ m String
 endLine = manyTill anyChar (try eol) <* emptyOrCommentLines
 
-comment ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+comment ∷ Parser m ⇒ m String
 comment = spacing *> char ';' *> manyTill anyChar (try eol)
 
-emptyLine ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m String
+emptyLine ∷ Parser m ⇒ m String
 emptyLine = spacing <* eol
 
-emptyOrCommentLines ∷ (MonadParsec e s m, Token s ~ Char) ⇒ m [String]
+emptyOrCommentLines ∷ Parser m ⇒ m [String]
 emptyOrCommentLines = many (try emptyLine <|> comment)
 
 parsePklLayout ∷ Logger m ⇒ String → L.Text → Either String (m Layout)