-- Copyright 2019 Google LLC
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | This module provides combinators for constructing Haskell literals,
-- which may be used in either patterns or expressions.
module GHC.SourceGen.Lit
    ( HsLit'
    , HsOverLit'
    , HasLit(..)
    , char
    , string
    , int
    , frac
    ) where

import BasicTypes (FractionalLit(..))
import BasicTypes(IntegralLit(..), SourceText(..))
import GHC.Hs.Lit
import GHC.Hs.Expr (noExpr, noSyntaxExpr, HsExpr(..))
import GHC.Hs.Pat (Pat(..))
import FastString (fsLit)

import GHC.SourceGen.Lit.Internal
import GHC.SourceGen.Syntax.Internal

class HasLit e where
    lit :: HsLit' -> e
    overLit :: HsOverLit' -> e

instance HasLit HsExpr' where
    lit :: HsLit' -> HsExpr'
lit = (NoExtField -> HsLit' -> HsExpr') -> HsLit' -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> HsLit' -> HsExpr'
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit
    overLit :: HsOverLit' -> HsExpr'
overLit = (NoExtField -> HsOverLit' -> HsExpr') -> HsOverLit' -> HsExpr'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> HsOverLit' -> HsExpr'
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit

instance HasLit Pat' where
    lit :: HsLit' -> Pat'
lit = (NoExtField -> HsLit' -> Pat') -> HsLit' -> Pat'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> HsLit' -> Pat'
forall p. XLitPat p -> HsLit p -> Pat p
LitPat
    overLit :: HsOverLit' -> Pat'
overLit HsOverLit'
l = Pat' -> Pat'
forall a. a -> a
withPlaceHolder
                    (Pat' -> Pat') -> Pat' -> Pat'
forall a b. (a -> b) -> a -> b
$ (NoExtField
 -> Located HsOverLit'
 -> Maybe (SyntaxExpr GhcPs)
 -> SyntaxExpr GhcPs
 -> Pat')
-> Located HsOverLit'
-> Maybe (SyntaxExpr GhcPs)
-> SyntaxExpr GhcPs
-> Pat'
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> Located HsOverLit'
-> Maybe (SyntaxExpr GhcPs)
-> SyntaxExpr GhcPs
-> Pat'
forall p.
XNPat p
-> Located (HsOverLit p)
-> Maybe (SyntaxExpr p)
-> SyntaxExpr p
-> Pat p
NPat (HsOverLit' -> Located HsOverLit'
forall e. e -> Located e
builtLoc HsOverLit'
l) Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr

char :: HasLit e => Char -> e
char :: Char -> e
char = HsLit' -> e
forall e. HasLit e => HsLit' -> e
lit (HsLit' -> e) -> (Char -> HsLit') -> Char -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceText -> Char -> HsLit') -> Char -> HsLit'
forall a. (SourceText -> a) -> a
noSourceText SourceText -> Char -> HsLit'
forall x. XHsChar x -> Char -> HsLit x
HsChar

string :: HasLit e => String -> e
string :: String -> e
string = HsLit' -> e
forall e. HasLit e => HsLit' -> e
lit (HsLit' -> e) -> (String -> HsLit') -> String -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceText -> FastString -> HsLit') -> FastString -> HsLit'
forall a. (SourceText -> a) -> a
noSourceText SourceText -> FastString -> HsLit'
forall x. XHsString x -> FastString -> HsLit x
HsString (FastString -> HsLit')
-> (String -> FastString) -> String -> HsLit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
fsLit

-- | Note: this is an *overloaded* integer.
int :: HasLit e => Integer -> e
int :: Integer -> e
int Integer
n = HsOverLit' -> e
forall e. HasLit e => HsOverLit' -> e
overLit (HsOverLit' -> e) -> HsOverLit' -> e
forall a b. (a -> b) -> a -> b
$ HsOverLit' -> HsOverLit'
forall a. a -> a
withPlaceHolder (HsOverLit' -> HsOverLit') -> HsOverLit' -> HsOverLit'
forall a b. (a -> b) -> a -> b
$ (HsExpr' -> HsOverLit') -> HsExpr' -> HsOverLit'
forall a. a -> a
withPlaceHolder ((NoExtField -> OverLitVal -> HsExpr' -> HsOverLit')
-> OverLitVal -> HsExpr' -> HsOverLit'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> OverLitVal -> HsExpr' -> HsOverLit'
forall p. XOverLit p -> OverLitVal -> HsExpr p -> HsOverLit p
OverLit OverLitVal
il) HsExpr'
forall (p :: Pass). HsExpr (GhcPass p)
noExpr
  where
    il :: OverLitVal
il = IntegralLit -> OverLitVal
HsIntegral (IntegralLit -> OverLitVal) -> IntegralLit -> OverLitVal
forall a b. (a -> b) -> a -> b
$ (SourceText -> Bool -> Integer -> IntegralLit)
-> Bool -> Integer -> IntegralLit
forall a. (SourceText -> a) -> a
noSourceText SourceText -> Bool -> Integer -> IntegralLit
IL (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) Integer
n

-- | Note: this is an *overloaded* rational, e.g., a decimal number.
frac :: HasLit e => Rational -> e
frac :: Rational -> e
frac Rational
x = HsOverLit' -> e
forall e. HasLit e => HsOverLit' -> e
overLit (HsOverLit' -> e) -> HsOverLit' -> e
forall a b. (a -> b) -> a -> b
$ HsOverLit' -> HsOverLit'
forall a. a -> a
withPlaceHolder (HsOverLit' -> HsOverLit') -> HsOverLit' -> HsOverLit'
forall a b. (a -> b) -> a -> b
$ (HsExpr' -> HsOverLit') -> HsExpr' -> HsOverLit'
forall a. a -> a
withPlaceHolder ((NoExtField -> OverLitVal -> HsExpr' -> HsOverLit')
-> OverLitVal -> HsExpr' -> HsOverLit'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> OverLitVal -> HsExpr' -> HsOverLit'
forall p. XOverLit p -> OverLitVal -> HsExpr p -> HsOverLit p
OverLit (OverLitVal -> HsExpr' -> HsOverLit')
-> OverLitVal -> HsExpr' -> HsOverLit'
forall a b. (a -> b) -> a -> b
$ FractionalLit -> OverLitVal
HsFractional FractionalLit
il) HsExpr'
forall (p :: Pass). HsExpr (GhcPass p)
noExpr
  where
    il :: FractionalLit
il = SourceText -> Bool -> Rational -> FractionalLit
FL (String -> SourceText
SourceText String
s) (Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0) Rational
x
    s :: String
s = Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x :: Double)