Skip to content

Commit 2fdc5bb

Browse files
crtschincrtschin
committed
Emit underscore formatted literals
1 parent 51721ef commit 2fdc5bb

File tree

1 file changed

+93
-125
lines changed
  • plugins/hls-alternate-number-format-plugin/src/Ide/Plugin

1 file changed

+93
-125
lines changed

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Conversion.hs‎

Lines changed: 93 additions & 125 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,6 @@
1-
{-# LANGUAGE CPP #-}
2-
{-# LANGUAGE ViewPatterns #-}
1+
{-# LANGUAGE CPP #-}
32
module Ide.Plugin.Conversion (
43
alternateFormat
5-
, hexRegex
6-
, hexFloatRegex
7-
, binaryRegex
8-
, octalRegex
9-
, decimalRegex
10-
, numDecimalRegex
11-
, matchLineRegex
124
, toOctal
135
, toDecimal
146
, toBinary
@@ -20,22 +12,24 @@ module Ide.Plugin.Conversion (
2012
, fracFormats
2113
, AlternateFormat
2214
, ExtensionNeeded(..)
15+
, FormatType(..)
16+
, IntFormatType(..)
17+
, FracFormatType(..)
2318
, UnderscoreFormatType(..)
2419
) where
2520

26-
import Data.List (delete)
27-
import Data.List.Extra (enumerate, upper)
28-
import Data.Maybe (mapMaybe)
21+
import Data.List (intercalate)
22+
import Data.List.Extra (chunksOf, enumerate, nubOrdOn,
23+
upper)
24+
import qualified Data.Map as Map
2925
import Data.Ratio (denominator, numerator)
3026
import Data.Text (Text)
3127
import qualified Data.Text as T
3228
import Development.IDE.Graph.Classes (NFData)
3329
import GHC.Generics (Generic)
3430
import GHC.LanguageExtensions.Type (Extension (..))
35-
import GHC.Show (intToDigit)
3631
import Ide.Plugin.Literals (Literal (..), getSrcText)
3732
import Numeric
38-
import Text.Regex.TDFA ((=~))
3933

4034
data FormatType = IntFormat IntFormatType
4135
| FracFormat FracFormatType
@@ -49,14 +43,14 @@ data IntFormatType = IntDecimalFormat
4943
| OctalFormat
5044
| BinaryFormat
5145
| NumDecimalFormat
52-
deriving (Show, Eq, Generic, Bounded, Enum)
46+
deriving (Show, Eq, Generic, Ord, Bounded, Enum)
5347

5448
instance NFData IntFormatType
5549

5650
data FracFormatType = FracDecimalFormat
5751
| HexFloatFormat
5852
| ExponentFormat
59-
deriving (Show, Eq, Generic, Bounded, Enum)
53+
deriving (Show, Eq, Generic, Ord, Bounded, Enum)
6054

6155
instance NFData FracFormatType
6256

@@ -67,122 +61,34 @@ type AlternateFormat = (Text, ExtensionNeeded)
6761

6862
-- | Generate alternate formats for a single Literal based on FormatType's given.
6963
alternateFormat :: Literal -> [AlternateFormat]
70-
alternateFormat lit = case lit of
71-
IntLiteral _ _ val -> map (alternateIntFormat val) (removeCurrentFormatInt lit)
64+
alternateFormat lit = nubOrdOn fst $ removeIdentical $ case lit of
65+
IntLiteral _ _ val -> alternateIntFormatsOf id val
7266
FracLiteral _ _ val -> if denominator val == 1 -- floats that can be integers we can represent as ints
73-
then map (alternateIntFormat (numerator val)) (removeCurrentFormatInt lit)
74-
else map (alternateFracFormat val) (removeCurrentFormatFrac lit)
75-
76-
alternateIntFormat :: Integer -> IntFormatType -> AlternateFormat
77-
alternateIntFormat val = \case
78-
IntDecimalFormat -> (T.pack $ toDecimal val, NoExtension)
79-
HexFormat -> (T.pack $ toHex val, NoExtension)
80-
OctalFormat -> (T.pack $ toOctal val, NoExtension)
81-
BinaryFormat -> (T.pack $ toBinary val, NeedsExtension BinaryLiterals)
82-
NumDecimalFormat -> (T.pack $ toFloatExpDecimal (fromInteger @Double val), NeedsExtension NumDecimals)
83-
84-
alternateFracFormat :: Rational -> FracFormatType -> AlternateFormat
85-
alternateFracFormat val = \case
86-
FracDecimalFormat -> (T.pack $ toFloatDecimal (fromRational @Double val), NoExtension)
87-
ExponentFormat -> (T.pack $ toFloatExpDecimal (fromRational @Double val), NoExtension)
88-
HexFloatFormat -> (T.pack $ toHexFloat (fromRational @Double val), NeedsExtension HexFloatLiterals)
89-
90-
-- given a Literal compute it's current Format and delete it from the list of available formats
91-
removeCurrentFormat :: (Foldable t, Eq a) => [a] -> t a -> [a]
92-
removeCurrentFormat fmts toRemove = foldl (flip delete) fmts toRemove
93-
94-
removeCurrentFormatInt :: Literal -> [IntFormatType]
95-
removeCurrentFormatInt (getSrcText -> srcText) = removeCurrentFormat intFormats (filterIntFormats $ sourceToFormatType srcText)
96-
97-
removeCurrentFormatFrac :: Literal -> [FracFormatType]
98-
removeCurrentFormatFrac (getSrcText -> srcText) = removeCurrentFormat fracFormats (filterFracFormats $ sourceToFormatType srcText)
99-
100-
filterIntFormats :: [FormatType] -> [IntFormatType]
101-
filterIntFormats = mapMaybe getIntFormat
102-
where
103-
getIntFormat (IntFormat f) = Just f
104-
getIntFormat _ = Nothing
105-
106-
filterFracFormats :: [FormatType] -> [FracFormatType]
107-
filterFracFormats = mapMaybe getFracFormat
108-
where
109-
getFracFormat (FracFormat f) = Just f
110-
getFracFormat _ = Nothing
111-
112-
intFormats :: [IntFormatType]
113-
intFormats = enumerate
114-
115-
fracFormats :: [FracFormatType]
116-
fracFormats = enumerate
117-
118-
-- | Regex to match a Haskell Hex Literal
119-
hexRegex :: Text
120-
hexRegex = "0[xX][a-fA-F0-9]+"
121-
122-
-- | Regex to match a Haskell Hex Float Literal
123-
hexFloatRegex :: Text
124-
hexFloatRegex = "0[xX][a-fA-F0-9]+(\\.)?[a-fA-F0-9]*(p[+-]?[0-9]+)?"
125-
126-
-- | Regex to match a Haskell Binary Literal
127-
binaryRegex :: Text
128-
binaryRegex = "0[bB][0|1]+"
129-
130-
-- | Regex to match a Haskell Octal Literal
131-
octalRegex :: Text
132-
octalRegex = "0[oO][0-8]+"
133-
134-
-- | Regex to match a Haskell Decimal Literal (no decimal points)
135-
decimalRegex :: Text
136-
decimalRegex = "[0-9]+(\\.[0-9]+)?"
137-
138-
-- | Regex to match a Haskell Literal with an explicit exponent
139-
numDecimalRegex :: Text
140-
numDecimalRegex = "[0-9]+\\.[0-9]+[eE][+-]?[0-9]+"
141-
142-
-- we want to be explicit in our matches
143-
-- so we need to match the beginning/end of the source text
144-
-- | Wraps a Regex with a beginning ("^") and end ("$") token
145-
matchLineRegex :: Text -> Text
146-
matchLineRegex regex = "^" <> regex <> "$"
147-
148-
sourceToFormatType :: Text -> [FormatType]
149-
sourceToFormatType srcText
150-
| srcText =~ matchLineRegex hexRegex = [IntFormat HexFormat]
151-
| srcText =~ matchLineRegex hexFloatRegex = [FracFormat HexFloatFormat]
152-
| srcText =~ matchLineRegex octalRegex = [IntFormat OctalFormat]
153-
| srcText =~ matchLineRegex binaryRegex = [IntFormat BinaryFormat]
154-
-- can either be a NumDecimal or just a regular Fractional with an exponent
155-
-- otherwise we wouldn't need to return a list
156-
| srcText =~ matchLineRegex numDecimalRegex = [IntFormat NumDecimalFormat, FracFormat ExponentFormat]
157-
-- just assume we are in base 10 with no decimals
158-
| otherwise = [IntFormat IntDecimalFormat, FracFormat FracDecimalFormat]
159-
160-
toBase :: (Num a, Ord a) => (a -> ShowS) -> String -> a -> String
161-
toBase conv header n
162-
| n < 0 = '-' : header <> upper (conv (abs n) "")
163-
| otherwise = header <> upper (conv n "")
164-
165-
#if MIN_VERSION_base(4,17,0)
166-
toOctal, toBinary, toHex :: Integral a => a -> String
167-
#else
168-
toOctal, toBinary, toHex:: (Integral a, Show a) => a -> String
169-
#endif
170-
171-
toBinary = toBase showBin_ "0b"
67+
then alternateIntFormatsOf numerator val
68+
else alternateFracFormatsOf val
17269
where
173-
-- this is not defined in base < 4.16
174-
showBin_ = showIntAtBase 2 intToDigit
70+
removeIdentical = filter ((/= getSrcText lit) . fst)
71+
alternateIntFormatsOf with val = [ alternateIntFormat (with val) formatType f | (formatType, formats) <- Map.toList intFormats, f <- formats]
72+
alternateFracFormatsOf val = [ alternateFracFormat val formatType f | (formatType, formats) <- Map.toList fracFormats, f <- formats]
17573

176-
toOctal = toBase showOct "0o"
17774
data UnderscoreFormatType
17875
= NoUnderscores
17976
| UseUnderscores Int
18077
deriving (Show, Eq)
18178

182-
toHex = toBase showHex "0x"
79+
alternateIntFormat :: Integer -> IntFormatType -> UnderscoreFormatType -> AlternateFormat
80+
alternateIntFormat val formatType underscoreFormat = case formatType of
81+
IntDecimalFormat -> (T.pack $ toDecimal underscoreFormat val , NoExtension)
82+
HexFormat -> (T.pack $ toHex underscoreFormat val , NoExtension)
83+
OctalFormat -> (T.pack $ toOctal underscoreFormat val , NoExtension)
84+
BinaryFormat -> (T.pack $ toBinary underscoreFormat val , NeedsExtension BinaryLiterals)
85+
NumDecimalFormat -> (T.pack $ toFloatExpDecimal underscoreFormat (fromInteger @Double val) , NeedsExtension NumDecimals)
18386

184-
toDecimal :: Integral a => a -> String
185-
toDecimal = toBase showInt ""
87+
alternateFracFormat :: Rational -> FracFormatType -> UnderscoreFormatType -> AlternateFormat
88+
alternateFracFormat val formatType underscoreFormat = case formatType of
89+
FracDecimalFormat -> (T.pack $ toFloatDecimal underscoreFormat (fromRational @Double val), NoExtension)
90+
ExponentFormat -> (T.pack $ toFloatExpDecimal underscoreFormat (fromRational @Double val), NoExtension)
91+
HexFloatFormat -> (T.pack $ toHexFloat underscoreFormat (fromRational @Double val), NeedsExtension HexFloatLiterals)
18692

18793
intFormats :: Map.Map IntFormatType [UnderscoreFormatType]
18894
intFormats = Map.fromList $ map (\t -> (t, intFormatUnderscore t)) enumerate
@@ -195,5 +101,67 @@ intFormatUnderscore formatType = NoUnderscores : map UseUnderscores (case format
195101
BinaryFormat -> [4]
196102
NumDecimalFormat -> [3, 4])
197103

198-
toHexFloat :: RealFloat a => a -> String
199-
toHexFloat val = showHFloat val ""
104+
fracFormats :: Map.Map FracFormatType [UnderscoreFormatType]
105+
fracFormats = Map.fromList $ map (\t -> (t, fracFormatUnderscore t)) enumerate
106+
107+
fracFormatUnderscore :: FracFormatType -> [UnderscoreFormatType]
108+
fracFormatUnderscore formatType = NoUnderscores : map UseUnderscores (case formatType of
109+
FracDecimalFormat -> [3, 4]
110+
ExponentFormat -> [3, 4]
111+
HexFloatFormat -> [2, 4])
112+
113+
addMinus :: (Ord n, Num n) => (n -> String) -> n -> String
114+
addMinus f n
115+
| n < 0 = '-' : f (abs n)
116+
| otherwise = f n
117+
118+
toBase :: (a -> ShowS) -> a -> String
119+
toBase conv n = upper (conv n "")
120+
121+
toBaseFmt :: (Ord a, Num a) => (a -> ShowS) -> [Char] -> UnderscoreFormatType -> a -> [Char]
122+
toBaseFmt conv header underscoreFormat = addMinus $ \val ->
123+
header ++ addUnderscoresInt underscoreFormat (toBase conv val)
124+
125+
toBinary :: Integral a => UnderscoreFormatType -> a -> String
126+
toBinary = toBaseFmt showBin "0b"
127+
128+
toOctal :: Integral a => UnderscoreFormatType -> a -> String
129+
toOctal = toBaseFmt showOct "0o"
130+
131+
toHex :: Integral a => UnderscoreFormatType -> a -> String
132+
toHex = toBaseFmt showHex "0x"
133+
134+
toDecimal :: Integral a => UnderscoreFormatType -> a -> String
135+
toDecimal = toBaseFmt showInt ""
136+
137+
addUnderscoresInt :: UnderscoreFormatType -> String -> String
138+
addUnderscoresInt = \case
139+
NoUnderscores -> id
140+
-- Chunk starting from the least significant numeral.
141+
UseUnderscores n -> reverse . intercalate "_" . chunksOf n . reverse
142+
143+
toFracFormat :: (Ord t, Num t) => (t -> String) -> String -> UnderscoreFormatType -> t -> String
144+
toFracFormat f header underScoreFormat = addMinus $ \val ->
145+
header <> addUnderscoresFloat underScoreFormat (f val)
146+
147+
toFloatDecimal :: RealFloat a => UnderscoreFormatType -> a -> String
148+
toFloatDecimal = toFracFormat (\v -> showFFloat Nothing (abs v) "") ""
149+
150+
toFloatExpDecimal :: RealFloat a => UnderscoreFormatType -> a -> String
151+
toFloatExpDecimal underscoreFormat val =
152+
let (n, e) = break (=='e') $ showEFloat Nothing (abs val) ""
153+
in toFracFormat (const n) "" underscoreFormat val <> e
154+
155+
toHexFloat :: RealFloat a => UnderscoreFormatType -> a -> String
156+
toHexFloat underscoreFormat val =
157+
let (header, n) = splitAt 2 $ showHFloat (abs val) ""
158+
(n', e) = break (=='p') n
159+
in toFracFormat (const n') header underscoreFormat val <> e
160+
161+
addUnderscoresFloat :: UnderscoreFormatType -> String -> String
162+
addUnderscoresFloat = \case
163+
NoUnderscores -> id
164+
UseUnderscores n -> \s ->
165+
let (integral, decimal) = break (=='.') s
166+
addUnderscores = reverse . intercalate "_" . chunksOf n . reverse
167+
in intercalate "." [addUnderscores integral, intercalate "_" $ chunksOf n $ drop 1 decimal]

0 commit comments

Comments
 (0)