{-# LANGUAGE StrictData #-}

{- |
Copyright: © 2019 James Alexander Feldman-Crough
License: MPL-2.0
-}
module ProSource.Source (Source (..)) where

import ProSource.LineMap

{- | Information about a source file.

The 'Show' instance for ths class does not include the 'LineMap' or 'Text' fields, as those are rather noisy.
-}
data Source = Source
  { Source -> String
sourceName :: String
    -- ^ The reported file-name of the 'Source'.
    --
    -- When read from file handles, a non-filepath description such as @"\<stdin\>"@ is typically chosen. This field doesn't have semantic meaning, and should only be used to enrich the output displayed to users.
  , Source -> Text
sourceText :: Text
    -- ^ The full source, as 'Text'.
  , Source -> LineMap
sourceLineMap :: LineMap
    -- ^ A mapping of the start position of each line in the 'Source'.
  }
  deriving stock (Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, (forall x. Source -> Rep Source x)
-> (forall x. Rep Source x -> Source) -> Generic Source
forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Generic)
  deriving anyclass (Eq Source
Eq Source
-> (Int -> Source -> Int) -> (Source -> Int) -> Hashable Source
Int -> Source -> Int
Source -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Source -> Int
$chash :: Source -> Int
hashWithSalt :: Int -> Source -> Int
$chashWithSalt :: Int -> Source -> Int
$cp1Hashable :: Eq Source
Hashable, Source -> ()
(Source -> ()) -> NFData Source
forall a. (a -> ()) -> NFData a
rnf :: Source -> ()
$crnf :: Source -> ()
NFData)

instance Show Source where
    show :: Source -> String
show (Source String
fp Text
_ LineMap
_) = String
"Source " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
fp

instance Pretty Source where
    pretty :: Source -> Doc ann
pretty = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Source -> String) -> Source -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> String
sourceName