{-# LANGUAGE CPP            #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Nix.Atoms where

#ifdef MIN_VERSION_serialise
import           Codec.Serialise                ( Serialise )
#endif

import           Data.Data                      ( Data)
import           Data.Fixed                     ( mod' )
import           Data.Binary                    ( Binary )
import           Data.Aeson.Types               ( FromJSON
                                                , ToJSON
                                                )

-- | Atoms are values that evaluate to themselves.
-- In other words - this is a constructors that are literals in Nix.
-- This means that
-- they appear in both the parsed AST (in the form of literals) and
-- the evaluated form as themselves.
-- Once HNix parsed or evaluated into atom - that is a literal
-- further after, for any further evaluation it is in all cases stays
-- constantly itself.
-- "atom", Ancient Greek \( atomos \) - "indivisible" particle,
-- indivisible expression.
data NAtom
  -- | An URI like @https://example.com@.
  = NURI Text
  -- | An integer. The c nix implementation currently only supports
  -- integers that fit in the range of 'Int64'.
  | NInt Integer
  -- | A floating point number
  | NFloat Float
  -- | Booleans. @false@ or @true@.
  | NBool Bool
  -- | Null values. There's only one of this variant: @null@.
  | NNull
  deriving
    ( NAtom -> NAtom -> Bool
(NAtom -> NAtom -> Bool) -> (NAtom -> NAtom -> Bool) -> Eq NAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NAtom -> NAtom -> Bool
$c/= :: NAtom -> NAtom -> Bool
== :: NAtom -> NAtom -> Bool
$c== :: NAtom -> NAtom -> Bool
Eq
    , Eq NAtom
Eq NAtom
-> (NAtom -> NAtom -> Ordering)
-> (NAtom -> NAtom -> Bool)
-> (NAtom -> NAtom -> Bool)
-> (NAtom -> NAtom -> Bool)
-> (NAtom -> NAtom -> Bool)
-> (NAtom -> NAtom -> NAtom)
-> (NAtom -> NAtom -> NAtom)
-> Ord NAtom
NAtom -> NAtom -> Bool
NAtom -> NAtom -> Ordering
NAtom -> NAtom -> NAtom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NAtom -> NAtom -> NAtom
$cmin :: NAtom -> NAtom -> NAtom
max :: NAtom -> NAtom -> NAtom
$cmax :: NAtom -> NAtom -> NAtom
>= :: NAtom -> NAtom -> Bool
$c>= :: NAtom -> NAtom -> Bool
> :: NAtom -> NAtom -> Bool
$c> :: NAtom -> NAtom -> Bool
<= :: NAtom -> NAtom -> Bool
$c<= :: NAtom -> NAtom -> Bool
< :: NAtom -> NAtom -> Bool
$c< :: NAtom -> NAtom -> Bool
compare :: NAtom -> NAtom -> Ordering
$ccompare :: NAtom -> NAtom -> Ordering
$cp1Ord :: Eq NAtom
Ord
    , (forall x. NAtom -> Rep NAtom x)
-> (forall x. Rep NAtom x -> NAtom) -> Generic NAtom
forall x. Rep NAtom x -> NAtom
forall x. NAtom -> Rep NAtom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NAtom x -> NAtom
$cfrom :: forall x. NAtom -> Rep NAtom x
Generic
    , Typeable
    , Typeable NAtom
DataType
Constr
Typeable NAtom
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> NAtom -> c NAtom)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NAtom)
-> (NAtom -> Constr)
-> (NAtom -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NAtom))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NAtom))
-> ((forall b. Data b => b -> b) -> NAtom -> NAtom)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r)
-> (forall u. (forall d. Data d => d -> u) -> NAtom -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NAtom -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NAtom -> m NAtom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NAtom -> m NAtom)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NAtom -> m NAtom)
-> Data NAtom
NAtom -> DataType
NAtom -> Constr
(forall b. Data b => b -> b) -> NAtom -> NAtom
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NAtom -> c NAtom
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NAtom
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NAtom -> u
forall u. (forall d. Data d => d -> u) -> NAtom -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NAtom -> m NAtom
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NAtom -> m NAtom
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NAtom
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NAtom -> c NAtom
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NAtom)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NAtom)
$cNNull :: Constr
$cNBool :: Constr
$cNFloat :: Constr
$cNInt :: Constr
$cNURI :: Constr
$tNAtom :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> NAtom -> m NAtom
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NAtom -> m NAtom
gmapMp :: (forall d. Data d => d -> m d) -> NAtom -> m NAtom
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NAtom -> m NAtom
gmapM :: (forall d. Data d => d -> m d) -> NAtom -> m NAtom
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NAtom -> m NAtom
gmapQi :: Int -> (forall d. Data d => d -> u) -> NAtom -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NAtom -> u
gmapQ :: (forall d. Data d => d -> u) -> NAtom -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NAtom -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NAtom -> r
gmapT :: (forall b. Data b => b -> b) -> NAtom -> NAtom
$cgmapT :: (forall b. Data b => b -> b) -> NAtom -> NAtom
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NAtom)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NAtom)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NAtom)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NAtom)
dataTypeOf :: NAtom -> DataType
$cdataTypeOf :: NAtom -> DataType
toConstr :: NAtom -> Constr
$ctoConstr :: NAtom -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NAtom
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NAtom
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NAtom -> c NAtom
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NAtom -> c NAtom
$cp1Data :: Typeable NAtom
Data
    , Int -> NAtom -> ShowS
[NAtom] -> ShowS
NAtom -> String
(Int -> NAtom -> ShowS)
-> (NAtom -> String) -> ([NAtom] -> ShowS) -> Show NAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NAtom] -> ShowS
$cshowList :: [NAtom] -> ShowS
show :: NAtom -> String
$cshow :: NAtom -> String
showsPrec :: Int -> NAtom -> ShowS
$cshowsPrec :: Int -> NAtom -> ShowS
Show
    , ReadPrec [NAtom]
ReadPrec NAtom
Int -> ReadS NAtom
ReadS [NAtom]
(Int -> ReadS NAtom)
-> ReadS [NAtom]
-> ReadPrec NAtom
-> ReadPrec [NAtom]
-> Read NAtom
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NAtom]
$creadListPrec :: ReadPrec [NAtom]
readPrec :: ReadPrec NAtom
$creadPrec :: ReadPrec NAtom
readList :: ReadS [NAtom]
$creadList :: ReadS [NAtom]
readsPrec :: Int -> ReadS NAtom
$creadsPrec :: Int -> ReadS NAtom
Read
    , NAtom -> ()
(NAtom -> ()) -> NFData NAtom
forall a. (a -> ()) -> NFData a
rnf :: NAtom -> ()
$crnf :: NAtom -> ()
NFData
    , Int -> NAtom -> Int
NAtom -> Int
(Int -> NAtom -> Int) -> (NAtom -> Int) -> Hashable NAtom
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: NAtom -> Int
$chash :: NAtom -> Int
hashWithSalt :: Int -> NAtom -> Int
$chashWithSalt :: Int -> NAtom -> Int
Hashable
    )

#ifdef MIN_VERSION_serialise
instance Serialise NAtom
#endif

instance Binary NAtom
instance ToJSON NAtom
instance FromJSON NAtom

-- | Translate an atom into its Nix representation.
atomText :: NAtom -> Text
atomText :: NAtom -> Text
atomText (NURI   Text
t) = Text
t
atomText (NInt   Integer
i) = Integer -> Text
forall b a. (Show a, IsString b) => a -> b
show Integer
i
atomText (NFloat Float
f) = Float -> Text
showNixFloat Float
f
 where
  showNixFloat :: Float -> Text
  showNixFloat :: Float -> Text
showNixFloat Float
x =
    Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool
      (Float -> Text
forall b a. (Show a, IsString b) => a -> b
show Float
x)
      (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
x :: Int))
      (Float
x Float -> Float -> Float
forall a. Real a => a -> a -> a
`mod'` Float
1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0)
atomText (NBool  Bool
b) = if Bool
b then Text
"true" else Text
"false"
atomText NAtom
NNull      = Text
"null"