{-# language DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric #-}
{-# language InstanceSigs, ScopedTypeVariables, TypeApplications #-}
{-# language LambdaCase #-}
{-# language TemplateHaskell #-}
module Language.Python.Syntax.Numbers
(
IntLiteral(..)
, Sign(..)
, E(..)
, FloatExponent(..)
, FloatLiteral(..)
, ImagLiteral(..)
, showIntLiteral
, showFloatLiteral
, showFloatExponent
, showImagLiteral
)
where
import Control.Lens.Lens (Lens')
import Control.Lens.Review ((#))
import Data.Deriving (deriveEq1, deriveOrd1)
import Data.Digit.Binary (BinDigit)
import Data.Digit.Char (charHeXaDeCiMaL, charOctal, charBinary, charDecimal)
import Data.Digit.Octal (OctDigit)
import Data.Digit.Decimal (DecDigit)
import Data.Digit.Hexadecimal.MixedCase (HeXDigit)
import Data.Generics.Product.Typed (typed)
import Data.List.NonEmpty (NonEmpty)
import Data.Semigroup ((<>))
import Data.Text (Text)
import Data.These (These(..))
import GHC.Generics (Generic)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import Language.Python.Syntax.Ann
data IntLiteral a
= IntLiteralDec
{ _intLiteralAnn :: Ann a
, _unsafeIntLiteralDecValue :: NonEmpty DecDigit
}
| IntLiteralBin
{ _intLiteralAnn :: Ann a
, _unsafeIntLiteralBinUppercase :: Bool
, _unsafeIntLiteralBinValue :: NonEmpty BinDigit
}
| IntLiteralOct
{ _intLiteralAnn :: Ann a
, _unsafeIntLiteralOctUppercase :: Bool
, _unsafeIntLiteralOctValue :: NonEmpty OctDigit
}
| IntLiteralHex
{ _intLiteralAnn :: Ann a
, _unsafeIntLiteralHexUppercase :: Bool
, _unsafeIntLiteralHexValue :: NonEmpty HeXDigit
}
deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
deriveEq1 ''IntLiteral
deriveOrd1 ''IntLiteral
instance HasAnn IntLiteral where
annot :: forall a. Lens' (IntLiteral a) (Ann a)
annot = typed @(Ann a)
data Sign = Pos | Neg deriving (Eq, Ord, Show, Generic)
data E = Ee | EE deriving (Eq, Ord, Show, Generic)
data FloatExponent = FloatExponent E (Maybe Sign) (NonEmpty DecDigit)
deriving (Eq, Ord, Show, Generic)
data FloatLiteral a
= FloatLiteralFull
{ _floatLiteralAnn :: Ann a
, _floatLiteralFullLeft :: NonEmpty DecDigit
, _floatLiteralFullRight
:: Maybe (These (NonEmpty DecDigit) FloatExponent)
}
| FloatLiteralPoint
{ _floatLiteralAnn :: Ann a
, _floatLiteralPointRight :: NonEmpty DecDigit
, _floatLiteralPointExponent :: Maybe FloatExponent
}
| FloatLiteralWhole
{ _floatLiteralAnn :: Ann a
, _floatLiteralWholeRight :: NonEmpty DecDigit
, _floatLiteralWholeExponent :: FloatExponent
}
deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
deriveEq1 ''FloatLiteral
deriveOrd1 ''FloatLiteral
instance HasAnn FloatLiteral where
annot :: forall a. Lens' (FloatLiteral a) (Ann a)
annot = typed @(Ann a)
data ImagLiteral a
= ImagLiteralInt
{ _imagLiteralAnn :: Ann a
, _unsafeImagLiteralIntValue :: NonEmpty DecDigit
, _imagLiteralUppercase :: Bool
}
| ImagLiteralFloat
{ _imagLiteralAnn :: Ann a
, _unsafeImagLiteralFloatValue :: FloatLiteral a
, _imagLiteralUppercase :: Bool
}
deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
deriveEq1 ''ImagLiteral
deriveOrd1 ''ImagLiteral
instance HasAnn ImagLiteral where
annot :: forall a. Lens' (ImagLiteral a) (Ann a)
annot = typed @(Ann a)
showIntLiteral :: IntLiteral a -> Text
showIntLiteral (IntLiteralDec _ n) =
Text.pack $
(charDecimal #) <$> NonEmpty.toList n
showIntLiteral (IntLiteralBin _ b n) =
Text.pack $
'0' : (if b then 'B' else 'b') : fmap (charBinary #) (NonEmpty.toList n)
showIntLiteral (IntLiteralOct _ b n) =
Text.pack $
'0' : (if b then 'O' else 'o') : fmap (charOctal #) (NonEmpty.toList n)
showIntLiteral (IntLiteralHex _ b n) =
Text.pack $
'0' : (if b then 'X' else 'x') : fmap (charHeXaDeCiMaL #) (NonEmpty.toList n)
showFloatExponent :: FloatExponent -> Text
showFloatExponent (FloatExponent e s ds) =
Text.pack $
(case e of; EE -> 'E'; Ee -> 'e') :
foldMap (\case; Pos -> "+"; Neg -> "-") s <>
fmap (charDecimal #) (NonEmpty.toList ds)
showFloatLiteral :: FloatLiteral a -> Text
showFloatLiteral (FloatLiteralFull _ a b) =
Text.pack (fmap (charDecimal #) (NonEmpty.toList a) <> ".") <>
foldMap
(\case
This x -> Text.pack $ fmap (charDecimal #) (NonEmpty.toList x)
That x -> showFloatExponent x
These x y ->
Text.pack (fmap (charDecimal #) (NonEmpty.toList x)) <>
showFloatExponent y)
b
showFloatLiteral (FloatLiteralPoint _ a b) =
Text.pack ('.' : fmap (charDecimal #) (NonEmpty.toList a)) <>
foldMap showFloatExponent b
showFloatLiteral (FloatLiteralWhole _ a b) =
Text.pack (fmap (charDecimal #) (NonEmpty.toList a)) <>
showFloatExponent b
showImagLiteral :: ImagLiteral a -> Text
showImagLiteral (ImagLiteralInt _ ds b) =
Text.pack $ fmap (charDecimal #) (NonEmpty.toList ds) ++ [if b then 'J' else 'j']
showImagLiteral (ImagLiteralFloat _ f b) =
showFloatLiteral f <> Text.singleton (if b then 'J' else 'j')