1- {-# LANGUAGE CPP #-}
2- {-# LANGUAGE ViewPatterns #-}
1+ {-# LANGUAGE CPP #-}
2+ {-# LANGUAGE DerivingStrategies #-}
33module Ide.Plugin.Conversion (
44 alternateFormat
5- , hexRegex
6- , hexFloatRegex
7- , binaryRegex
8- , octalRegex
9- , decimalRegex
10- , numDecimalRegex
11- , matchLineRegex
125 , toOctal
136 , toDecimal
147 , toBinary
158 , toHex
169 , toFloatDecimal
1710 , toFloatExpDecimal
1811 , toHexFloat
12+ , intFormats
13+ , fracFormats
1914 , AlternateFormat
2015 , ExtensionNeeded (.. )
16+ , FormatType (.. )
17+ , IntFormatType (.. )
18+ , FracFormatType (.. )
19+ , UnderscoreFormatType (.. )
2120) where
2221
23- import Data.List (delete )
24- import Data.List.Extra (enumerate , upper )
25- import Data.Maybe (mapMaybe )
22+ import Data.List (intercalate )
23+ import Data.List.Extra (chunksOf , enumerate , nubOrdOn ,
24+ upper )
25+ import qualified Data.Map as Map
2626import Data.Ratio (denominator , numerator )
2727import Data.Text (Text )
2828import qualified Data.Text as T
2929import Development.IDE.Graph.Classes (NFData )
3030import GHC.Generics (Generic )
3131import GHC.LanguageExtensions.Type (Extension (.. ))
32- import GHC.Show (intToDigit )
3332import Ide.Plugin.Literals (Literal (.. ), getSrcText )
3433import Numeric
35- import Text.Regex.TDFA ((=~) )
3634
3735data FormatType = IntFormat IntFormatType
3836 | FracFormat FracFormatType
@@ -46,142 +44,130 @@ data IntFormatType = IntDecimalFormat
4644 | OctalFormat
4745 | BinaryFormat
4846 | NumDecimalFormat
49- deriving (Show , Eq , Generic , Bounded , Enum )
47+ deriving (Show , Eq , Generic , Ord , Bounded , Enum )
5048
5149instance NFData IntFormatType
5250
5351data FracFormatType = FracDecimalFormat
5452 | HexFloatFormat
5553 | ExponentFormat
56- deriving (Show , Eq , Generic , Bounded , Enum )
54+ deriving (Show , Eq , Generic , Ord , Bounded , Enum )
5755
5856instance NFData FracFormatType
5957
60- data ExtensionNeeded = NoExtension
61- | NeedsExtension Extension
58+ newtype ExtensionNeeded = ExtensionNeeded [ Extension ]
59+ deriving newtype ( Semigroup , Monoid )
6260
6361type AlternateFormat = (Text , ExtensionNeeded )
6462
6563-- | Generate alternate formats for a single Literal based on FormatType's given.
6664alternateFormat :: Literal -> [AlternateFormat ]
67- alternateFormat lit = case lit of
68- IntLiteral _ _ val -> map (alternateIntFormat val) (removeCurrentFormatInt lit)
65+ alternateFormat lit = nubOrdOn fst $ removeIdentical $ case lit of
66+ IntLiteral _ _ val -> alternateIntFormatsOf id val
6967 FracLiteral _ _ val -> if denominator val == 1 -- floats that can be integers we can represent as ints
70- then map (alternateIntFormat (numerator val)) (removeCurrentFormatInt lit)
71- else map (alternateFracFormat val) (removeCurrentFormatFrac lit)
72-
73- alternateIntFormat :: Integer -> IntFormatType -> AlternateFormat
74- alternateIntFormat val = \ case
75- IntDecimalFormat -> (T. pack $ toDecimal val, NoExtension )
76- HexFormat -> (T. pack $ toHex val, NoExtension )
77- OctalFormat -> (T. pack $ toOctal val, NoExtension )
78- BinaryFormat -> (T. pack $ toBinary val, NeedsExtension BinaryLiterals )
79- NumDecimalFormat -> (T. pack $ toFloatExpDecimal (fromInteger @ Double NeedsExtension NumDecimals )
80-
81- alternateFracFormat :: Rational -> FracFormatType -> AlternateFormat
82- alternateFracFormat val = \ case
83- FracDecimalFormat -> (T. pack $ toFloatDecimal (fromRational @ Double NoExtension )
84- ExponentFormat -> (T. pack $ toFloatExpDecimal (fromRational @ Double NoExtension )
85- HexFloatFormat -> (T. pack $ toHexFloat (fromRational @ Double NeedsExtension HexFloatLiterals )
86-
87- -- given a Literal compute it's current Format and delete it from the list of available formats
88- removeCurrentFormat :: (Foldable t , Eq a ) => [a ] -> t a -> [a ]
89- removeCurrentFormat fmts toRemove = foldl (flip delete) fmts toRemove
90-
91- removeCurrentFormatInt :: Literal -> [IntFormatType ]
92- removeCurrentFormatInt (getSrcText -> srcText) = removeCurrentFormat intFormats (filterIntFormats $ sourceToFormatType srcText)
93-
94- removeCurrentFormatFrac :: Literal -> [FracFormatType ]
95- removeCurrentFormatFrac (getSrcText -> srcText) = removeCurrentFormat fracFormats (filterFracFormats $ sourceToFormatType srcText)
96-
97- filterIntFormats :: [FormatType ] -> [IntFormatType ]
98- filterIntFormats = mapMaybe getIntFormat
99- where
100- getIntFormat (IntFormat f) = Just f
101- getIntFormat _ = Nothing
102-
103- filterFracFormats :: [FormatType ] -> [FracFormatType ]
104- filterFracFormats = mapMaybe getFracFormat
105- where
106- getFracFormat (FracFormat f) = Just f
107- getFracFormat _ = Nothing
108-
109- intFormats :: [IntFormatType ]
110- intFormats = enumerate
111-
112- fracFormats :: [FracFormatType ]
113- fracFormats = enumerate
114-
115- -- | Regex to match a Haskell Hex Literal
116- hexRegex :: Text
117- hexRegex = " 0[xX][a-fA-F0-9]+"
118-
119- -- | Regex to match a Haskell Hex Float Literal
120- hexFloatRegex :: Text
121- hexFloatRegex = " 0[xX][a-fA-F0-9]+(\\ .)?[a-fA-F0-9]*(p[+-]?[0-9]+)?"
122-
123- -- | Regex to match a Haskell Binary Literal
124- binaryRegex :: Text
125- binaryRegex = " 0[bB][0|1]+"
126-
127- -- | Regex to match a Haskell Octal Literal
128- octalRegex :: Text
129- octalRegex = " 0[oO][0-8]+"
130-
131- -- | Regex to match a Haskell Decimal Literal (no decimal points)
132- decimalRegex :: Text
133- decimalRegex = " [0-9]+(\\ .[0-9]+)?"
134-
135- -- | Regex to match a Haskell Literal with an explicit exponent
136- numDecimalRegex :: Text
137- numDecimalRegex = " [0-9]+\\ .[0-9]+[eE][+-]?[0-9]+"
138-
139- -- we want to be explicit in our matches
140- -- so we need to match the beginning/end of the source text
141- -- | Wraps a Regex with a beginning ("^") and end ("$") token
142- matchLineRegex :: Text -> Text
143- matchLineRegex regex = " ^" <> regex <> " $"
144-
145- sourceToFormatType :: Text -> [FormatType ]
146- sourceToFormatType srcText
147- | srcText =~ matchLineRegex hexRegex = [IntFormat HexFormat ]
148- | srcText =~ matchLineRegex hexFloatRegex = [FracFormat HexFloatFormat ]
149- | srcText =~ matchLineRegex octalRegex = [IntFormat OctalFormat ]
150- | srcText =~ matchLineRegex binaryRegex = [IntFormat BinaryFormat ]
151- -- can either be a NumDecimal or just a regular Fractional with an exponent
152- -- otherwise we wouldn't need to return a list
153- | srcText =~ matchLineRegex numDecimalRegex = [IntFormat NumDecimalFormat , FracFormat ExponentFormat ]
154- -- just assume we are in base 10 with no decimals
155- | otherwise = [IntFormat IntDecimalFormat , FracFormat FracDecimalFormat ]
156-
157- toBase :: (Num a , Ord a ) => (a -> ShowS -> String -> a -> String
158- toBase conv header n
159- | n < 0 = ' -' : header <> upper (conv (abs n) " "
160- | otherwise = header <> upper (conv n " "
161-
162- #if MIN_VERSION_base(4,17,0)
163- toOctal , toBinary , toHex :: Integral a => a -> String
164- #else
165- toOctal , toBinary , toHex :: (Integral a , Show a ) => a -> String
166- #endif
167-
168- toBinary = toBase showBin_ " 0b"
68+ then alternateIntFormatsOf numerator val
69+ else alternateFracFormatsOf val
16970 where
170- -- this is not defined in base < 4.16
171- showBin_ = showIntAtBase 2 intToDigit
172-
173- toOctal = toBase showOct " 0o"
174-
175- toHex = toBase showHex " 0x"
176-
177- toDecimal :: Integral a => a -> String
178- toDecimal = toBase showInt " "
179-
180- toFloatDecimal :: RealFloat a => a -> String
181- toFloatDecimal val = showFFloat Nothing val " "
182-
183- toFloatExpDecimal :: RealFloat a => a -> String
184- toFloatExpDecimal val = showEFloat Nothing val " "
185-
186- toHexFloat :: RealFloat a => a -> String
187- toHexFloat val = showHFloat val " "
71+ removeIdentical = filter ((/= getSrcText lit) . fst )
72+ alternateIntFormatsOf with val = [ alternateIntFormat (with val) formatType f | (formatType, formats) <- Map. toList intFormats, f <- formats]
73+ alternateFracFormatsOf val = [ alternateFracFormat val formatType f | (formatType, formats) <- Map. toList fracFormats, f <- formats]
74+
75+ data UnderscoreFormatType
76+ = NoUnderscores
77+ | UseUnderscores Int
78+ deriving (Show , Eq )
79+
80+ underscoreExtensions :: UnderscoreFormatType -> ExtensionNeeded
81+ underscoreExtensions = \ case
82+ NoUnderscores -> mempty
83+ UseUnderscores _ -> ExtensionNeeded [NumericUnderscores ]
84+
85+ alternateIntFormat :: Integer -> IntFormatType -> UnderscoreFormatType -> AlternateFormat
86+ alternateIntFormat val formatType underscoreFormat = case formatType of
87+ IntDecimalFormat -> (T. pack $ toDecimal underscoreFormat val, underscoreExtensions underscoreFormat)
88+ HexFormat -> (T. pack $ toHex underscoreFormat val, underscoreExtensions underscoreFormat)
89+ OctalFormat -> (T. pack $ toOctal underscoreFormat val, underscoreExtensions underscoreFormat)
90+ BinaryFormat -> (T. pack $ toBinary underscoreFormat val, underscoreExtensions underscoreFormat <> ExtensionNeeded [BinaryLiterals ])
91+ NumDecimalFormat -> (T. pack $ toFloatExpDecimal underscoreFormat (fromInteger @ Double <> ExtensionNeeded [NumDecimals ])
92+
93+ alternateFracFormat :: Rational -> FracFormatType -> UnderscoreFormatType -> AlternateFormat
94+ alternateFracFormat val formatType underscoreFormat = case formatType of
95+ FracDecimalFormat -> (T. pack $ toFloatDecimal underscoreFormat (fromRational @ Double mempty )
96+ ExponentFormat -> (T. pack $ toFloatExpDecimal underscoreFormat (fromRational @ Double mempty )
97+ HexFloatFormat -> (T. pack $ toHexFloat underscoreFormat (fromRational @ Double <> ExtensionNeeded [HexFloatLiterals ])
98+
99+ intFormats :: Map. MapIntFormatType [UnderscoreFormatType ]
100+ intFormats = Map. fromList $ map (\ t -> (t, intFormatUnderscore t)) enumerate
101+
102+ intFormatUnderscore :: IntFormatType -> [UnderscoreFormatType ]
103+ intFormatUnderscore formatType = NoUnderscores : map UseUnderscores (case formatType of
104+ IntDecimalFormat -> [3 , 4 ]
105+ HexFormat -> [2 , 4 ]
106+ OctalFormat -> [2 , 4 , 8 ]
107+ BinaryFormat -> [4 ]
108+ NumDecimalFormat -> [3 , 4 ])
109+
110+ fracFormats :: Map. MapFracFormatType [UnderscoreFormatType ]
111+ fracFormats = Map. fromList $ map (\ t -> (t, fracFormatUnderscore t)) enumerate
112+
113+ fracFormatUnderscore :: FracFormatType -> [UnderscoreFormatType ]
114+ fracFormatUnderscore formatType = NoUnderscores : map UseUnderscores (case formatType of
115+ FracDecimalFormat -> [3 , 4 ]
116+ ExponentFormat -> [3 , 4 ]
117+ HexFloatFormat -> [2 , 4 ])
118+
119+ addMinus :: (Ord n , Num n ) => (n -> String -> n -> String
120+ addMinus f n
121+ | n < 0 = ' -' : f (abs n)
122+ | otherwise = f n
123+
124+ toBase :: (a -> ShowS -> a -> String
125+ toBase conv n = upper (conv n " "
126+
127+ toBaseFmt :: (Ord a , Num a ) => (a -> ShowS -> [Char -> UnderscoreFormatType -> a -> [Char
128+ toBaseFmt conv header underscoreFormat = addMinus $ \ val ->
129+ header ++ addUnderscoresInt underscoreFormat (toBase conv val)
130+
131+ toBinary :: Integral a => UnderscoreFormatType -> a -> String
132+ toBinary = toBaseFmt showBin " 0b"
133+
134+ toOctal :: Integral a => UnderscoreFormatType -> a -> String
135+ toOctal = toBaseFmt showOct " 0o"
136+
137+ toHex :: Integral a => UnderscoreFormatType -> a -> String
138+ toHex = toBaseFmt showHex " 0x"
139+
140+ toDecimal :: Integral a => UnderscoreFormatType -> a -> String
141+ toDecimal = toBaseFmt showInt " "
142+
143+ addUnderscoresInt :: UnderscoreFormatType -> String -> String
144+ addUnderscoresInt = \ case
145+ NoUnderscores -> id
146+ -- Chunk starting from the least significant numeral.
147+ UseUnderscores n -> reverse . intercalate " _" . chunksOf n . reverse
148+
149+ toFracFormat :: (Ord t , Num t ) => (t -> String -> String -> UnderscoreFormatType -> t -> String
150+ toFracFormat f header underScoreFormat = addMinus $ \ val ->
151+ header <> addUnderscoresFloat underScoreFormat (f val)
152+
153+ toFloatDecimal :: RealFloat a => UnderscoreFormatType -> a -> String
154+ toFloatDecimal = toFracFormat (\ v -> showFFloat Nothing (abs v) " " " "
155+
156+ toFloatExpDecimal :: RealFloat a => UnderscoreFormatType -> a -> String
157+ toFloatExpDecimal underscoreFormat val =
158+ let (n, e) = break (== ' e' $ showEFloat Nothing (abs val) " "
159+ in toFracFormat (const n) " " <> e
160+
161+ toHexFloat :: RealFloat a => UnderscoreFormatType -> a -> String
162+ toHexFloat underscoreFormat val =
163+ let (header, n) = splitAt 2 $ showHFloat (abs val) " "
164+ (n', e) = break (== ' p'
165+ in toFracFormat (const n') header underscoreFormat val <> e
166+
167+ addUnderscoresFloat :: UnderscoreFormatType -> String -> String
168+ addUnderscoresFloat = \ case
169+ NoUnderscores -> id
170+ UseUnderscores n -> \ s ->
171+ let (integral, decimal) = break (== ' .'
172+ addUnderscores = reverse . intercalate " _" . chunksOf n . reverse
173+ in intercalate " ." " _" $ chunksOf n $ drop 1 decimal]
![mergify[bot]](https://avatars.githubusercontent.com/in/10562?v=4&size=40){kind=avatar}
0 commit comments