{-# LANGUAGE DeriveGeneric #-}

module Dhall.Syntax.Types
    ( DhallDouble(..)
    , PreferAnnotation(..)
    , FieldSelection(..)
    , makeFieldSelection
    , WithComponent(..)
    ) where

import Data.Text    (Text)
import GHC.Generics (Generic)

-- | This wrapper around 'Prelude.Double' exists for its 'Eq' instance which is
-- defined via the binary encoding of Dhall @Double@s.
newtype DhallDouble = DhallDouble { DhallDouble -> Double
getDhallDouble :: Double }
    deriving forall x. Rep DhallDouble x -> DhallDouble
forall x. DhallDouble -> Rep DhallDouble x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DhallDouble x -> DhallDouble
$cfrom :: forall x. DhallDouble -> Rep DhallDouble x
Generic

-- | Used to record the origin of a @//@ operator (i.e. from source code or a
-- product of desugaring)
data PreferAnnotation
    = PreferFromSource
    | PreferFromCompletion
    deriving forall x. Rep PreferAnnotation x -> PreferAnnotation
forall x. PreferAnnotation -> Rep PreferAnnotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreferAnnotation x -> PreferAnnotation
$cfrom :: forall x. PreferAnnotation -> Rep PreferAnnotation x
Generic

-- | Record the field on a selector-expression
--
-- For example,
--
-- > e . {- A -} x {- B -}
--
-- … will be instantiated as follows:
--
-- * @fieldSelectionSrc0@ corresponds to the @A@ comment
-- * @fieldSelectionLabel@ corresponds to @x@
-- * @fieldSelectionSrc1@ corresponds to the @B@ comment
--
-- Given our limitation that not all expressions recover their whitespaces, the
-- purpose of @fieldSelectionSrc1@ is to save the 'Text.Megaparsec.SourcePos'
-- where the @fieldSelectionLabel@ ends, but we /still/ use a
-- 'Maybe Dhall.Src.Src' (@s = 'Dhall.Src.Src'@) to be consistent with similar
-- data types such as 'Dhall.Syntax.Binding.Binding', for example.
data FieldSelection s = FieldSelection
    { forall s. FieldSelection s -> Maybe s
fieldSelectionSrc0 :: Maybe s
    , forall s. FieldSelection s -> Text
fieldSelectionLabel :: !Text
    , forall s. FieldSelection s -> Maybe s
fieldSelectionSrc1 :: Maybe s
    } deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (FieldSelection s) x -> FieldSelection s
forall s x. FieldSelection s -> Rep (FieldSelection s) x
$cto :: forall s x. Rep (FieldSelection s) x -> FieldSelection s
$cfrom :: forall s x. FieldSelection s -> Rep (FieldSelection s) x
Generic

-- | Smart constructor for 'FieldSelection' with no src information
makeFieldSelection :: Text -> FieldSelection s
makeFieldSelection :: forall s. Text -> FieldSelection s
makeFieldSelection Text
t = forall s. Maybe s -> Text -> Maybe s -> FieldSelection s
FieldSelection forall a. Maybe a
Nothing Text
t forall a. Maybe a
Nothing

-- | A path component for a @with@ expression
data WithComponent = WithLabel Text | WithQuestion
    deriving forall x. Rep WithComponent x -> WithComponent
forall x. WithComponent -> Rep WithComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WithComponent x -> WithComponent
$cfrom :: forall x. WithComponent -> Rep WithComponent x
Generic