{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module BNFC.Utils
( ModuleName
, when, unless, unlessNull, unlessNull'
, applyWhen, applyUnless
, for, whenJust
, caseMaybe, (>.>)
, curry3, uncurry3
, singleton, headWithDefault, mapHead, spanEnd
, duplicatesOn, groupOn, uniqOn
, hasNumericSuffix
, (+++), (++++), (+-+), (+.+), parensIf
, pad, table
, mkName, mkNames, NameStyle(..)
, lowerCase, upperCase, mixedCase
, camelCase, camelCase_
, snakeCase, snakeCase_
, replace
, writeFileRep
, cstring
, getZonedTimeTruncatedToSeconds
, symbolToName
) where
import Control.Arrow ((&&&))
import Control.DeepSeq (rnf)
import Data.Char
import Data.List (intercalate)
import Data.List.NonEmpty (pattern (:|))
import Data.Map (Map)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Time
import qualified Data.Foldable as Fold
import qualified Data.Map as Map
import qualified Data.List.NonEmpty as List1
import System.IO (IOMode(ReadMode),hClose,hGetContents,openFile)
import System.IO.Error (tryIOError)
import BNFC.PrettyPrint (Doc, text)
type List1 = List1.NonEmpty
type ModuleName = String
#if __GLASGOW_HASKELL__ <= 710
instance {-# OVERLAPPING #-} Semigroup (IO ()) where
(<>) = (>>)
instance {-# OVERLAPPING #-} Monoid (IO ()) where
mempty = return ()
mappend = (<>)
mconcat = sequence_
#endif
when :: Monoid m => Bool -> m -> m
when :: forall m. Monoid m => Bool -> m -> m
when Bool
True m
m = m
m
when Bool
False m
_ = forall a. Monoid a => a
mempty
unless :: Monoid m => Bool -> m -> m
unless :: forall m. Monoid m => Bool -> m -> m
unless Bool
False m
m = m
m
unless Bool
True m
_ = forall a. Monoid a => a
mempty
applyWhen :: Bool -> (a -> a) -> a -> a
applyWhen :: forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
True a -> a
f = a -> a
f
applyWhen Bool
False a -> a
_ = forall a. a -> a
id
applyUnless :: Bool -> (a -> a) -> a -> a
applyUnless :: forall a. Bool -> (a -> a) -> a -> a
applyUnless Bool
False a -> a
f = a -> a
f
applyUnless Bool
True a -> a
_ = forall a. a -> a
id
unlessNull :: Monoid m => [a] -> ([a] -> m) -> m
unlessNull :: forall m a. Monoid m => [a] -> ([a] -> m) -> m
unlessNull [a]
l [a] -> m
k = case [a]
l of
[] -> forall a. Monoid a => a
mempty
[a]
as -> [a] -> m
k [a]
as
unlessNull' :: Monoid m => [a] -> (a -> [a] -> m) -> m
unlessNull' :: forall m a. Monoid m => [a] -> (a -> [a] -> m) -> m
unlessNull' [a]
l a -> [a] -> m
k = case [a]
l of
[] -> forall a. Monoid a => a
mempty
(a
a:[a]
as) -> a -> [a] -> m
k a
a [a]
as
infixr 8 >.>
(>.>) :: (a -> b) -> (b -> c) -> a -> c
a -> b
g >.> :: forall a b c. (a -> b) -> (b -> c) -> a -> c
>.> b -> c
f = b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g
for :: [a] -> (a -> b) -> [b]
for :: forall a b. [a] -> (a -> b) -> [b]
for = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map
whenJust :: Monoid m => Maybe a -> (a -> m) -> m
whenJust :: forall m a. Monoid m => Maybe a -> (a -> m) -> m
whenJust = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
caseMaybe :: Maybe a -> b -> (a -> b) -> b
caseMaybe :: forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe Maybe a
ma b
b a -> b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
b a -> b
f Maybe a
ma
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (a, b, c) -> d
f a
a b
b c
c = (a, b, c) -> d
f (a
a,b
b,c
c)
uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
uncurry3 :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 a -> b -> c -> d
f ~(a
a,b
b,c
c) = a -> b -> c -> d
f a
a b
b c
c
infixr 5 +++, ++++, +-+, +.+
(+++) :: String -> String -> String
String
a +++ :: String -> String -> String
+++ String
b = String
a forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
b
(++++) :: String -> String -> String
String
a ++++ :: String -> String -> String
++++ String
b = String
a forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
b
(+-+) :: String -> String -> String
String
a +-+ :: String -> String -> String
+-+ String
b = String
a forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ String
b
(+.+) :: String -> String -> String
String
a +.+ :: String -> String -> String
+.+ String
b = String
a forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
b
parensIf :: Bool -> String -> String
parensIf :: Bool -> String -> String
parensIf = \case
Bool
True -> (String
"(" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
")")
Bool
False -> forall a. a -> a
id
pad :: Int -> String -> String
pad :: Int -> String -> String
pad Int
n String
s = String
s forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (forall a. Int -> a -> [a]
replicate Int
n Char
' ')
table :: String -> [[String]] -> [String]
table :: String -> [[String]] -> [String]
table String
sep [[String]]
m = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> String -> String
pad [Int]
widths) [[String]]
m
where
widths :: [Int]
widths :: [Int]
widths = forall a b. ([a] -> b) -> [[a]] -> [b]
columns forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[String]]
m
columns :: ([a] -> b) -> [[a]] -> [b]
columns :: forall a b. ([a] -> b) -> [[a]] -> [b]
columns [a] -> b
f [[a]]
rows =
case forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
take Int
1) [[a]]
rows) of
[] -> []
[a]
col -> [a] -> b
f [a]
col forall a. a -> [a] -> [a]
: forall a b. ([a] -> b) -> [[a]] -> [b]
columns [a] -> b
f (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
1) [[a]]
rows)
singleton :: a -> [a]
singleton :: forall a. a -> [a]
singleton = (forall a. a -> [a] -> [a]
:[])
headWithDefault :: a -> [a] -> a
headWithDefault :: forall a. a -> [a] -> a
headWithDefault a
a [] = a
a
headWithDefault a
_ (a
a:[a]
_) = a
a
mapHead :: (a -> a) -> [a] -> [a]
mapHead :: forall a. (a -> a) -> [a] -> [a]
mapHead a -> a
f = \case
[] -> []
a
a:[a]
as -> a -> a
f a
a forall a. a -> [a] -> [a]
: [a]
as
spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd :: forall a. (a -> Bool) -> [a] -> ([a], [a])
spanEnd a -> Bool
p [a]
l = [a] -> [a] -> [a] -> [a] -> ([a], [a])
go [a]
l [] [] [a]
l
where
go :: [a] -> [a] -> [a] -> [a] -> ([a], [a])
go [a]
yes [a]
_ [a]
rev_no [] = ([a]
yes, forall a. [a] -> [a]
reverse [a]
rev_no)
go [a]
yes [a]
rev_yes [a]
rev_no (a
x:[a]
xs)
| a -> Bool
p a
x = [a] -> [a] -> [a] -> [a] -> ([a], [a])
go [a]
yes (a
x forall a. a -> [a] -> [a]
: [a]
rev_yes) [a]
rev_no [a]
xs
| Bool
otherwise = [a] -> [a] -> [a] -> [a] -> ([a], [a])
go [a]
xs [] (a
x forall a. a -> [a] -> [a]
: [a]
rev_yes forall a. [a] -> [a] -> [a]
++ [a]
rev_no) [a]
xs
replace :: Eq a =>
a
-> a
-> [a] -> [a]
replace :: forall a. Eq a => a -> a -> [a] -> [a]
replace a
x a
y [a]
xs = [ if a
z forall a. Eq a => a -> a -> Bool
== a
x then a
y else a
z | a
z <- [a]
xs]
duplicatesOn :: (Foldable t, Ord b) => (a -> b) -> t a -> [List1 a]
duplicatesOn :: forall (t :: * -> *) b a.
(Foldable t, Ord b) =>
(a -> b) -> t a -> [List1 a]
duplicatesOn a -> b
nf
= forall a. (a -> Bool) -> [a] -> [a]
filter ((Int
2 forall a. Ord a => a -> a -> Bool
<=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> Int
List1.length)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr (\ a
a -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) (a -> b
nf a
a) (a
a forall a. a -> [a] -> NonEmpty a
:| [])) forall k a. Map k a
Map.empty
groupOn :: Eq b => (a -> b) -> [a] -> [List1 a]
groupOn :: forall b a. Eq b => (a -> b) -> [a] -> [List1 a]
groupOn a -> b
nf = [a] -> [NonEmpty a]
loop
where
loop :: [a] -> [NonEmpty a]
loop = \case
[] -> []
a
a:[a]
xs | let ([a]
as, [a]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((a -> b
nf a
a forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
nf) [a]
xs
-> (a
a forall a. a -> [a] -> NonEmpty a
:| [a]
as) forall a. a -> [a] -> [a]
: [a] -> [NonEmpty a]
loop [a]
rest
uniqOn :: Eq b => (a -> b) -> [a] -> [a]
uniqOn :: forall b a. Eq b => (a -> b) -> [a] -> [a]
uniqOn a -> b
nf = forall a b. (a -> b) -> [a] -> [b]
map forall a. NonEmpty a -> a
List1.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Eq b => (a -> b) -> [a] -> [List1 a]
groupOn a -> b
nf
hasNumericSuffix :: String -> Maybe (String, Integer)
hasNumericSuffix :: String -> Maybe (String, Integer)
hasNumericSuffix String
s = case forall a. (a -> Bool) -> [a] -> ([a], [a])
spanEnd Char -> Bool
isDigit String
s of
([], String
_) -> forall a. Maybe a
Nothing
(String
num, String
front) -> forall a. a -> Maybe a
Just (String
front, forall a. Read a => String -> a
read String
num)
truncateZonedTimeToSeconds :: ZonedTime -> ZonedTime
truncateZonedTimeToSeconds :: ZonedTime -> ZonedTime
truncateZonedTimeToSeconds (ZonedTime (LocalTime Day
day (TimeOfDay Int
h Int
m Pico
s)) TimeZone
zone) =
LocalTime -> TimeZone -> ZonedTime
ZonedTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
day (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sec)) TimeZone
zone
where
sec :: Int
sec :: Int
sec = forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
s
getZonedTimeTruncatedToSeconds :: IO ZonedTime
getZonedTimeTruncatedToSeconds :: IO ZonedTime
getZonedTimeTruncatedToSeconds = ZonedTime -> ZonedTime
truncateZonedTimeToSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime
writeFileRep :: FilePath -> String -> IO ()
writeFileRep :: String -> String -> IO ()
writeFileRep String
path String
s =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {p}. p -> IO ()
newFile String -> IO ()
updateFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> IO (Either IOError a)
tryIOError (String -> IO String
readFile' String
path)
where
newFile :: p -> IO ()
newFile p
_ = do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"writing new file " forall a. [a] -> [a] -> [a]
++ String
path
String -> String -> IO ()
writeFile String
path String
s
updateFile :: String -> IO ()
updateFile String
old = do
String -> String -> IO ()
writeFile String
path String
s
if String
s forall a. Eq a => a -> a -> Bool
== String
old
then do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"refreshing unchanged file " forall a. [a] -> [a] -> [a]
++ String
path
else do
let bak :: String
bak = String
path forall a. [a] -> [a] -> [a]
++ String
".bak"
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"writing file " forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
" (saving old file as " forall a. [a] -> [a] -> [a]
++ String
bak forall a. [a] -> [a] -> [a]
++ String
")"
String -> String -> IO ()
writeFile String
bak String
old
readFile' :: FilePath -> IO String
readFile' :: String -> IO String
readFile' String
path' = do
Handle
inFile <- String -> IOMode -> IO Handle
openFile String
path' IOMode
ReadMode
String
contents <- Handle -> IO String
hGetContents Handle
inFile
forall a. NFData a => a -> ()
rnf String
contents seq :: forall a b. a -> b -> b
`seq` Handle -> IO ()
hClose Handle
inFile
forall (m :: * -> *) a. Monad m => a -> m a
return String
contents
data NameStyle
= LowerCase
| UpperCase
| SnakeCase
| CamelCase
| MixedCase
| OrigCase
deriving (Int -> NameStyle -> String -> String
[NameStyle] -> String -> String
NameStyle -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NameStyle] -> String -> String
$cshowList :: [NameStyle] -> String -> String
show :: NameStyle -> String
$cshow :: NameStyle -> String
showsPrec :: Int -> NameStyle -> String -> String
$cshowsPrec :: Int -> NameStyle -> String -> String
Show, NameStyle -> NameStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameStyle -> NameStyle -> Bool
$c/= :: NameStyle -> NameStyle -> Bool
== :: NameStyle -> NameStyle -> Bool
$c== :: NameStyle -> NameStyle -> Bool
Eq)
mkName :: [String] -> NameStyle -> String -> String
mkName :: [String] -> NameStyle -> String -> String
mkName [String]
reserved NameStyle
style String
s = String -> String
notReserved String
name'
where
notReserved :: String -> String
notReserved String
name
| String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reserved = String -> String
notReserved (String
name forall a. [a] -> [a] -> [a]
++ String
"_")
| Bool
otherwise = String
name
tokens :: [String]
tokens = String -> [String]
parseIdent String
s
name' :: String
name' = case NameStyle
style of
NameStyle
LowerCase -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
tokens
NameStyle
UpperCase -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
tokens
NameStyle
CamelCase -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
capitalize [String]
tokens
NameStyle
MixedCase -> forall a. (a -> a) -> [a] -> [a]
mapHead Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
capitalize [String]
tokens
NameStyle
SnakeCase -> forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"_" [String]
tokens
NameStyle
OrigCase -> String
s
capitalize :: String -> String
capitalize = forall a. (a -> a) -> [a] -> [a]
mapHead Char -> Char
toUpper
mkNames :: [String] -> NameStyle -> [String] -> [String]
mkNames :: [String] -> NameStyle -> [String] -> [String]
mkNames [String]
reserved NameStyle
style = [String] -> [String]
disambiguateNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String] -> NameStyle -> String -> String
mkName [String]
reserved NameStyle
style)
disambiguateNames :: [String] -> [String]
disambiguateNames :: [String] -> [String]
disambiguateNames = [String] -> [String] -> [String]
disamb []
where
disamb :: [String] -> [String] -> [String]
disamb [String]
ns1 (String
n:[String]
ns2)
| String
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([String]
ns1 forall a. [a] -> [a] -> [a]
++ [String]
ns2) = let i :: Int
i = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
==String
n) [String]
ns1) forall a. Num a => a -> a -> a
+ Int
1
in (String
n forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i) forall a. a -> [a] -> [a]
: [String] -> [String] -> [String]
disamb (String
nforall a. a -> [a] -> [a]
:[String]
ns1) [String]
ns2
| Bool
otherwise = String
n forall a. a -> [a] -> [a]
: [String] -> [String] -> [String]
disamb (String
nforall a. a -> [a] -> [a]
:[String]
ns1) [String]
ns2
disamb [String]
_ [] = []
parseIdent :: String -> [String]
parseIdent :: String -> [String]
parseIdent = String -> [(CharClass, Char)] -> [String]
p [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Char -> CharClass
classify forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)
where
classify :: Char -> CharClass
classify :: Char -> CharClass
classify Char
c
| Char -> Bool
isUpper Char
c = CharClass
U
| Char -> Bool
isLower Char
c = CharClass
L
| Bool
otherwise = CharClass
O
p :: String -> [(CharClass,Char)] -> [String]
p :: String -> [(CharClass, Char)] -> [String]
p String
acc [] = String -> [String] -> [String]
emit String
acc []
p String
acc ((CharClass
L,Char
c) : cs :: [(CharClass, Char)]
cs@((CharClass
L,Char
_) : [(CharClass, Char)]
_)) = String -> [(CharClass, Char)] -> [String]
p (Char
cforall a. a -> [a] -> [a]
:String
acc) [(CharClass, Char)]
cs
p String
acc ((CharClass
U,Char
c) : cs :: [(CharClass, Char)]
cs@((CharClass
U,Char
_) : [(CharClass, Char)]
_)) = String -> [(CharClass, Char)] -> [String]
p (Char
cforall a. a -> [a] -> [a]
:String
acc) [(CharClass, Char)]
cs
p String
acc ((CharClass
U,Char
c) : cs :: [(CharClass, Char)]
cs@((CharClass
L,Char
_) : [(CharClass, Char)]
_)) = String -> [String] -> [String]
emit String
acc forall a b. (a -> b) -> a -> b
$ String -> [(CharClass, Char)] -> [String]
p [Char
c] [(CharClass, Char)]
cs
p String
acc ((CharClass
L,Char
c) : cs :: [(CharClass, Char)]
cs@((CharClass
U,Char
_) : [(CharClass, Char)]
_)) = String -> [String] -> [String]
emit (Char
cforall a. a -> [a] -> [a]
:String
acc) forall a b. (a -> b) -> a -> b
$ String -> [(CharClass, Char)] -> [String]
p [] [(CharClass, Char)]
cs
p String
acc ((CharClass
U,Char
c) : (CharClass
O,Char
_) : [(CharClass, Char)]
cs) = String -> [String] -> [String]
emit (Char
cforall a. a -> [a] -> [a]
:String
acc) forall a b. (a -> b) -> a -> b
$ String -> [(CharClass, Char)] -> [String]
p [] [(CharClass, Char)]
cs
p String
acc ((CharClass
L,Char
c) : (CharClass
O,Char
_) : [(CharClass, Char)]
cs) = String -> [String] -> [String]
emit (Char
cforall a. a -> [a] -> [a]
:String
acc) forall a b. (a -> b) -> a -> b
$ String -> [(CharClass, Char)] -> [String]
p [] [(CharClass, Char)]
cs
p String
acc ((CharClass
O,Char
_) : [(CharClass, Char)]
cs) = String -> [String] -> [String]
emit String
acc forall a b. (a -> b) -> a -> b
$ String -> [(CharClass, Char)] -> [String]
p [] [(CharClass, Char)]
cs
p String
acc [(CharClass
_,Char
c)] = String -> [(CharClass, Char)] -> [String]
p (Char
cforall a. a -> [a] -> [a]
:String
acc) []
emit :: String -> [String] -> [String]
emit :: String -> [String] -> [String]
emit [] [String]
rest = [String]
rest
emit String
acc [String]
rest = forall a. [a] -> [a]
reverse String
acc forall a. a -> [a] -> [a]
: [String]
rest
data CharClass = U | L | O
lowerCase :: String -> Doc
lowerCase :: String -> Doc
lowerCase = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> NameStyle -> String -> String
mkName [] NameStyle
LowerCase
upperCase :: String -> Doc
upperCase :: String -> Doc
upperCase = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> NameStyle -> String -> String
mkName [] NameStyle
UpperCase
camelCase :: String -> Doc
camelCase :: String -> Doc
camelCase = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
camelCase_
camelCase_ :: String -> String
camelCase_ :: String -> String
camelCase_ = [String] -> NameStyle -> String -> String
mkName [] NameStyle
CamelCase
mixedCase :: String -> Doc
mixedCase :: String -> Doc
mixedCase = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> NameStyle -> String -> String
mkName [] NameStyle
MixedCase
snakeCase :: String -> Doc
snakeCase :: String -> Doc
snakeCase = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
snakeCase_
snakeCase_ :: String -> String
snakeCase_ :: String -> String
snakeCase_ = [String] -> NameStyle -> String -> String
mkName [] NameStyle
SnakeCase
cstring :: String -> Doc
cstring :: String -> Doc
cstring = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
symbolToName :: String -> Maybe String
symbolToName :: String -> Maybe String
symbolToName = (forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map String String
symbolTokenMap)
symbolTokenMap :: Map String String
symbolTokenMap :: Map String String
symbolTokenMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, String)]
symbolTokenList
symbolTokenList :: [(String, String)]
symbolTokenList :: [(String, String)]
symbolTokenList =
[ (String
"{" , String
"LBRACE")
, (String
"}" , String
"RBRACE")
, (String
"(" , String
"LPAREN")
, (String
")" , String
"RPAREN")
, (String
"[" , String
"LBRACK")
, (String
"]" , String
"RBRACK")
, (String
"[]" , String
"EMPTYBRACK")
, (String
"." , String
"DOT")
, (String
".." , String
"DDOT")
, (String
"...", String
"ELLIPSIS")
, (String
"," , String
"COMMA")
, (String
",," , String
"DCOMMA")
, (String
";" , String
"SEMI")
, (String
";;" , String
"DSEMI")
, (String
":" , String
"COLON")
, (String
"::" , String
"DCOLON")
, (String
":=" , String
"COLONEQ")
, (String
"::=", String
"DCOLONEQ")
, (String
":-" , String
"COLONMINUS")
, (String
"::-", String
"DCOLONMINUS")
, (String
":--", String
"COLONDMINUS")
, (String
"+" , String
"PLUS")
, (String
"++" , String
"DPLUS")
, (String
"+=" , String
"PLUSEQ")
, (String
"+-" , String
"PLUSMINUS")
, (String
"-" , String
"MINUS")
, (String
"--" , String
"DMINUS")
, (String
"-=" , String
"MINUSEQ")
, (String
"-+" , String
"MINUSPLUS")
, (String
"-*" , String
"MINUSSTAR")
, (String
"*" , String
"STAR")
, (String
"**" , String
"DSTAR")
, (String
"*=" , String
"STAREQ")
, (String
"*-" , String
"STARMINUS")
, (String
"/" , String
"SLASH")
, (String
"//" , String
"DSLASH")
, (String
"/=" , String
"SLASHEQ")
, (String
"\\" , String
"BACKSLASH")
, (String
"\\\\",String
"DBACKSLASH")
, (String
"/\\", String
"WEDGE")
, (String
"\\/", String
"VEE")
, (String
"&" , String
"AMP")
, (String
"&&" , String
"DAMP")
, (String
"&=" , String
"AMPEQ")
, (String
"|" , String
"BAR")
, (String
"||" , String
"DBAR")
, (String
"|=" , String
"BAREQ")
, (String
"<" , String
"LT")
, (String
"<<" , String
"DLT")
, (String
"<<<", String
"TLT")
, (String
"<=" , String
"LTEQ")
, (String
"<<=", String
"DLTEQ")
, (String
"<<<=",String
"TLTEQ")
, (String
">" , String
"GT")
, (String
">>" , String
"DGT")
, (String
">>>", String
"TGT")
, (String
">=" , String
"GTEQ")
, (String
">>=", String
"DGTEQ")
, (String
">>>=",String
"TGTEQ")
, (String
"<>" , String
"LTGT")
, (String
"=" , String
"EQ")
, (String
"==" , String
"DEQ")
, (String
"_" , String
"UNDERSCORE")
, (String
"!" , String
"BANG")
, (String
"!=" , String
"BANGEQ")
, (String
"?" , String
"QUESTION")
, (String
"?=" , String
"QUESTIONEQ")
, (String
"#" , String
"HASH")
, (String
"##" , String
"DHASH")
, (String
"###", String
"THASH")
, (String
"@" , String
"AT")
, (String
"@@" , String
"DAT")
, (String
"@=" , String
"ATEQ")
, (String
"$" , String
"DOLLAR")
, (String
"$$" , String
"DDOLLAR")
, (String
"%" , String
"PERCENT")
, (String
"%%" , String
"DPERCENT")
, (String
"%=" , String
"PERCENTEQ")
, (String
"^" , String
"CARET")
, (String
"^^" , String
"DCARET")
, (String
"^=" , String
"CARETEQ")
, (String
"~" , String
"TILDE")
, (String
"~~" , String
"DTILDE")
, (String
"~=" , String
"TILDEEQ")
, (String
"'" , String
"APOSTROPHE")
, (String
"''" , String
"DAPOSTROPHE")
, (String
"'''", String
"TAPOSTROPHE")
, (String
"<-" , String
"LARROW")
, (String
"->" , String
"RARROW")
, (String
"<=" , String
"LDARROW")
, (String
"=>" , String
"RDARROW")
, (String
"|->", String
"MAPSTO")
]