-- |Description: AST for the "Data.Prune.ApplyStrategy.Smart" strategy.
module Data.Prune.Section.Types where

import Prelude

import Data.Text (Text)

import qualified Data.Prune.Types as T

-- |The name of a @common@ stanza.
newtype CommonName = CommonName { CommonName -> Text
unCommonName :: Text }
  deriving (CommonName -> CommonName -> Bool
(CommonName -> CommonName -> Bool)
-> (CommonName -> CommonName -> Bool) -> Eq CommonName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommonName -> CommonName -> Bool
$c/= :: CommonName -> CommonName -> Bool
== :: CommonName -> CommonName -> Bool
$c== :: CommonName -> CommonName -> Bool
Eq, Eq CommonName
Eq CommonName
-> (CommonName -> CommonName -> Ordering)
-> (CommonName -> CommonName -> Bool)
-> (CommonName -> CommonName -> Bool)
-> (CommonName -> CommonName -> Bool)
-> (CommonName -> CommonName -> Bool)
-> (CommonName -> CommonName -> CommonName)
-> (CommonName -> CommonName -> CommonName)
-> Ord CommonName
CommonName -> CommonName -> Bool
CommonName -> CommonName -> Ordering
CommonName -> CommonName -> CommonName
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 :: CommonName -> CommonName -> CommonName
$cmin :: CommonName -> CommonName -> CommonName
max :: CommonName -> CommonName -> CommonName
$cmax :: CommonName -> CommonName -> CommonName
>= :: CommonName -> CommonName -> Bool
$c>= :: CommonName -> CommonName -> Bool
> :: CommonName -> CommonName -> Bool
$c> :: CommonName -> CommonName -> Bool
<= :: CommonName -> CommonName -> Bool
$c<= :: CommonName -> CommonName -> Bool
< :: CommonName -> CommonName -> Bool
$c< :: CommonName -> CommonName -> Bool
compare :: CommonName -> CommonName -> Ordering
$ccompare :: CommonName -> CommonName -> Ordering
$cp1Ord :: Eq CommonName
Ord, Int -> CommonName -> ShowS
[CommonName] -> ShowS
CommonName -> String
(Int -> CommonName -> ShowS)
-> (CommonName -> String)
-> ([CommonName] -> ShowS)
-> Show CommonName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommonName] -> ShowS
$cshowList :: [CommonName] -> ShowS
show :: CommonName -> String
$cshow :: CommonName -> String
showsPrec :: Int -> CommonName -> ShowS
$cshowsPrec :: Int -> CommonName -> ShowS
Show)

-- |An indented section.
data NestedSection
  = BuildDependsNestedSection Int [String]
  | ImportNestedSection Int [String]
  | OtherNestedSection Int [String]
  deriving (NestedSection -> NestedSection -> Bool
(NestedSection -> NestedSection -> Bool)
-> (NestedSection -> NestedSection -> Bool) -> Eq NestedSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NestedSection -> NestedSection -> Bool
$c/= :: NestedSection -> NestedSection -> Bool
== :: NestedSection -> NestedSection -> Bool
$c== :: NestedSection -> NestedSection -> Bool
Eq, Eq NestedSection
Eq NestedSection
-> (NestedSection -> NestedSection -> Ordering)
-> (NestedSection -> NestedSection -> Bool)
-> (NestedSection -> NestedSection -> Bool)
-> (NestedSection -> NestedSection -> Bool)
-> (NestedSection -> NestedSection -> Bool)
-> (NestedSection -> NestedSection -> NestedSection)
-> (NestedSection -> NestedSection -> NestedSection)
-> Ord NestedSection
NestedSection -> NestedSection -> Bool
NestedSection -> NestedSection -> Ordering
NestedSection -> NestedSection -> NestedSection
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 :: NestedSection -> NestedSection -> NestedSection
$cmin :: NestedSection -> NestedSection -> NestedSection
max :: NestedSection -> NestedSection -> NestedSection
$cmax :: NestedSection -> NestedSection -> NestedSection
>= :: NestedSection -> NestedSection -> Bool
$c>= :: NestedSection -> NestedSection -> Bool
> :: NestedSection -> NestedSection -> Bool
$c> :: NestedSection -> NestedSection -> Bool
<= :: NestedSection -> NestedSection -> Bool
$c<= :: NestedSection -> NestedSection -> Bool
< :: NestedSection -> NestedSection -> Bool
$c< :: NestedSection -> NestedSection -> Bool
compare :: NestedSection -> NestedSection -> Ordering
$ccompare :: NestedSection -> NestedSection -> Ordering
$cp1Ord :: Eq NestedSection
Ord, Int -> NestedSection -> ShowS
[NestedSection] -> ShowS
NestedSection -> String
(Int -> NestedSection -> ShowS)
-> (NestedSection -> String)
-> ([NestedSection] -> ShowS)
-> Show NestedSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NestedSection] -> ShowS
$cshowList :: [NestedSection] -> ShowS
show :: NestedSection -> String
$cshow :: NestedSection -> String
showsPrec :: Int -> NestedSection -> ShowS
$cshowsPrec :: Int -> NestedSection -> ShowS
Show)

-- |A top-level section.
data Section
  = TargetSection T.CompilableType (Maybe T.CompilableName) [NestedSection]
  | CommonSection CommonName [NestedSection]
  | OtherSection [String]
  deriving (Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Eq Section
Eq Section
-> (Section -> Section -> Ordering)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Section)
-> (Section -> Section -> Section)
-> Ord Section
Section -> Section -> Bool
Section -> Section -> Ordering
Section -> Section -> Section
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 :: Section -> Section -> Section
$cmin :: Section -> Section -> Section
max :: Section -> Section -> Section
$cmax :: Section -> Section -> Section
>= :: Section -> Section -> Bool
$c>= :: Section -> Section -> Bool
> :: Section -> Section -> Bool
$c> :: Section -> Section -> Bool
<= :: Section -> Section -> Bool
$c<= :: Section -> Section -> Bool
< :: Section -> Section -> Bool
$c< :: Section -> Section -> Bool
compare :: Section -> Section -> Ordering
$ccompare :: Section -> Section -> Ordering
$cp1Ord :: Eq Section
Ord, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show)