File: DigraphQuote.hs

package info (click to toggle)
glirc 2.32-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 872 kB
  • sloc: haskell: 12,748; ansic: 82; makefile: 6
file content (53 lines) | stat: -rw-r--r-- 1,587 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
{-|
Module      : DigraphQuote
Description : Template Haskell quasi-quoter for digraph table
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

-}
module DigraphQuote (digraphTable) where

import Data.Char
import Control.Monad
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Numeric (readHex)

digraphTable :: QuasiQuoter
digraphTable = QuasiQuoter
  { quoteExp  = digraphTableExp
  , quotePat  = const (fail "Digraph table must be an expression")
  , quoteType = const (fail "Digraph table must be an expression")
  , quoteDec  = const (fail "Digraph table must be an expression")
  }

digraphTableExp :: String -> ExpQ
digraphTableExp = stringE . concat <=< traverse parseEntry . lines

-- Parse entries, empty lines are ignored, -- comments are allowed
-- Entries are a two-character digraph followed by a hexadecimal
-- representation of the replacement character's unicode value.
--
-- Examples
--
-- > "'   14
-- > AB 0123
-- > CD 0FDE -- with a comment
-- >
-- > -- with a comment
parseEntry :: String -> Q String
parseEntry line =
  case words line of
    [x,y] : ('U':'+':hex) : rest
       | [(n,"")] <- readHex hex
       , isAllowedTerminator rest   -> pure [x,y,chr n]

    rest | isAllowedTerminator rest -> pure "" -- skip empty lines
         | otherwise                -> fail ("Bad digraph entry: " ++ line)

-- Optionally tolerate a comment
isAllowedTerminator :: [String] -> Bool
isAllowedTerminator (('-':'-':_):_) = True
isAllowedTerminator []              = True
isAllowedTerminator _               = False