-- {-# OPTIONS_GHC -Wunused-imports #-} -- does not work because of liftA2
{-# OPTIONS_GHC -Wunused-matches #-}

{-| Some common syntactic entities are defined in this module.
-}
module Mikan.Syntax.Common
  ( module Mikan.Syntax.Common
  , module Mikan.Syntax.Common.KeywordRange
  , module Mikan.Syntax.TopLevelModuleName.Boot
  , Induction(..)
  )
  where

import Mikan.Syntax.TopLevelModuleName.Boot

import Prelude hiding (null)

import Control.DeepSeq
import Control.Applicative ((<|>), liftA2)

import Data.Bifunctor
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Char8 qualified as ByteString
import Data.Foldable qualified as Fold
import Data.Function (on)
import Data.Hashable (Hashable(..))
import Data.Strict.Maybe qualified as Strict
import Data.Word
import Data.IntSet (IntSet)
import Data.IntSet qualified as IntSet
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Short (ShortText)
import Data.Text.Short qualified as TS

import Generic.Data (FiniteEnumeration(..))

import GHC.Generics (Generic)

import Mikan.Syntax.Common.Aspect (Induction(..))
import Mikan.Syntax.Common.KeywordRange
import Mikan.Syntax.Common.Pretty
import Mikan.Syntax.Concrete.Glyph
import Mikan.Syntax.Position

import Mikan.Utils.Boolean (Boolean(fromBool), IsBool(toBool))
import Mikan.Utils.Float (toStringWithoutDotZero)
import Mikan.Utils.Functor
import Mikan.Utils.Lens
import Mikan.Utils.Hash (combineWord)
import Mikan.Utils.List  ( lastMaybe )
import Mikan.Utils.List1  ( List1, pattern (:|), (<|) )
import Mikan.Utils.List1 qualified as List1
import Mikan.Utils.Maybe
import Mikan.Utils.Null
import Mikan.Utils.PartialOrd
import Mikan.Utils.POMonoid
import Mikan.Utils.Singleton
import Mikan.Utils.VarSet (VarSet)
import Mikan.Utils.VarSet qualified as VarSet

import Mikan.Utils.Impossible

-- | Number @>= 0@.
type Nat    = Int
type Arity  = Nat

-- | Number @>= 1@.
type Nat1   = Nat

---------------------------------------------------------------------------
-- * IsMain
---------------------------------------------------------------------------

data IsMain = IsMain | NotMain
  deriving (IsMain -> IsMain -> Bool
(IsMain -> IsMain -> Bool)
-> (IsMain -> IsMain -> Bool) -> Eq IsMain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsMain -> IsMain -> Bool
== :: IsMain -> IsMain -> Bool
$c/= :: IsMain -> IsMain -> Bool
/= :: IsMain -> IsMain -> Bool
Eq, Int -> IsMain -> ShowS
[IsMain] -> ShowS
IsMain -> String
(Int -> IsMain -> ShowS)
-> (IsMain -> String) -> ([IsMain] -> ShowS) -> Show IsMain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsMain -> ShowS
showsPrec :: Int -> IsMain -> ShowS
$cshow :: IsMain -> String
show :: IsMain -> String
$cshowList :: [IsMain] -> ShowS
showList :: [IsMain] -> ShowS
Show)

-- | Conjunctive semigroup ('NotMain' is absorbing).
instance Semigroup IsMain where
  IsMain
NotMain <> :: IsMain -> IsMain -> IsMain
<> IsMain
_ = IsMain
NotMain
  IsMain
_       <> IsMain
NotMain = IsMain
NotMain
  IsMain
IsMain  <> IsMain
IsMain = IsMain
IsMain

instance Monoid IsMain where
  mempty :: IsMain
mempty = IsMain
IsMain
  mappend :: IsMain -> IsMain -> IsMain
mappend = IsMain -> IsMain -> IsMain
forall a. Semigroup a => a -> a -> a
(<>)

---------------------------------------------------------------------------
-- * File
---------------------------------------------------------------------------

data FileType = AgdaFileType | MdFileType | RstFileType | TexFileType | OrgFileType | TypstFileType | TreeFileType
  deriving (FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: FileType -> FileType -> Bool
Eq, Eq FileType
Eq FileType =>
(FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
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
$ccompare :: FileType -> FileType -> Ordering
compare :: FileType -> FileType -> Ordering
$c< :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
>= :: FileType -> FileType -> Bool
$cmax :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
min :: FileType -> FileType -> FileType
Ord, Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileType -> ShowS
showsPrec :: Int -> FileType -> ShowS
$cshow :: FileType -> String
show :: FileType -> String
$cshowList :: [FileType] -> ShowS
showList :: [FileType] -> ShowS
Show, (forall x. FileType -> Rep FileType x)
-> (forall x. Rep FileType x -> FileType) -> Generic FileType
forall x. Rep FileType x -> FileType
forall x. FileType -> Rep FileType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FileType -> Rep FileType x
from :: forall x. FileType -> Rep FileType x
$cto :: forall x. Rep FileType x -> FileType
to :: forall x. Rep FileType x -> FileType
Generic)

instance Pretty FileType where
  pretty :: FileType -> Doc
pretty = \case
    FileType
AgdaFileType -> Doc
"Agda"
    FileType
MdFileType   -> Doc
"Markdown"
    FileType
RstFileType  -> Doc
"ReStructedText"
    FileType
TexFileType  -> Doc
"LaTeX"
    FileType
OrgFileType  -> Doc
"org-mode"
    FileType
TypstFileType -> Doc
"Typst"
    FileType
TreeFileType -> Doc
"Forester"

instance NFData FileType

---------------------------------------------------------------------------
-- * Backends
---------------------------------------------------------------------------

type BackendName = ShortText

---------------------------------------------------------------------------
-- * Some enums
---------------------------------------------------------------------------

-- | Distinguish constructors from pattern synonyms.

data ConstructorOrPatternSynonym = IsConstructor | IsPatternSynonym
  deriving (Int -> ConstructorOrPatternSynonym -> ShowS
[ConstructorOrPatternSynonym] -> ShowS
ConstructorOrPatternSynonym -> String
(Int -> ConstructorOrPatternSynonym -> ShowS)
-> (ConstructorOrPatternSynonym -> String)
-> ([ConstructorOrPatternSynonym] -> ShowS)
-> Show ConstructorOrPatternSynonym
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstructorOrPatternSynonym -> ShowS
showsPrec :: Int -> ConstructorOrPatternSynonym -> ShowS
$cshow :: ConstructorOrPatternSynonym -> String
show :: ConstructorOrPatternSynonym -> String
$cshowList :: [ConstructorOrPatternSynonym] -> ShowS
showList :: [ConstructorOrPatternSynonym] -> ShowS
Show, (forall x.
 ConstructorOrPatternSynonym -> Rep ConstructorOrPatternSynonym x)
-> (forall x.
    Rep ConstructorOrPatternSynonym x -> ConstructorOrPatternSynonym)
-> Generic ConstructorOrPatternSynonym
forall x.
Rep ConstructorOrPatternSynonym x -> ConstructorOrPatternSynonym
forall x.
ConstructorOrPatternSynonym -> Rep ConstructorOrPatternSynonym x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ConstructorOrPatternSynonym -> Rep ConstructorOrPatternSynonym x
from :: forall x.
ConstructorOrPatternSynonym -> Rep ConstructorOrPatternSynonym x
$cto :: forall x.
Rep ConstructorOrPatternSynonym x -> ConstructorOrPatternSynonym
to :: forall x.
Rep ConstructorOrPatternSynonym x -> ConstructorOrPatternSynonym
Generic, Int -> ConstructorOrPatternSynonym
ConstructorOrPatternSynonym -> Int
ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym
ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> [ConstructorOrPatternSynonym]
(ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym)
-> (ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym)
-> (Int -> ConstructorOrPatternSynonym)
-> (ConstructorOrPatternSynonym -> Int)
-> (ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym])
-> (ConstructorOrPatternSynonym
    -> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym])
-> (ConstructorOrPatternSynonym
    -> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym])
-> (ConstructorOrPatternSynonym
    -> ConstructorOrPatternSynonym
    -> ConstructorOrPatternSynonym
    -> [ConstructorOrPatternSynonym])
-> Enum ConstructorOrPatternSynonym
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym
succ :: ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym
$cpred :: ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym
pred :: ConstructorOrPatternSynonym -> ConstructorOrPatternSynonym
$ctoEnum :: Int -> ConstructorOrPatternSynonym
toEnum :: Int -> ConstructorOrPatternSynonym
$cfromEnum :: ConstructorOrPatternSynonym -> Int
fromEnum :: ConstructorOrPatternSynonym -> Int
$cenumFrom :: ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
enumFrom :: ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
$cenumFromThen :: ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
enumFromThen :: ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
$cenumFromTo :: ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
enumFromTo :: ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym -> [ConstructorOrPatternSynonym]
$cenumFromThenTo :: ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> [ConstructorOrPatternSynonym]
enumFromThenTo :: ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> [ConstructorOrPatternSynonym]
Enum, ConstructorOrPatternSynonym
ConstructorOrPatternSynonym
-> ConstructorOrPatternSynonym
-> Bounded ConstructorOrPatternSynonym
forall a. a -> a -> Bounded a
$cminBound :: ConstructorOrPatternSynonym
minBound :: ConstructorOrPatternSynonym
$cmaxBound :: ConstructorOrPatternSynonym
maxBound :: ConstructorOrPatternSynonym
Bounded)

instance Pretty ConstructorOrPatternSynonym where
  pretty :: ConstructorOrPatternSynonym -> Doc
pretty = \case
    ConstructorOrPatternSynonym
IsConstructor    -> Doc
"constructor"
    ConstructorOrPatternSynonym
IsPatternSynonym -> Doc
"pattern synonym"

instance NFData ConstructorOrPatternSynonym

-- | Distinguish parsing a DISPLAY pragma from an ordinary left hand side.

data DisplayLHS = YesDisplayLHS | NoDisplayLHS
  deriving (DisplayLHS -> DisplayLHS -> Bool
(DisplayLHS -> DisplayLHS -> Bool)
-> (DisplayLHS -> DisplayLHS -> Bool) -> Eq DisplayLHS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisplayLHS -> DisplayLHS -> Bool
== :: DisplayLHS -> DisplayLHS -> Bool
$c/= :: DisplayLHS -> DisplayLHS -> Bool
/= :: DisplayLHS -> DisplayLHS -> Bool
Eq, Int -> DisplayLHS -> ShowS
[DisplayLHS] -> ShowS
DisplayLHS -> String
(Int -> DisplayLHS -> ShowS)
-> (DisplayLHS -> String)
-> ([DisplayLHS] -> ShowS)
-> Show DisplayLHS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisplayLHS -> ShowS
showsPrec :: Int -> DisplayLHS -> ShowS
$cshow :: DisplayLHS -> String
show :: DisplayLHS -> String
$cshowList :: [DisplayLHS] -> ShowS
showList :: [DisplayLHS] -> ShowS
Show, (forall x. DisplayLHS -> Rep DisplayLHS x)
-> (forall x. Rep DisplayLHS x -> DisplayLHS) -> Generic DisplayLHS
forall x. Rep DisplayLHS x -> DisplayLHS
forall x. DisplayLHS -> Rep DisplayLHS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DisplayLHS -> Rep DisplayLHS x
from :: forall x. DisplayLHS -> Rep DisplayLHS x
$cto :: forall x. Rep DisplayLHS x -> DisplayLHS
to :: forall x. Rep DisplayLHS x -> DisplayLHS
Generic, Int -> DisplayLHS
DisplayLHS -> Int
DisplayLHS -> [DisplayLHS]
DisplayLHS -> DisplayLHS
DisplayLHS -> DisplayLHS -> [DisplayLHS]
DisplayLHS -> DisplayLHS -> DisplayLHS -> [DisplayLHS]
(DisplayLHS -> DisplayLHS)
-> (DisplayLHS -> DisplayLHS)
-> (Int -> DisplayLHS)
-> (DisplayLHS -> Int)
-> (DisplayLHS -> [DisplayLHS])
-> (DisplayLHS -> DisplayLHS -> [DisplayLHS])
-> (DisplayLHS -> DisplayLHS -> [DisplayLHS])
-> (DisplayLHS -> DisplayLHS -> DisplayLHS -> [DisplayLHS])
-> Enum DisplayLHS
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DisplayLHS -> DisplayLHS
succ :: DisplayLHS -> DisplayLHS
$cpred :: DisplayLHS -> DisplayLHS
pred :: DisplayLHS -> DisplayLHS
$ctoEnum :: Int -> DisplayLHS
toEnum :: Int -> DisplayLHS
$cfromEnum :: DisplayLHS -> Int
fromEnum :: DisplayLHS -> Int
$cenumFrom :: DisplayLHS -> [DisplayLHS]
enumFrom :: DisplayLHS -> [DisplayLHS]
$cenumFromThen :: DisplayLHS -> DisplayLHS -> [DisplayLHS]
enumFromThen :: DisplayLHS -> DisplayLHS -> [DisplayLHS]
$cenumFromTo :: DisplayLHS -> DisplayLHS -> [DisplayLHS]
enumFromTo :: DisplayLHS -> DisplayLHS -> [DisplayLHS]
$cenumFromThenTo :: DisplayLHS -> DisplayLHS -> DisplayLHS -> [DisplayLHS]
enumFromThenTo :: DisplayLHS -> DisplayLHS -> DisplayLHS -> [DisplayLHS]
Enum, DisplayLHS
DisplayLHS -> DisplayLHS -> Bounded DisplayLHS
forall a. a -> a -> Bounded a
$cminBound :: DisplayLHS
minBound :: DisplayLHS
$cmaxBound :: DisplayLHS
maxBound :: DisplayLHS
Bounded)

instance Boolean DisplayLHS where
  fromBool :: Bool -> DisplayLHS
fromBool = \case
    Bool
True -> DisplayLHS
YesDisplayLHS
    Bool
False -> DisplayLHS
NoDisplayLHS

instance IsBool DisplayLHS where
  toBool :: DisplayLHS -> Bool
toBool = \case
    DisplayLHS
YesDisplayLHS -> Bool
True
    DisplayLHS
NoDisplayLHS -> Bool
False

-- | Expression kinds: Expressions or patterns.

data ExprKind = IsExpr | IsPattern DisplayLHS
  deriving (ExprKind -> ExprKind -> Bool
(ExprKind -> ExprKind -> Bool)
-> (ExprKind -> ExprKind -> Bool) -> Eq ExprKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExprKind -> ExprKind -> Bool
== :: ExprKind -> ExprKind -> Bool
$c/= :: ExprKind -> ExprKind -> Bool
/= :: ExprKind -> ExprKind -> Bool
Eq, Int -> ExprKind -> ShowS
[ExprKind] -> ShowS
ExprKind -> String
(Int -> ExprKind -> ShowS)
-> (ExprKind -> String) -> ([ExprKind] -> ShowS) -> Show ExprKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExprKind -> ShowS
showsPrec :: Int -> ExprKind -> ShowS
$cshow :: ExprKind -> String
show :: ExprKind -> String
$cshowList :: [ExprKind] -> ShowS
showList :: [ExprKind] -> ShowS
Show)

isKindPattern :: ExprKind -> Bool
isKindPattern :: ExprKind -> Bool
isKindPattern (IsPattern DisplayLHS
_) = Bool
True
isKindPattern ExprKind
IsExpr        = Bool
False

---------------------------------------------------------------------------
-- * Record Directives
---------------------------------------------------------------------------

data RecordDirectives' a = RecordDirectives
  { forall a. RecordDirectives' a -> Maybe (Ranged Induction)
recInductive   :: Maybe (Ranged Induction)
  , forall a. RecordDirectives' a -> Maybe (Ranged HasEta0)
recHasEta      :: Maybe (Ranged HasEta0)
  , forall a. RecordDirectives' a -> Maybe Range
recPattern     :: Maybe Range
  , forall a. RecordDirectives' a -> a
recConstructor :: a
  } deriving ((forall a b.
 (a -> b) -> RecordDirectives' a -> RecordDirectives' b)
-> (forall a b. a -> RecordDirectives' b -> RecordDirectives' a)
-> Functor RecordDirectives'
forall a b. a -> RecordDirectives' b -> RecordDirectives' a
forall a b. (a -> b) -> RecordDirectives' a -> RecordDirectives' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RecordDirectives' a -> RecordDirectives' b
fmap :: forall a b. (a -> b) -> RecordDirectives' a -> RecordDirectives' b
$c<$ :: forall a b. a -> RecordDirectives' b -> RecordDirectives' a
<$ :: forall a b. a -> RecordDirectives' b -> RecordDirectives' a
Functor, Int -> RecordDirectives' a -> ShowS
[RecordDirectives' a] -> ShowS
RecordDirectives' a -> String
(Int -> RecordDirectives' a -> ShowS)
-> (RecordDirectives' a -> String)
-> ([RecordDirectives' a] -> ShowS)
-> Show (RecordDirectives' a)
forall a. Show a => Int -> RecordDirectives' a -> ShowS
forall a. Show a => [RecordDirectives' a] -> ShowS
forall a. Show a => RecordDirectives' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> RecordDirectives' a -> ShowS
showsPrec :: Int -> RecordDirectives' a -> ShowS
$cshow :: forall a. Show a => RecordDirectives' a -> String
show :: RecordDirectives' a -> String
$cshowList :: forall a. Show a => [RecordDirectives' a] -> ShowS
showList :: [RecordDirectives' a] -> ShowS
Show, RecordDirectives' a -> RecordDirectives' a -> Bool
(RecordDirectives' a -> RecordDirectives' a -> Bool)
-> (RecordDirectives' a -> RecordDirectives' a -> Bool)
-> Eq (RecordDirectives' a)
forall a.
Eq a =>
RecordDirectives' a -> RecordDirectives' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
RecordDirectives' a -> RecordDirectives' a -> Bool
== :: RecordDirectives' a -> RecordDirectives' a -> Bool
$c/= :: forall a.
Eq a =>
RecordDirectives' a -> RecordDirectives' a -> Bool
/= :: RecordDirectives' a -> RecordDirectives' a -> Bool
Eq, (forall m. Monoid m => RecordDirectives' m -> m)
-> (forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m)
-> (forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m)
-> (forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b)
-> (forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b)
-> (forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b)
-> (forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b)
-> (forall a. (a -> a -> a) -> RecordDirectives' a -> a)
-> (forall a. (a -> a -> a) -> RecordDirectives' a -> a)
-> (forall a. RecordDirectives' a -> [a])
-> (forall a. RecordDirectives' a -> Bool)
-> (forall a. RecordDirectives' a -> Int)
-> (forall a. Eq a => a -> RecordDirectives' a -> Bool)
-> (forall a. Ord a => RecordDirectives' a -> a)
-> (forall a. Ord a => RecordDirectives' a -> a)
-> (forall a. Num a => RecordDirectives' a -> a)
-> (forall a. Num a => RecordDirectives' a -> a)
-> Foldable RecordDirectives'
forall a. Eq a => a -> RecordDirectives' a -> Bool
forall a. Num a => RecordDirectives' a -> a
forall a. Ord a => RecordDirectives' a -> a
forall m. Monoid m => RecordDirectives' m -> m
forall a. RecordDirectives' a -> Bool
forall a. RecordDirectives' a -> Int
forall a. RecordDirectives' a -> [a]
forall a. (a -> a -> a) -> RecordDirectives' a -> a
forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m
forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b
forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => RecordDirectives' m -> m
fold :: forall m. Monoid m => RecordDirectives' m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RecordDirectives' a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RecordDirectives' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RecordDirectives' a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> RecordDirectives' a -> a
foldr1 :: forall a. (a -> a -> a) -> RecordDirectives' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RecordDirectives' a -> a
foldl1 :: forall a. (a -> a -> a) -> RecordDirectives' a -> a
$ctoList :: forall a. RecordDirectives' a -> [a]
toList :: forall a. RecordDirectives' a -> [a]
$cnull :: forall a. RecordDirectives' a -> Bool
null :: forall a. RecordDirectives' a -> Bool
$clength :: forall a. RecordDirectives' a -> Int
length :: forall a. RecordDirectives' a -> Int
$celem :: forall a. Eq a => a -> RecordDirectives' a -> Bool
elem :: forall a. Eq a => a -> RecordDirectives' a -> Bool
$cmaximum :: forall a. Ord a => RecordDirectives' a -> a
maximum :: forall a. Ord a => RecordDirectives' a -> a
$cminimum :: forall a. Ord a => RecordDirectives' a -> a
minimum :: forall a. Ord a => RecordDirectives' a -> a
$csum :: forall a. Num a => RecordDirectives' a -> a
sum :: forall a. Num a => RecordDirectives' a -> a
$cproduct :: forall a. Num a => RecordDirectives' a -> a
product :: forall a. Num a => RecordDirectives' a -> a
Foldable, Functor RecordDirectives'
Foldable RecordDirectives'
(Functor RecordDirectives', Foldable RecordDirectives') =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> RecordDirectives' a -> f (RecordDirectives' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RecordDirectives' (f a) -> f (RecordDirectives' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RecordDirectives' a -> m (RecordDirectives' b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RecordDirectives' (m a) -> m (RecordDirectives' a))
-> Traversable RecordDirectives'
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
RecordDirectives' (m a) -> m (RecordDirectives' a)
forall (f :: * -> *) a.
Applicative f =>
RecordDirectives' (f a) -> f (RecordDirectives' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RecordDirectives' a -> m (RecordDirectives' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordDirectives' a -> f (RecordDirectives' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordDirectives' a -> f (RecordDirectives' b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RecordDirectives' a -> f (RecordDirectives' b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RecordDirectives' (f a) -> f (RecordDirectives' a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RecordDirectives' (f a) -> f (RecordDirectives' a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RecordDirectives' a -> m (RecordDirectives' b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RecordDirectives' a -> m (RecordDirectives' b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
RecordDirectives' (m a) -> m (RecordDirectives' a)
sequence :: forall (m :: * -> *) a.
Monad m =>
RecordDirectives' (m a) -> m (RecordDirectives' a)
Traversable)

instance Null a => Null (RecordDirectives' a) where
  empty :: RecordDirectives' a
empty = RecordDirectives' a
forall a. Null a => RecordDirectives' a
emptyRecordDirectives
  null :: RecordDirectives' a -> Bool
null (RecordDirectives Maybe (Ranged Induction)
a Maybe (Ranged HasEta0)
b Maybe Range
c a
d) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Maybe (Ranged Induction) -> Bool
forall a. Null a => a -> Bool
null Maybe (Ranged Induction)
a, Maybe (Ranged HasEta0) -> Bool
forall a. Null a => a -> Bool
null Maybe (Ranged HasEta0)
b, Maybe Range -> Bool
forall a. Null a => a -> Bool
null Maybe Range
c, a -> Bool
forall a. Null a => a -> Bool
null a
d]

emptyRecordDirectives :: Null a => RecordDirectives' a
emptyRecordDirectives :: forall a. Null a => RecordDirectives' a
emptyRecordDirectives = Maybe (Ranged Induction)
-> Maybe (Ranged HasEta0)
-> Maybe Range
-> a
-> RecordDirectives' a
forall a.
Maybe (Ranged Induction)
-> Maybe (Ranged HasEta0)
-> Maybe Range
-> a
-> RecordDirectives' a
RecordDirectives Maybe (Ranged Induction)
forall a. Null a => a
empty Maybe (Ranged HasEta0)
forall a. Null a => a
empty Maybe Range
forall a. Null a => a
empty a
forall a. Null a => a
empty

instance HasRange a => HasRange (RecordDirectives' a) where
  getRange :: RecordDirectives' a -> Range
getRange (RecordDirectives Maybe (Ranged Induction)
a Maybe (Ranged HasEta0)
b Maybe Range
c a
d) = (Maybe (Ranged Induction), Maybe (Ranged HasEta0), Maybe Range, a)
-> Range
forall a. HasRange a => a -> Range
getRange (Maybe (Ranged Induction)
a,Maybe (Ranged HasEta0)
b,Maybe Range
c,a
d)

instance KillRange a => KillRange (RecordDirectives' a) where
  killRange :: KillRangeT (RecordDirectives' a)
killRange (RecordDirectives Maybe (Ranged Induction)
a Maybe (Ranged HasEta0)
b Maybe Range
c a
d) = (Maybe (Ranged Induction)
 -> Maybe (Ranged HasEta0)
 -> Maybe Range
 -> a
 -> RecordDirectives' a)
-> Maybe (Ranged Induction)
-> Maybe (Ranged HasEta0)
-> Maybe Range
-> a
-> RecordDirectives' a
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN Maybe (Ranged Induction)
-> Maybe (Ranged HasEta0)
-> Maybe Range
-> a
-> RecordDirectives' a
forall a.
Maybe (Ranged Induction)
-> Maybe (Ranged HasEta0)
-> Maybe Range
-> a
-> RecordDirectives' a
RecordDirectives Maybe (Ranged Induction)
a Maybe (Ranged HasEta0)
b Maybe Range
c a
d

instance NFData a => NFData (RecordDirectives' a) where
  rnf :: RecordDirectives' a -> ()
rnf (RecordDirectives Maybe (Ranged Induction)
a Maybe (Ranged HasEta0)
b Maybe Range
c a
d) = Maybe Range
c Maybe Range -> () -> ()
forall a b. a -> b -> b
`seq` (Maybe (Ranged Induction), Maybe (Ranged HasEta0), a) -> ()
forall a. NFData a => a -> ()
rnf (Maybe (Ranged Induction)
a, Maybe (Ranged HasEta0)
b, a
d)

---------------------------------------------------------------------------
-- * Eta-equality
---------------------------------------------------------------------------

-- | Does a record come with eta-equality?
data HasEta' a
  = YesEta
  | NoEta a
  deriving (Int -> HasEta' a -> ShowS
[HasEta' a] -> ShowS
HasEta' a -> String
(Int -> HasEta' a -> ShowS)
-> (HasEta' a -> String)
-> ([HasEta' a] -> ShowS)
-> Show (HasEta' a)
forall a. Show a => Int -> HasEta' a -> ShowS
forall a. Show a => [HasEta' a] -> ShowS
forall a. Show a => HasEta' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> HasEta' a -> ShowS
showsPrec :: Int -> HasEta' a -> ShowS
$cshow :: forall a. Show a => HasEta' a -> String
show :: HasEta' a -> String
$cshowList :: forall a. Show a => [HasEta' a] -> ShowS
showList :: [HasEta' a] -> ShowS
Show, HasEta' a -> HasEta' a -> Bool
(HasEta' a -> HasEta' a -> Bool)
-> (HasEta' a -> HasEta' a -> Bool) -> Eq (HasEta' a)
forall a. Eq a => HasEta' a -> HasEta' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => HasEta' a -> HasEta' a -> Bool
== :: HasEta' a -> HasEta' a -> Bool
$c/= :: forall a. Eq a => HasEta' a -> HasEta' a -> Bool
/= :: HasEta' a -> HasEta' a -> Bool
Eq, Eq (HasEta' a)
Eq (HasEta' a) =>
(HasEta' a -> HasEta' a -> Ordering)
-> (HasEta' a -> HasEta' a -> Bool)
-> (HasEta' a -> HasEta' a -> Bool)
-> (HasEta' a -> HasEta' a -> Bool)
-> (HasEta' a -> HasEta' a -> Bool)
-> (HasEta' a -> HasEta' a -> HasEta' a)
-> (HasEta' a -> HasEta' a -> HasEta' a)
-> Ord (HasEta' a)
HasEta' a -> HasEta' a -> Bool
HasEta' a -> HasEta' a -> Ordering
HasEta' a -> HasEta' a -> HasEta' a
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
forall a. Ord a => Eq (HasEta' a)
forall a. Ord a => HasEta' a -> HasEta' a -> Bool
forall a. Ord a => HasEta' a -> HasEta' a -> Ordering
forall a. Ord a => HasEta' a -> HasEta' a -> HasEta' a
$ccompare :: forall a. Ord a => HasEta' a -> HasEta' a -> Ordering
compare :: HasEta' a -> HasEta' a -> Ordering
$c< :: forall a. Ord a => HasEta' a -> HasEta' a -> Bool
< :: HasEta' a -> HasEta' a -> Bool
$c<= :: forall a. Ord a => HasEta' a -> HasEta' a -> Bool
<= :: HasEta' a -> HasEta' a -> Bool
$c> :: forall a. Ord a => HasEta' a -> HasEta' a -> Bool
> :: HasEta' a -> HasEta' a -> Bool
$c>= :: forall a. Ord a => HasEta' a -> HasEta' a -> Bool
>= :: HasEta' a -> HasEta' a -> Bool
$cmax :: forall a. Ord a => HasEta' a -> HasEta' a -> HasEta' a
max :: HasEta' a -> HasEta' a -> HasEta' a
$cmin :: forall a. Ord a => HasEta' a -> HasEta' a -> HasEta' a
min :: HasEta' a -> HasEta' a -> HasEta' a
Ord, (forall a b. (a -> b) -> HasEta' a -> HasEta' b)
-> (forall a b. a -> HasEta' b -> HasEta' a) -> Functor HasEta'
forall a b. a -> HasEta' b -> HasEta' a
forall a b. (a -> b) -> HasEta' a -> HasEta' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> HasEta' a -> HasEta' b
fmap :: forall a b. (a -> b) -> HasEta' a -> HasEta' b
$c<$ :: forall a b. a -> HasEta' b -> HasEta' a
<$ :: forall a b. a -> HasEta' b -> HasEta' a
Functor, (forall m. Monoid m => HasEta' m -> m)
-> (forall m a. Monoid m => (a -> m) -> HasEta' a -> m)
-> (forall m a. Monoid m => (a -> m) -> HasEta' a -> m)
-> (forall a b. (a -> b -> b) -> b -> HasEta' a -> b)
-> (forall a b. (a -> b -> b) -> b -> HasEta' a -> b)
-> (forall b a. (b -> a -> b) -> b -> HasEta' a -> b)
-> (forall b a. (b -> a -> b) -> b -> HasEta' a -> b)
-> (forall a. (a -> a -> a) -> HasEta' a -> a)
-> (forall a. (a -> a -> a) -> HasEta' a -> a)
-> (forall a. HasEta' a -> [a])
-> (forall a. HasEta' a -> Bool)
-> (forall a. HasEta' a -> Int)
-> (forall a. Eq a => a -> HasEta' a -> Bool)
-> (forall a. Ord a => HasEta' a -> a)
-> (forall a. Ord a => HasEta' a -> a)
-> (forall a. Num a => HasEta' a -> a)
-> (forall a. Num a => HasEta' a -> a)
-> Foldable HasEta'
forall a. Eq a => a -> HasEta' a -> Bool
forall a. Num a => HasEta' a -> a
forall a. Ord a => HasEta' a -> a
forall m. Monoid m => HasEta' m -> m
forall a. HasEta' a -> Bool
forall a. HasEta' a -> Int
forall a. HasEta' a -> [a]
forall a. (a -> a -> a) -> HasEta' a -> a
forall m a. Monoid m => (a -> m) -> HasEta' a -> m
forall b a. (b -> a -> b) -> b -> HasEta' a -> b
forall a b. (a -> b -> b) -> b -> HasEta' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => HasEta' m -> m
fold :: forall m. Monoid m => HasEta' m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> HasEta' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HasEta' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> HasEta' a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> HasEta' a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> HasEta' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HasEta' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> HasEta' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HasEta' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> HasEta' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HasEta' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> HasEta' a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> HasEta' a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> HasEta' a -> a
foldr1 :: forall a. (a -> a -> a) -> HasEta' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> HasEta' a -> a
foldl1 :: forall a. (a -> a -> a) -> HasEta' a -> a
$ctoList :: forall a. HasEta' a -> [a]
toList :: forall a. HasEta' a -> [a]
$cnull :: forall a. HasEta' a -> Bool
null :: forall a. HasEta' a -> Bool
$clength :: forall a. HasEta' a -> Int
length :: forall a. HasEta' a -> Int
$celem :: forall a. Eq a => a -> HasEta' a -> Bool
elem :: forall a. Eq a => a -> HasEta' a -> Bool
$cmaximum :: forall a. Ord a => HasEta' a -> a
maximum :: forall a. Ord a => HasEta' a -> a
$cminimum :: forall a. Ord a => HasEta' a -> a
minimum :: forall a. Ord a => HasEta' a -> a
$csum :: forall a. Num a => HasEta' a -> a
sum :: forall a. Num a => HasEta' a -> a
$cproduct :: forall a. Num a => HasEta' a -> a
product :: forall a. Num a => HasEta' a -> a
Foldable, Functor HasEta'
Foldable HasEta'
(Functor HasEta', Foldable HasEta') =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> HasEta' a -> f (HasEta' b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    HasEta' (f a) -> f (HasEta' a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> HasEta' a -> m (HasEta' b))
-> (forall (m :: * -> *) a.
    Monad m =>
    HasEta' (m a) -> m (HasEta' a))
-> Traversable HasEta'
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => HasEta' (m a) -> m (HasEta' a)
forall (f :: * -> *) a.
Applicative f =>
HasEta' (f a) -> f (HasEta' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HasEta' a -> m (HasEta' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HasEta' a -> f (HasEta' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HasEta' a -> f (HasEta' b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HasEta' a -> f (HasEta' b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
HasEta' (f a) -> f (HasEta' a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HasEta' (f a) -> f (HasEta' a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HasEta' a -> m (HasEta' b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HasEta' a -> m (HasEta' b)
$csequence :: forall (m :: * -> *) a. Monad m => HasEta' (m a) -> m (HasEta' a)
sequence :: forall (m :: * -> *) a. Monad m => HasEta' (m a) -> m (HasEta' a)
Traversable)

instance HasRange a => HasRange (HasEta' a) where
  getRange :: HasEta' a -> Range
getRange = (a -> Range) -> HasEta' a -> Range
forall m a. Monoid m => (a -> m) -> HasEta' a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Range
forall a. HasRange a => a -> Range
getRange

instance KillRange a => KillRange (HasEta' a) where
  killRange :: KillRangeT (HasEta' a)
killRange = (a -> a) -> KillRangeT (HasEta' a)
forall a b. (a -> b) -> HasEta' a -> HasEta' b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. KillRange a => KillRangeT a
killRange

instance NFData a => NFData (HasEta' a) where
  rnf :: HasEta' a -> ()
rnf HasEta' a
YesEta    = ()
  rnf (NoEta a
p) = a -> ()
forall a. NFData a => a -> ()
rnf a
p

-- | Pattern and copattern matching is allowed in the presence of eta.
--
--   In the absence of eta, we have to choose whether we want to allow
--   matching on the constructor or copattern matching with the projections.
--   Having both leads to breakage of subject reduction (issue #4560).

type HasEta  = HasEta' PatternOrCopattern
type HasEta0 = HasEta' ()

-- | For a record without eta, which type of matching do we allow?
data PatternOrCopattern
  = PatternMatching
      -- ^ Can match on the record constructor.
  | CopatternMatching
      -- ^ Can copattern match using the projections. (Default.)
  deriving (Int -> PatternOrCopattern -> ShowS
[PatternOrCopattern] -> ShowS
PatternOrCopattern -> String
(Int -> PatternOrCopattern -> ShowS)
-> (PatternOrCopattern -> String)
-> ([PatternOrCopattern] -> ShowS)
-> Show PatternOrCopattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatternOrCopattern -> ShowS
showsPrec :: Int -> PatternOrCopattern -> ShowS
$cshow :: PatternOrCopattern -> String
show :: PatternOrCopattern -> String
$cshowList :: [PatternOrCopattern] -> ShowS
showList :: [PatternOrCopattern] -> ShowS
Show, PatternOrCopattern -> PatternOrCopattern -> Bool
(PatternOrCopattern -> PatternOrCopattern -> Bool)
-> (PatternOrCopattern -> PatternOrCopattern -> Bool)
-> Eq PatternOrCopattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatternOrCopattern -> PatternOrCopattern -> Bool
== :: PatternOrCopattern -> PatternOrCopattern -> Bool
$c/= :: PatternOrCopattern -> PatternOrCopattern -> Bool
/= :: PatternOrCopattern -> PatternOrCopattern -> Bool
Eq, Eq PatternOrCopattern
Eq PatternOrCopattern =>
(PatternOrCopattern -> PatternOrCopattern -> Ordering)
-> (PatternOrCopattern -> PatternOrCopattern -> Bool)
-> (PatternOrCopattern -> PatternOrCopattern -> Bool)
-> (PatternOrCopattern -> PatternOrCopattern -> Bool)
-> (PatternOrCopattern -> PatternOrCopattern -> Bool)
-> (PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern)
-> (PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern)
-> Ord PatternOrCopattern
PatternOrCopattern -> PatternOrCopattern -> Bool
PatternOrCopattern -> PatternOrCopattern -> Ordering
PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern
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
$ccompare :: PatternOrCopattern -> PatternOrCopattern -> Ordering
compare :: PatternOrCopattern -> PatternOrCopattern -> Ordering
$c< :: PatternOrCopattern -> PatternOrCopattern -> Bool
< :: PatternOrCopattern -> PatternOrCopattern -> Bool
$c<= :: PatternOrCopattern -> PatternOrCopattern -> Bool
<= :: PatternOrCopattern -> PatternOrCopattern -> Bool
$c> :: PatternOrCopattern -> PatternOrCopattern -> Bool
> :: PatternOrCopattern -> PatternOrCopattern -> Bool
$c>= :: PatternOrCopattern -> PatternOrCopattern -> Bool
>= :: PatternOrCopattern -> PatternOrCopattern -> Bool
$cmax :: PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern
max :: PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern
$cmin :: PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern
min :: PatternOrCopattern -> PatternOrCopattern -> PatternOrCopattern
Ord, Int -> PatternOrCopattern
PatternOrCopattern -> Int
PatternOrCopattern -> [PatternOrCopattern]
PatternOrCopattern -> PatternOrCopattern
PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
PatternOrCopattern
-> PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
(PatternOrCopattern -> PatternOrCopattern)
-> (PatternOrCopattern -> PatternOrCopattern)
-> (Int -> PatternOrCopattern)
-> (PatternOrCopattern -> Int)
-> (PatternOrCopattern -> [PatternOrCopattern])
-> (PatternOrCopattern
    -> PatternOrCopattern -> [PatternOrCopattern])
-> (PatternOrCopattern
    -> PatternOrCopattern -> [PatternOrCopattern])
-> (PatternOrCopattern
    -> PatternOrCopattern
    -> PatternOrCopattern
    -> [PatternOrCopattern])
-> Enum PatternOrCopattern
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PatternOrCopattern -> PatternOrCopattern
succ :: PatternOrCopattern -> PatternOrCopattern
$cpred :: PatternOrCopattern -> PatternOrCopattern
pred :: PatternOrCopattern -> PatternOrCopattern
$ctoEnum :: Int -> PatternOrCopattern
toEnum :: Int -> PatternOrCopattern
$cfromEnum :: PatternOrCopattern -> Int
fromEnum :: PatternOrCopattern -> Int
$cenumFrom :: PatternOrCopattern -> [PatternOrCopattern]
enumFrom :: PatternOrCopattern -> [PatternOrCopattern]
$cenumFromThen :: PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
enumFromThen :: PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
$cenumFromTo :: PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
enumFromTo :: PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
$cenumFromThenTo :: PatternOrCopattern
-> PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
enumFromThenTo :: PatternOrCopattern
-> PatternOrCopattern -> PatternOrCopattern -> [PatternOrCopattern]
Enum, PatternOrCopattern
PatternOrCopattern
-> PatternOrCopattern -> Bounded PatternOrCopattern
forall a. a -> a -> Bounded a
$cminBound :: PatternOrCopattern
minBound :: PatternOrCopattern
$cmaxBound :: PatternOrCopattern
maxBound :: PatternOrCopattern
Bounded)

instance NFData PatternOrCopattern where
  rnf :: PatternOrCopattern -> ()
rnf PatternOrCopattern
PatternMatching   = ()
  rnf PatternOrCopattern
CopatternMatching = ()

instance HasRange PatternOrCopattern where
  getRange :: PatternOrCopattern -> Range
getRange PatternOrCopattern
_ = Range
forall a. Range' a
noRange

instance KillRange PatternOrCopattern where
  killRange :: PatternOrCopattern -> PatternOrCopattern
killRange = PatternOrCopattern -> PatternOrCopattern
forall a. a -> a
id

-- | Can we pattern match on the record constructor?
class PatternMatchingAllowed a where
  patternMatchingAllowed :: a -> Bool

instance PatternMatchingAllowed PatternOrCopattern where
  patternMatchingAllowed :: PatternOrCopattern -> Bool
patternMatchingAllowed = (PatternOrCopattern -> PatternOrCopattern -> Bool
forall a. Eq a => a -> a -> Bool
== PatternOrCopattern
PatternMatching)

instance PatternMatchingAllowed HasEta where
  patternMatchingAllowed :: HasEta -> Bool
patternMatchingAllowed = \case
    HasEta
YesEta -> Bool
True
    NoEta PatternOrCopattern
p -> PatternOrCopattern -> Bool
forall a. PatternMatchingAllowed a => a -> Bool
patternMatchingAllowed PatternOrCopattern
p


-- | Can we construct a record by copattern matching?
class CopatternMatchingAllowed a where
  copatternMatchingAllowed :: a -> Bool

instance CopatternMatchingAllowed PatternOrCopattern where
  copatternMatchingAllowed :: PatternOrCopattern -> Bool
copatternMatchingAllowed = (PatternOrCopattern -> PatternOrCopattern -> Bool
forall a. Eq a => a -> a -> Bool
== PatternOrCopattern
CopatternMatching)

instance CopatternMatchingAllowed HasEta where
  copatternMatchingAllowed :: HasEta -> Bool
copatternMatchingAllowed = \case
    HasEta
YesEta -> Bool
True
    NoEta PatternOrCopattern
p -> PatternOrCopattern -> Bool
forall a. CopatternMatchingAllowed a => a -> Bool
copatternMatchingAllowed PatternOrCopattern
p

---------------------------------------------------------------------------
-- * Data or record
---------------------------------------------------------------------------

data DataOrRecord' p
  = IsData
  | IsRecord p
  deriving (Int -> DataOrRecord' p -> ShowS
[DataOrRecord' p] -> ShowS
DataOrRecord' p -> String
(Int -> DataOrRecord' p -> ShowS)
-> (DataOrRecord' p -> String)
-> ([DataOrRecord' p] -> ShowS)
-> Show (DataOrRecord' p)
forall p. Show p => Int -> DataOrRecord' p -> ShowS
forall p. Show p => [DataOrRecord' p] -> ShowS
forall p. Show p => DataOrRecord' p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Show p => Int -> DataOrRecord' p -> ShowS
showsPrec :: Int -> DataOrRecord' p -> ShowS
$cshow :: forall p. Show p => DataOrRecord' p -> String
show :: DataOrRecord' p -> String
$cshowList :: forall p. Show p => [DataOrRecord' p] -> ShowS
showList :: [DataOrRecord' p] -> ShowS
Show, DataOrRecord' p -> DataOrRecord' p -> Bool
(DataOrRecord' p -> DataOrRecord' p -> Bool)
-> (DataOrRecord' p -> DataOrRecord' p -> Bool)
-> Eq (DataOrRecord' p)
forall p. Eq p => DataOrRecord' p -> DataOrRecord' p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. Eq p => DataOrRecord' p -> DataOrRecord' p -> Bool
== :: DataOrRecord' p -> DataOrRecord' p -> Bool
$c/= :: forall p. Eq p => DataOrRecord' p -> DataOrRecord' p -> Bool
/= :: DataOrRecord' p -> DataOrRecord' p -> Bool
Eq, (forall x. DataOrRecord' p -> Rep (DataOrRecord' p) x)
-> (forall x. Rep (DataOrRecord' p) x -> DataOrRecord' p)
-> Generic (DataOrRecord' p)
forall x. Rep (DataOrRecord' p) x -> DataOrRecord' p
forall x. DataOrRecord' p -> Rep (DataOrRecord' p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (DataOrRecord' p) x -> DataOrRecord' p
forall p x. DataOrRecord' p -> Rep (DataOrRecord' p) x
$cfrom :: forall p x. DataOrRecord' p -> Rep (DataOrRecord' p) x
from :: forall x. DataOrRecord' p -> Rep (DataOrRecord' p) x
$cto :: forall p x. Rep (DataOrRecord' p) x -> DataOrRecord' p
to :: forall x. Rep (DataOrRecord' p) x -> DataOrRecord' p
Generic)

type DataOrRecord = DataOrRecord' PatternOrCopattern
type DataOrRecord_ = DataOrRecord' ()

pattern IsRecord_ :: DataOrRecord_
pattern $bIsRecord_ :: DataOrRecord_
$mIsRecord_ :: forall {r}. DataOrRecord_ -> ((# #) -> r) -> ((# #) -> r) -> r
IsRecord_ = IsRecord ()

{-# COMPLETE IsData, IsRecord_ #-}

instance Boolean DataOrRecord_ where
  fromBool :: Bool -> DataOrRecord_
fromBool Bool
True  = DataOrRecord_
forall p. DataOrRecord' p
IsData
  fromBool Bool
False = DataOrRecord_
IsRecord_

instance IsBool DataOrRecord_ where
  toBool :: DataOrRecord_ -> Bool
toBool DataOrRecord_
IsData    = Bool
True
  toBool DataOrRecord_
IsRecord_ = Bool
False

instance PatternMatchingAllowed DataOrRecord where
  patternMatchingAllowed :: DataOrRecord -> Bool
patternMatchingAllowed = \case
    DataOrRecord
IsData -> Bool
True
    IsRecord PatternOrCopattern
patCopat -> PatternOrCopattern -> Bool
forall a. PatternMatchingAllowed a => a -> Bool
patternMatchingAllowed PatternOrCopattern
patCopat

instance CopatternMatchingAllowed DataOrRecord where
  copatternMatchingAllowed :: DataOrRecord -> Bool
copatternMatchingAllowed = \case
    DataOrRecord
IsData -> Bool
False
    IsRecord PatternOrCopattern
patCopat -> PatternOrCopattern -> Bool
forall a. CopatternMatchingAllowed a => a -> Bool
copatternMatchingAllowed PatternOrCopattern
patCopat

instance NFData a => NFData (DataOrRecord' a)

instance KillRange DataOrRecord where
  killRange :: KillRangeT DataOrRecord
killRange = KillRangeT DataOrRecord
forall a. a -> a
id

---------------------------------------------------------------------------
-- * Induction
---------------------------------------------------------------------------

instance Pretty Induction where
  pretty :: Induction -> Doc
pretty Induction
Inductive   = Doc
"inductive"
  pretty Induction
CoInductive = Doc
"coinductive"

instance HasRange Induction where
  getRange :: Induction -> Range
getRange Induction
_ = Range
forall a. Range' a
noRange

instance KillRange Induction where
  killRange :: KillRangeT Induction
killRange = KillRangeT Induction
forall a. a -> a
id

instance PatternMatchingAllowed Induction where
  patternMatchingAllowed :: Induction -> Bool
patternMatchingAllowed = (Induction -> Induction -> Bool
forall a. Eq a => a -> a -> Bool
== Induction
Inductive)

---------------------------------------------------------------------------
-- * Overlapping instances
---------------------------------------------------------------------------

data Overlappable = YesOverlap | NoOverlap
  deriving (Int -> Overlappable -> ShowS
[Overlappable] -> ShowS
Overlappable -> String
(Int -> Overlappable -> ShowS)
-> (Overlappable -> String)
-> ([Overlappable] -> ShowS)
-> Show Overlappable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Overlappable -> ShowS
showsPrec :: Int -> Overlappable -> ShowS
$cshow :: Overlappable -> String
show :: Overlappable -> String
$cshowList :: [Overlappable] -> ShowS
showList :: [Overlappable] -> ShowS
Show, Overlappable -> Overlappable -> Bool
(Overlappable -> Overlappable -> Bool)
-> (Overlappable -> Overlappable -> Bool) -> Eq Overlappable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Overlappable -> Overlappable -> Bool
== :: Overlappable -> Overlappable -> Bool
$c/= :: Overlappable -> Overlappable -> Bool
/= :: Overlappable -> Overlappable -> Bool
Eq, Eq Overlappable
Eq Overlappable =>
(Overlappable -> Overlappable -> Ordering)
-> (Overlappable -> Overlappable -> Bool)
-> (Overlappable -> Overlappable -> Bool)
-> (Overlappable -> Overlappable -> Bool)
-> (Overlappable -> Overlappable -> Bool)
-> (Overlappable -> Overlappable -> Overlappable)
-> (Overlappable -> Overlappable -> Overlappable)
-> Ord Overlappable
Overlappable -> Overlappable -> Bool
Overlappable -> Overlappable -> Ordering
Overlappable -> Overlappable -> Overlappable
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
$ccompare :: Overlappable -> Overlappable -> Ordering
compare :: Overlappable -> Overlappable -> Ordering
$c< :: Overlappable -> Overlappable -> Bool
< :: Overlappable -> Overlappable -> Bool
$c<= :: Overlappable -> Overlappable -> Bool
<= :: Overlappable -> Overlappable -> Bool
$c> :: Overlappable -> Overlappable -> Bool
> :: Overlappable -> Overlappable -> Bool
$c>= :: Overlappable -> Overlappable -> Bool
>= :: Overlappable -> Overlappable -> Bool
$cmax :: Overlappable -> Overlappable -> Overlappable
max :: Overlappable -> Overlappable -> Overlappable
$cmin :: Overlappable -> Overlappable -> Overlappable
min :: Overlappable -> Overlappable -> Overlappable
Ord, Int -> Overlappable
Overlappable -> Int
Overlappable -> [Overlappable]
Overlappable -> Overlappable
Overlappable -> Overlappable -> [Overlappable]
Overlappable -> Overlappable -> Overlappable -> [Overlappable]
(Overlappable -> Overlappable)
-> (Overlappable -> Overlappable)
-> (Int -> Overlappable)
-> (Overlappable -> Int)
-> (Overlappable -> [Overlappable])
-> (Overlappable -> Overlappable -> [Overlappable])
-> (Overlappable -> Overlappable -> [Overlappable])
-> (Overlappable -> Overlappable -> Overlappable -> [Overlappable])
-> Enum Overlappable
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Overlappable -> Overlappable
succ :: Overlappable -> Overlappable
$cpred :: Overlappable -> Overlappable
pred :: Overlappable -> Overlappable
$ctoEnum :: Int -> Overlappable
toEnum :: Int -> Overlappable
$cfromEnum :: Overlappable -> Int
fromEnum :: Overlappable -> Int
$cenumFrom :: Overlappable -> [Overlappable]
enumFrom :: Overlappable -> [Overlappable]
$cenumFromThen :: Overlappable -> Overlappable -> [Overlappable]
enumFromThen :: Overlappable -> Overlappable -> [Overlappable]
$cenumFromTo :: Overlappable -> Overlappable -> [Overlappable]
enumFromTo :: Overlappable -> Overlappable -> [Overlappable]
$cenumFromThenTo :: Overlappable -> Overlappable -> Overlappable -> [Overlappable]
enumFromThenTo :: Overlappable -> Overlappable -> Overlappable -> [Overlappable]
Enum, Overlappable
Overlappable -> Overlappable -> Bounded Overlappable
forall a. a -> a -> Bounded a
$cminBound :: Overlappable
minBound :: Overlappable
$cmaxBound :: Overlappable
maxBound :: Overlappable
Bounded)

-- | Just for the 'Hiding' instance. Should never combine different
--   overlapping.
instance Semigroup Overlappable where
  Overlappable
NoOverlap  <> :: Overlappable -> Overlappable -> Overlappable
<> Overlappable
NoOverlap  = Overlappable
NoOverlap
  Overlappable
YesOverlap <> Overlappable
YesOverlap = Overlappable
YesOverlap
  Overlappable
_          <> Overlappable
_          = Overlappable
forall a. HasCallStack => a
__IMPOSSIBLE__

instance Monoid Overlappable where
  mempty :: Overlappable
mempty  = Overlappable
NoOverlap
  mappend :: Overlappable -> Overlappable -> Overlappable
mappend = Overlappable -> Overlappable -> Overlappable
forall a. Semigroup a => a -> a -> a
(<>)

instance NFData Overlappable where
  rnf :: Overlappable -> ()
rnf Overlappable
NoOverlap  = ()
  rnf Overlappable
YesOverlap = ()

-- | The possible overlap modes for an instance, also used for instance candidates.
data OverlapMode
  = Overlappable
  -- ^ User-written OVERLAPPABLE pragma: this candidate can *be removed*
  -- by a more specific candidate.

  | Overlapping
  -- ^ User-written OVERLAPPING pragma: this candidate can *remove* a
  -- less specific candidate.

  | Overlaps
  -- ^ User-written OVERLAPS pragma: both overlappable and overlapping.

  | DefaultOverlap
  -- ^ No user-written overlap pragma. This instance can be overlapped
  -- by an OVERLAPPING instance, and it can overlap OVERLAPPABLE
  -- instances.

  | Incoherent
  -- ^ User-written INCOHERENT pragma: both overlappable and
  -- overlapping; and, if there are multiple candidates after all
  -- overlap has been handled, make an arbitrary choice.

  | FieldOverlap
  -- ^ Overlapping instances in record fields.
  deriving (Int -> OverlapMode -> ShowS
[OverlapMode] -> ShowS
OverlapMode -> String
(Int -> OverlapMode -> ShowS)
-> (OverlapMode -> String)
-> ([OverlapMode] -> ShowS)
-> Show OverlapMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OverlapMode -> ShowS
showsPrec :: Int -> OverlapMode -> ShowS
$cshow :: OverlapMode -> String
show :: OverlapMode -> String
$cshowList :: [OverlapMode] -> ShowS
showList :: [OverlapMode] -> ShowS
Show, OverlapMode -> OverlapMode -> Bool
(OverlapMode -> OverlapMode -> Bool)
-> (OverlapMode -> OverlapMode -> Bool) -> Eq OverlapMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OverlapMode -> OverlapMode -> Bool
== :: OverlapMode -> OverlapMode -> Bool
$c/= :: OverlapMode -> OverlapMode -> Bool
/= :: OverlapMode -> OverlapMode -> Bool
Eq, Eq OverlapMode
Eq OverlapMode =>
(OverlapMode -> OverlapMode -> Ordering)
-> (OverlapMode -> OverlapMode -> Bool)
-> (OverlapMode -> OverlapMode -> Bool)
-> (OverlapMode -> OverlapMode -> Bool)
-> (OverlapMode -> OverlapMode -> Bool)
-> (OverlapMode -> OverlapMode -> OverlapMode)
-> (OverlapMode -> OverlapMode -> OverlapMode)
-> Ord OverlapMode
OverlapMode -> OverlapMode -> Bool
OverlapMode -> OverlapMode -> Ordering
OverlapMode -> OverlapMode -> OverlapMode
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
$ccompare :: OverlapMode -> OverlapMode -> Ordering
compare :: OverlapMode -> OverlapMode -> Ordering
$c< :: OverlapMode -> OverlapMode -> Bool
< :: OverlapMode -> OverlapMode -> Bool
$c<= :: OverlapMode -> OverlapMode -> Bool
<= :: OverlapMode -> OverlapMode -> Bool
$c> :: OverlapMode -> OverlapMode -> Bool
> :: OverlapMode -> OverlapMode -> Bool
$c>= :: OverlapMode -> OverlapMode -> Bool
>= :: OverlapMode -> OverlapMode -> Bool
$cmax :: OverlapMode -> OverlapMode -> OverlapMode
max :: OverlapMode -> OverlapMode -> OverlapMode
$cmin :: OverlapMode -> OverlapMode -> OverlapMode
min :: OverlapMode -> OverlapMode -> OverlapMode
Ord, Int -> OverlapMode
OverlapMode -> Int
OverlapMode -> [OverlapMode]
OverlapMode -> OverlapMode
OverlapMode -> OverlapMode -> [OverlapMode]
OverlapMode -> OverlapMode -> OverlapMode -> [OverlapMode]
(OverlapMode -> OverlapMode)
-> (OverlapMode -> OverlapMode)
-> (Int -> OverlapMode)
-> (OverlapMode -> Int)
-> (OverlapMode -> [OverlapMode])
-> (OverlapMode -> OverlapMode -> [OverlapMode])
-> (OverlapMode -> OverlapMode -> [OverlapMode])
-> (OverlapMode -> OverlapMode -> OverlapMode -> [OverlapMode])
-> Enum OverlapMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OverlapMode -> OverlapMode
succ :: OverlapMode -> OverlapMode
$cpred :: OverlapMode -> OverlapMode
pred :: OverlapMode -> OverlapMode
$ctoEnum :: Int -> OverlapMode
toEnum :: Int -> OverlapMode
$cfromEnum :: OverlapMode -> Int
fromEnum :: OverlapMode -> Int
$cenumFrom :: OverlapMode -> [OverlapMode]
enumFrom :: OverlapMode -> [OverlapMode]
$cenumFromThen :: OverlapMode -> OverlapMode -> [OverlapMode]
enumFromThen :: OverlapMode -> OverlapMode -> [OverlapMode]
$cenumFromTo :: OverlapMode -> OverlapMode -> [OverlapMode]
enumFromTo :: OverlapMode -> OverlapMode -> [OverlapMode]
$cenumFromThenTo :: OverlapMode -> OverlapMode -> OverlapMode -> [OverlapMode]
enumFromThenTo :: OverlapMode -> OverlapMode -> OverlapMode -> [OverlapMode]
Enum, OverlapMode
OverlapMode -> OverlapMode -> Bounded OverlapMode
forall a. a -> a -> Bounded a
$cminBound :: OverlapMode
minBound :: OverlapMode
$cmaxBound :: OverlapMode
maxBound :: OverlapMode
Bounded)

instance Pretty OverlapMode where
  pretty :: OverlapMode -> Doc
pretty = \case
    OverlapMode
Overlappable   -> Doc
"OVERLAPPABLE"
    OverlapMode
Overlapping    -> Doc
"OVERLAPPING"
    OverlapMode
Incoherent     -> Doc
"INCOHERENT"
    OverlapMode
Overlaps       -> Doc
"OVERLAPS"
    OverlapMode
FieldOverlap   -> Doc
"overlap"
    OverlapMode
DefaultOverlap -> Doc
forall a. Null a => a
empty

instance KillRange OverlapMode where
  killRange :: OverlapMode -> OverlapMode
killRange = OverlapMode -> OverlapMode
forall a. a -> a
id

instance NFData OverlapMode where
  rnf :: OverlapMode -> ()
rnf = \case
    OverlapMode
Overlappable   -> ()
    OverlapMode
Overlapping    -> ()
    OverlapMode
Overlaps       -> ()
    OverlapMode
DefaultOverlap -> ()
    OverlapMode
FieldOverlap   -> ()
    OverlapMode
Incoherent     -> ()

class HasOverlapMode a where
  lensOverlapMode :: Lens' a OverlapMode

instance HasOverlapMode OverlapMode where
  lensOverlapMode :: Lens' OverlapMode OverlapMode
lensOverlapMode = (OverlapMode -> f OverlapMode) -> OverlapMode -> f OverlapMode
forall a. a -> a
id

isIncoherent, isOverlappable, isOverlapping :: HasOverlapMode a => a -> Bool
isIncoherent :: forall a. HasOverlapMode a => a -> Bool
isIncoherent a
x = case a
x a -> Getting OverlapMode a OverlapMode -> OverlapMode
forall s a. s -> Getting a s a -> a
^. Getting OverlapMode a OverlapMode
forall a. HasOverlapMode a => Lens' a OverlapMode
Lens' a OverlapMode
lensOverlapMode of
  OverlapMode
Incoherent -> Bool
True
  OverlapMode
_          -> Bool
False

isOverlappable :: forall a. HasOverlapMode a => a -> Bool
isOverlappable a
x = case a
x a -> Getting OverlapMode a OverlapMode -> OverlapMode
forall s a. s -> Getting a s a -> a
^. Getting OverlapMode a OverlapMode
forall a. HasOverlapMode a => Lens' a OverlapMode
Lens' a OverlapMode
lensOverlapMode of
  OverlapMode
Overlappable -> Bool
True
  OverlapMode
Incoherent   -> Bool
True
  OverlapMode
Overlaps     -> Bool
True
  OverlapMode
_            -> Bool
False

isOverlapping :: forall a. HasOverlapMode a => a -> Bool
isOverlapping a
x = case a
x a -> Getting OverlapMode a OverlapMode -> OverlapMode
forall s a. s -> Getting a s a -> a
^. Getting OverlapMode a OverlapMode
forall a. HasOverlapMode a => Lens' a OverlapMode
Lens' a OverlapMode
lensOverlapMode of
  OverlapMode
Overlapping -> Bool
True
  OverlapMode
Incoherent  -> Bool
True
  OverlapMode
Overlaps    -> Bool
True
  OverlapMode
_           -> Bool
False

---------------------------------------------------------------------------
-- * Hiding
---------------------------------------------------------------------------

data Hiding  = Hidden | Instance Overlappable | NotHidden
  deriving (Int -> Hiding -> ShowS
[Hiding] -> ShowS
Hiding -> String
(Int -> Hiding -> ShowS)
-> (Hiding -> String) -> ([Hiding] -> ShowS) -> Show Hiding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hiding -> ShowS
showsPrec :: Int -> Hiding -> ShowS
$cshow :: Hiding -> String
show :: Hiding -> String
$cshowList :: [Hiding] -> ShowS
showList :: [Hiding] -> ShowS
Show, Hiding -> Hiding -> Bool
(Hiding -> Hiding -> Bool)
-> (Hiding -> Hiding -> Bool) -> Eq Hiding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hiding -> Hiding -> Bool
== :: Hiding -> Hiding -> Bool
$c/= :: Hiding -> Hiding -> Bool
/= :: Hiding -> Hiding -> Bool
Eq, Eq Hiding
Eq Hiding =>
(Hiding -> Hiding -> Ordering)
-> (Hiding -> Hiding -> Bool)
-> (Hiding -> Hiding -> Bool)
-> (Hiding -> Hiding -> Bool)
-> (Hiding -> Hiding -> Bool)
-> (Hiding -> Hiding -> Hiding)
-> (Hiding -> Hiding -> Hiding)
-> Ord Hiding
Hiding -> Hiding -> Bool
Hiding -> Hiding -> Ordering
Hiding -> Hiding -> Hiding
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
$ccompare :: Hiding -> Hiding -> Ordering
compare :: Hiding -> Hiding -> Ordering
$c< :: Hiding -> Hiding -> Bool
< :: Hiding -> Hiding -> Bool
$c<= :: Hiding -> Hiding -> Bool
<= :: Hiding -> Hiding -> Bool
$c> :: Hiding -> Hiding -> Bool
> :: Hiding -> Hiding -> Bool
$c>= :: Hiding -> Hiding -> Bool
>= :: Hiding -> Hiding -> Bool
$cmax :: Hiding -> Hiding -> Hiding
max :: Hiding -> Hiding -> Hiding
$cmin :: Hiding -> Hiding -> Hiding
min :: Hiding -> Hiding -> Hiding
Ord, (forall x. Hiding -> Rep Hiding x)
-> (forall x. Rep Hiding x -> Hiding) -> Generic Hiding
forall x. Rep Hiding x -> Hiding
forall x. Hiding -> Rep Hiding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hiding -> Rep Hiding x
from :: forall x. Hiding -> Rep Hiding x
$cto :: forall x. Rep Hiding x -> Hiding
to :: forall x. Rep Hiding x -> Hiding
Generic)
  deriving (Int -> Hiding
Hiding -> Int
Hiding -> [Hiding]
Hiding -> Hiding
Hiding -> Hiding -> [Hiding]
Hiding -> Hiding -> Hiding -> [Hiding]
(Hiding -> Hiding)
-> (Hiding -> Hiding)
-> (Int -> Hiding)
-> (Hiding -> Int)
-> (Hiding -> [Hiding])
-> (Hiding -> Hiding -> [Hiding])
-> (Hiding -> Hiding -> [Hiding])
-> (Hiding -> Hiding -> Hiding -> [Hiding])
-> Enum Hiding
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Hiding -> Hiding
succ :: Hiding -> Hiding
$cpred :: Hiding -> Hiding
pred :: Hiding -> Hiding
$ctoEnum :: Int -> Hiding
toEnum :: Int -> Hiding
$cfromEnum :: Hiding -> Int
fromEnum :: Hiding -> Int
$cenumFrom :: Hiding -> [Hiding]
enumFrom :: Hiding -> [Hiding]
$cenumFromThen :: Hiding -> Hiding -> [Hiding]
enumFromThen :: Hiding -> Hiding -> [Hiding]
$cenumFromTo :: Hiding -> Hiding -> [Hiding]
enumFromTo :: Hiding -> Hiding -> [Hiding]
$cenumFromThenTo :: Hiding -> Hiding -> Hiding -> [Hiding]
enumFromThenTo :: Hiding -> Hiding -> Hiding -> [Hiding]
Enum, Hiding
Hiding -> Hiding -> Bounded Hiding
forall a. a -> a -> Bounded a
$cminBound :: Hiding
minBound :: Hiding
$cmaxBound :: Hiding
maxBound :: Hiding
Bounded) via (FiniteEnumeration Hiding)

instance Pretty Hiding where
  pretty :: Hiding -> Doc
pretty = String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> (Hiding -> String) -> Hiding -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hiding -> String
hidingToString

hidingToString :: Hiding -> String
hidingToString :: Hiding -> String
hidingToString = \case
  Hiding
Hidden     -> String
"implicit"
  Hiding
NotHidden  -> String
"visible"
  Instance{} -> String
"instance"

instance Null Hiding where
  empty :: Hiding
empty = Hiding
NotHidden

-- | 'Hiding' is an idempotent partial monoid, with unit 'NotHidden'.
--   'Instance' and 'NotHidden' are incompatible.
instance Semigroup Hiding where
  Hiding
NotHidden  <> :: Hiding -> Hiding -> Hiding
<> Hiding
h           = Hiding
h
  Hiding
h          <> Hiding
NotHidden   = Hiding
h
  Hiding
Hidden     <> Hiding
Hidden      = Hiding
Hidden
  Instance Overlappable
o <> Instance Overlappable
o' = Overlappable -> Hiding
Instance (Overlappable
o Overlappable -> Overlappable -> Overlappable
forall a. Semigroup a => a -> a -> a
<> Overlappable
o')
  Hiding
_          <> Hiding
_           = Hiding
forall a. HasCallStack => a
__IMPOSSIBLE__

instance Monoid Hiding where
  mempty :: Hiding
mempty = Hiding
forall a. Null a => a
empty
  mappend :: Hiding -> Hiding -> Hiding
mappend = Hiding -> Hiding -> Hiding
forall a. Semigroup a => a -> a -> a
(<>)

instance HasRange Hiding where
  getRange :: Hiding -> Range
getRange Hiding
_ = Range
forall a. Range' a
noRange

instance KillRange Hiding where
  killRange :: Hiding -> Hiding
killRange = Hiding -> Hiding
forall a. a -> a
id

instance NFData Hiding where
  rnf :: Hiding -> ()
rnf Hiding
Hidden       = ()
  rnf (Instance Overlappable
o) = Overlappable -> ()
forall a. NFData a => a -> ()
rnf Overlappable
o
  rnf Hiding
NotHidden    = ()

-- | Decorating something with 'Hiding' information.
data WithHiding a = WithHiding
  { forall a. WithHiding a -> Hiding
whHiding :: !Hiding
  , forall a. WithHiding a -> a
whThing  :: a
  }
  deriving (WithHiding a -> WithHiding a -> Bool
(WithHiding a -> WithHiding a -> Bool)
-> (WithHiding a -> WithHiding a -> Bool) -> Eq (WithHiding a)
forall a. Eq a => WithHiding a -> WithHiding a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithHiding a -> WithHiding a -> Bool
== :: WithHiding a -> WithHiding a -> Bool
$c/= :: forall a. Eq a => WithHiding a -> WithHiding a -> Bool
/= :: WithHiding a -> WithHiding a -> Bool
Eq, Eq (WithHiding a)
Eq (WithHiding a) =>
(WithHiding a -> WithHiding a -> Ordering)
-> (WithHiding a -> WithHiding a -> Bool)
-> (WithHiding a -> WithHiding a -> Bool)
-> (WithHiding a -> WithHiding a -> Bool)
-> (WithHiding a -> WithHiding a -> Bool)
-> (WithHiding a -> WithHiding a -> WithHiding a)
-> (WithHiding a -> WithHiding a -> WithHiding a)
-> Ord (WithHiding a)
WithHiding a -> WithHiding a -> Bool
WithHiding a -> WithHiding a -> Ordering
WithHiding a -> WithHiding a -> WithHiding a
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
forall a. Ord a => Eq (WithHiding a)
forall a. Ord a => WithHiding a -> WithHiding a -> Bool
forall a. Ord a => WithHiding a -> WithHiding a -> Ordering
forall a. Ord a => WithHiding a -> WithHiding a -> WithHiding a
$ccompare :: forall a. Ord a => WithHiding a -> WithHiding a -> Ordering
compare :: WithHiding a -> WithHiding a -> Ordering
$c< :: forall a. Ord a => WithHiding a -> WithHiding a -> Bool
< :: WithHiding a -> WithHiding a -> Bool
$c<= :: forall a. Ord a => WithHiding a -> WithHiding a -> Bool
<= :: WithHiding a -> WithHiding a -> Bool
$c> :: forall a. Ord a => WithHiding a -> WithHiding a -> Bool
> :: WithHiding a -> WithHiding a -> Bool
$c>= :: forall a. Ord a => WithHiding a -> WithHiding a -> Bool
>= :: WithHiding a -> WithHiding a -> Bool
$cmax :: forall a. Ord a => WithHiding a -> WithHiding a -> WithHiding a
max :: WithHiding a -> WithHiding a -> WithHiding a
$cmin :: forall a. Ord a => WithHiding a -> WithHiding a -> WithHiding a
min :: WithHiding a -> WithHiding a -> WithHiding a
Ord, Int -> WithHiding a -> ShowS
[WithHiding a] -> ShowS
WithHiding a -> String
(Int -> WithHiding a -> ShowS)
-> (WithHiding a -> String)
-> ([WithHiding a] -> ShowS)
-> Show (WithHiding a)
forall a. Show a => Int -> WithHiding a -> ShowS
forall a. Show a => [WithHiding a] -> ShowS
forall a. Show a => WithHiding a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithHiding a -> ShowS
showsPrec :: Int -> WithHiding a -> ShowS
$cshow :: forall a. Show a => WithHiding a -> String
show :: WithHiding a -> String
$cshowList :: forall a. Show a => [WithHiding a] -> ShowS
showList :: [WithHiding a] -> ShowS
Show, (forall a b. (a -> b) -> WithHiding a -> WithHiding b)
-> (forall a b. a -> WithHiding b -> WithHiding a)
-> Functor WithHiding
forall a b. a -> WithHiding b -> WithHiding a
forall a b. (a -> b) -> WithHiding a -> WithHiding b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithHiding a -> WithHiding b
fmap :: forall a b. (a -> b) -> WithHiding a -> WithHiding b
$c<$ :: forall a b. a -> WithHiding b -> WithHiding a
<$ :: forall a b. a -> WithHiding b -> WithHiding a
Functor, (forall m. Monoid m => WithHiding m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithHiding a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithHiding a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithHiding a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithHiding a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithHiding a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithHiding a -> b)
-> (forall a. (a -> a -> a) -> WithHiding a -> a)
-> (forall a. (a -> a -> a) -> WithHiding a -> a)
-> (forall a. WithHiding a -> [a])
-> (forall a. WithHiding a -> Bool)
-> (forall a. WithHiding a -> Int)
-> (forall a. Eq a => a -> WithHiding a -> Bool)
-> (forall a. Ord a => WithHiding a -> a)
-> (forall a. Ord a => WithHiding a -> a)
-> (forall a. Num a => WithHiding a -> a)
-> (forall a. Num a => WithHiding a -> a)
-> Foldable WithHiding
forall a. Eq a => a -> WithHiding a -> Bool
forall a. Num a => WithHiding a -> a
forall a. Ord a => WithHiding a -> a
forall m. Monoid m => WithHiding m -> m
forall a. WithHiding a -> Bool
forall a. WithHiding a -> Int
forall a. WithHiding a -> [a]
forall a. (a -> a -> a) -> WithHiding a -> a
forall m a. Monoid m => (a -> m) -> WithHiding a -> m
forall b a. (b -> a -> b) -> b -> WithHiding a -> b
forall a b. (a -> b -> b) -> b -> WithHiding a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithHiding m -> m
fold :: forall m. Monoid m => WithHiding m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithHiding a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithHiding a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithHiding a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithHiding a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithHiding a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithHiding a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithHiding a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithHiding a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithHiding a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithHiding a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithHiding a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithHiding a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithHiding a -> a
foldr1 :: forall a. (a -> a -> a) -> WithHiding a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithHiding a -> a
foldl1 :: forall a. (a -> a -> a) -> WithHiding a -> a
$ctoList :: forall a. WithHiding a -> [a]
toList :: forall a. WithHiding a -> [a]
$cnull :: forall a. WithHiding a -> Bool
null :: forall a. WithHiding a -> Bool
$clength :: forall a. WithHiding a -> Int
length :: forall a. WithHiding a -> Int
$celem :: forall a. Eq a => a -> WithHiding a -> Bool
elem :: forall a. Eq a => a -> WithHiding a -> Bool
$cmaximum :: forall a. Ord a => WithHiding a -> a
maximum :: forall a. Ord a => WithHiding a -> a
$cminimum :: forall a. Ord a => WithHiding a -> a
minimum :: forall a. Ord a => WithHiding a -> a
$csum :: forall a. Num a => WithHiding a -> a
sum :: forall a. Num a => WithHiding a -> a
$cproduct :: forall a. Num a => WithHiding a -> a
product :: forall a. Num a => WithHiding a -> a
Foldable, Functor WithHiding
Foldable WithHiding
(Functor WithHiding, Foldable WithHiding) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WithHiding a -> f (WithHiding b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithHiding (f a) -> f (WithHiding a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithHiding a -> m (WithHiding b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithHiding (m a) -> m (WithHiding a))
-> Traversable WithHiding
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithHiding (m a) -> m (WithHiding a)
forall (f :: * -> *) a.
Applicative f =>
WithHiding (f a) -> f (WithHiding a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithHiding a -> m (WithHiding b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithHiding a -> f (WithHiding b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithHiding a -> f (WithHiding b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithHiding a -> f (WithHiding b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithHiding (f a) -> f (WithHiding a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithHiding (f a) -> f (WithHiding a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithHiding a -> m (WithHiding b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithHiding a -> m (WithHiding b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithHiding (m a) -> m (WithHiding a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithHiding (m a) -> m (WithHiding a)
Traversable)

instance Decoration WithHiding where
  traverseF :: forall (m :: * -> *) a b.
Functor m =>
(a -> m b) -> WithHiding a -> m (WithHiding b)
traverseF a -> m b
f (WithHiding Hiding
h a
a) = Hiding -> b -> WithHiding b
forall a. Hiding -> a -> WithHiding a
WithHiding Hiding
h (b -> WithHiding b) -> m b -> m (WithHiding b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a

instance Applicative WithHiding where
  pure :: forall a. a -> WithHiding a
pure = Hiding -> a -> WithHiding a
forall a. Hiding -> a -> WithHiding a
WithHiding Hiding
forall a. Monoid a => a
mempty
  WithHiding Hiding
h a -> b
f <*> :: forall a b. WithHiding (a -> b) -> WithHiding a -> WithHiding b
<*> WithHiding Hiding
h' a
a = Hiding -> b -> WithHiding b
forall a. Hiding -> a -> WithHiding a
WithHiding (Hiding -> Hiding -> Hiding
forall a. Monoid a => a -> a -> a
mappend Hiding
h Hiding
h') (a -> b
f a
a)

instance HasRange a => HasRange (WithHiding a) where
  getRange :: WithHiding a -> Range
getRange = a -> Range
forall a. HasRange a => a -> Range
getRange (a -> Range) -> (WithHiding a -> a) -> WithHiding a -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithHiding a -> a
forall (t :: * -> *) a. Decoration t => t a -> a
dget

instance SetRange a => SetRange (WithHiding a) where
  setRange :: Range -> WithHiding a -> WithHiding a
setRange = (a -> a) -> WithHiding a -> WithHiding a
forall a b. (a -> b) -> WithHiding a -> WithHiding b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> WithHiding a -> WithHiding a)
-> (Range -> a -> a) -> Range -> WithHiding a -> WithHiding a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> a -> a
forall a. SetRange a => Range -> a -> a
setRange

instance KillRange a => KillRange (WithHiding a) where
  killRange :: KillRangeT (WithHiding a)
killRange = (a -> a) -> KillRangeT (WithHiding a)
forall a b. (a -> b) -> WithHiding a -> WithHiding b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. KillRange a => KillRangeT a
killRange

instance NFData a => NFData (WithHiding a) where
  rnf :: WithHiding a -> ()
rnf (WithHiding Hiding
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

-- | A lens to access the 'Hiding' attribute in data structures.
--   Minimal implementation: @getHiding@ and @mapHiding@ or @LensArgInfo@.
class LensHiding a where

  getHiding :: a -> Hiding

  setHiding :: Hiding -> a -> a
  setHiding Hiding
h = (Hiding -> Hiding) -> a -> a
forall a. LensHiding a => (Hiding -> Hiding) -> a -> a
mapHiding (Hiding -> Hiding -> Hiding
forall a b. a -> b -> a
const Hiding
h)

  mapHiding :: (Hiding -> Hiding) -> a -> a

  default getHiding :: LensArgInfo a => a -> Hiding
  getHiding = ArgInfo -> Hiding
argInfoHiding (ArgInfo -> Hiding) -> (a -> ArgInfo) -> a -> Hiding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo

  default mapHiding :: LensArgInfo a => (Hiding -> Hiding) -> a -> a
  mapHiding Hiding -> Hiding
f = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a) -> (ArgInfo -> ArgInfo) -> a -> a
forall a b. (a -> b) -> a -> b
$ \ ArgInfo
ai -> ArgInfo
ai { argInfoHiding = f $ argInfoHiding ai }

instance LensHiding Hiding where
  getHiding :: Hiding -> Hiding
getHiding = Hiding -> Hiding
forall a. a -> a
id
  setHiding :: Hiding -> Hiding -> Hiding
setHiding = Hiding -> Hiding -> Hiding
forall a b. a -> b -> a
const
  mapHiding :: (Hiding -> Hiding) -> Hiding -> Hiding
mapHiding = (Hiding -> Hiding) -> Hiding -> Hiding
forall a. a -> a
id

instance LensHiding (WithHiding a) where
  getHiding :: WithHiding a -> Hiding
getHiding   (WithHiding Hiding
h a
_) = Hiding
h
  setHiding :: Hiding -> WithHiding a -> WithHiding a
setHiding Hiding
h (WithHiding Hiding
_ a
a) = Hiding -> a -> WithHiding a
forall a. Hiding -> a -> WithHiding a
WithHiding Hiding
h a
a
  mapHiding :: (Hiding -> Hiding) -> WithHiding a -> WithHiding a
mapHiding Hiding -> Hiding
f (WithHiding Hiding
h a
a) = Hiding -> a -> WithHiding a
forall a. Hiding -> a -> WithHiding a
WithHiding (Hiding -> Hiding
f Hiding
h) a
a

instance LensHiding a => LensHiding (Named nm a) where
  getHiding :: Named nm a -> Hiding
getHiding = a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding (a -> Hiding) -> (Named nm a -> a) -> Named nm a -> Hiding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named nm a -> a
forall name a. Named name a -> a
namedThing
  setHiding :: Hiding -> Named nm a -> Named nm a
setHiding = (a -> a) -> Named nm a -> Named nm a
forall a b. (a -> b) -> Named nm a -> Named nm b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Named nm a -> Named nm a)
-> (Hiding -> a -> a) -> Hiding -> Named nm a -> Named nm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hiding -> a -> a
forall a. LensHiding a => Hiding -> a -> a
setHiding
  mapHiding :: (Hiding -> Hiding) -> Named nm a -> Named nm a
mapHiding = (a -> a) -> Named nm a -> Named nm a
forall a b. (a -> b) -> Named nm a -> Named nm b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Named nm a -> Named nm a)
-> ((Hiding -> Hiding) -> a -> a)
-> (Hiding -> Hiding)
-> Named nm a
-> Named nm a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hiding -> Hiding) -> a -> a
forall a. LensHiding a => (Hiding -> Hiding) -> a -> a
mapHiding

-- | 'NotHidden' arguments are @visible@.
visible :: LensHiding a => a -> Bool
visible :: forall a. LensHiding a => a -> Bool
visible a
a = a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
a Hiding -> Hiding -> Bool
forall a. Eq a => a -> a -> Bool
== Hiding
NotHidden

-- | 'Instance' and 'Hidden' arguments are @notVisible@.
notVisible :: LensHiding a => a -> Bool
notVisible :: forall a. LensHiding a => a -> Bool
notVisible a
a = a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
a Hiding -> Hiding -> Bool
forall a. Eq a => a -> a -> Bool
/= Hiding
NotHidden

-- | 'Hidden' arguments are @hidden@.
hidden :: LensHiding a => a -> Bool
hidden :: forall a. LensHiding a => a -> Bool
hidden a
a = a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
a Hiding -> Hiding -> Bool
forall a. Eq a => a -> a -> Bool
== Hiding
Hidden

hide :: LensHiding a => a -> a
hide :: forall a. LensHiding a => a -> a
hide = Hiding -> a -> a
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden

-- | Hide a 'NotHidden' thing.
hideExplicit :: LensHiding a => a -> a
hideExplicit :: forall a. LensHiding a => a -> a
hideExplicit a
x =
  case a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
x of
    Hiding
Hidden     -> a
x
    Instance{} -> a
x
    Hiding
NotHidden  -> Hiding -> a -> a
forall a. LensHiding a => Hiding -> a -> a
setHiding Hiding
Hidden a
x

makeInstance :: LensHiding a => a -> a
makeInstance :: forall a. LensHiding a => a -> a
makeInstance = Overlappable -> a -> a
forall a. LensHiding a => Overlappable -> a -> a
makeInstance' Overlappable
NoOverlap

makeInstance' :: LensHiding a => Overlappable -> a -> a
makeInstance' :: forall a. LensHiding a => Overlappable -> a -> a
makeInstance' Overlappable
o = Hiding -> a -> a
forall a. LensHiding a => Hiding -> a -> a
setHiding (Overlappable -> Hiding
Instance Overlappable
o)

isYesOverlap :: LensHiding a => a -> Bool
isYesOverlap :: forall a. LensHiding a => a -> Bool
isYesOverlap a
x =
  case a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
x of
    Instance Overlappable
YesOverlap -> Bool
True
    Hiding
_ -> Bool
False

isInstance :: LensHiding a => a -> Bool
isInstance :: forall a. LensHiding a => a -> Bool
isInstance a
x =
  case a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
x of
    Instance{} -> Bool
True
    Hiding
_          -> Bool
False

-- | Ignores 'Overlappable'.
sameHiding :: (LensHiding a, LensHiding b) => a -> b -> Bool
sameHiding :: forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
sameHiding a
x b
y =
  case (a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
x, b -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding b
y) of
    (Instance{}, Instance{}) -> Bool
True
    (Hiding
hx, Hiding
hy)                 -> Hiding
hx Hiding -> Hiding -> Bool
forall a. Eq a => a -> a -> Bool
== Hiding
hy

-- | @prettyHiding info visible doc@ puts the correct braces
--   around @doc@ according to info @info@ and returns
--   @visible doc@ if the we deal with a visible thing.
prettyHiding :: LensHiding a => a -> (Doc -> Doc) -> Doc -> Doc
prettyHiding :: forall a. LensHiding a => a -> (Doc -> Doc) -> Doc -> Doc
prettyHiding a
a Doc -> Doc
parens =
  case a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
a of
    Hiding
Hidden     -> Doc -> Doc
braces'
    Instance{} -> Doc -> Doc
dbraces
    Hiding
NotHidden  -> Doc -> Doc
parens

pDom :: LensHiding a => a -> Doc -> Doc
pDom :: forall a. LensHiding a => a -> Doc -> Doc
pDom a
x = a -> (Doc -> Doc) -> Doc -> Doc
forall a. LensHiding a => a -> (Doc -> Doc) -> Doc -> Doc
prettyHiding a
x Doc -> Doc
parens

instance Pretty a => Pretty (WithHiding a) where
  pretty :: WithHiding a -> Doc
pretty WithHiding a
w = WithHiding a -> (Doc -> Doc) -> Doc -> Doc
forall a. LensHiding a => a -> (Doc -> Doc) -> Doc -> Doc
prettyHiding WithHiding a
w Doc -> Doc
forall a. a -> a
id (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> Doc) -> a -> Doc
forall a b. (a -> b) -> a -> b
$ WithHiding a -> a
forall (t :: * -> *) a. Decoration t => t a -> a
dget WithHiding a
w

unArgKeepHiding :: Arg a -> WithHiding a
unArgKeepHiding :: forall a. Arg a -> WithHiding a
unArgKeepHiding (Arg ArgInfo
i a
a) = Hiding -> a -> WithHiding a
forall a. Hiding -> a -> WithHiding a
WithHiding (ArgInfo -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding ArgInfo
i) a
a

---------------------------------------------------------------------------
-- * Origin of arguments (user-written, inserted or reflected)
---------------------------------------------------------------------------

-- | Origin of arguments.
data Origin
  = UserWritten     -- ^ From the source file / user input.  (Preserve!)
  | Inserted        -- ^ E.g. inserted hidden arguments.
  | Reflected       -- ^ Produced by the reflection machinery.
  | CaseSplit       -- ^ Produced by an interactive case split.
  | Substitution    -- ^ Named application produced to represent a substitution. E.g. "?0 (x = n)" instead of "?0 n"
  | ExpandedPun     -- ^ An expanded hidden argument pun.
  | Generalization  -- ^ Inserted by the generalization process
  | ConversionFail
    -- ^ Inserted by the conversion checker in an argument spine at the
    -- position where they differ.
    --
    -- Indicates that the argument at this position should always be
    -- reified, even if the visibility would be skipped with
    -- the current flags.
  | RecordSelf
  -- ^ Inserted to stand for the record "self" variable when checking a
  -- declaration inside a record module.
  deriving (Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
(Int -> Origin -> ShowS)
-> (Origin -> String) -> ([Origin] -> ShowS) -> Show Origin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Origin -> ShowS
showsPrec :: Int -> Origin -> ShowS
$cshow :: Origin -> String
show :: Origin -> String
$cshowList :: [Origin] -> ShowS
showList :: [Origin] -> ShowS
Show, Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
/= :: Origin -> Origin -> Bool
Eq, Eq Origin
Eq Origin =>
(Origin -> Origin -> Ordering)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Origin)
-> (Origin -> Origin -> Origin)
-> Ord Origin
Origin -> Origin -> Bool
Origin -> Origin -> Ordering
Origin -> Origin -> Origin
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
$ccompare :: Origin -> Origin -> Ordering
compare :: Origin -> Origin -> Ordering
$c< :: Origin -> Origin -> Bool
< :: Origin -> Origin -> Bool
$c<= :: Origin -> Origin -> Bool
<= :: Origin -> Origin -> Bool
$c> :: Origin -> Origin -> Bool
> :: Origin -> Origin -> Bool
$c>= :: Origin -> Origin -> Bool
>= :: Origin -> Origin -> Bool
$cmax :: Origin -> Origin -> Origin
max :: Origin -> Origin -> Origin
$cmin :: Origin -> Origin -> Origin
min :: Origin -> Origin -> Origin
Ord)

instance HasRange Origin where
  getRange :: Origin -> Range
getRange Origin
_ = Range
forall a. Range' a
noRange

instance KillRange Origin where
  killRange :: Origin -> Origin
killRange = Origin -> Origin
forall a. a -> a
id

instance NFData Origin where
  rnf :: Origin -> ()
rnf Origin
UserWritten    = ()
  rnf Origin
Inserted       = ()
  rnf Origin
Reflected      = ()
  rnf Origin
CaseSplit      = ()
  rnf Origin
Substitution   = ()
  rnf Origin
ExpandedPun    = ()
  rnf Origin
Generalization = ()
  rnf Origin
ConversionFail = ()
  rnf Origin
RecordSelf     = ()

-- | Decorating something with 'Origin' information.
data WithOrigin a = WithOrigin
  { forall a. WithOrigin a -> Origin
woOrigin :: !Origin
  , forall a. WithOrigin a -> a
woThing  :: a
  }
  deriving (WithOrigin a -> WithOrigin a -> Bool
(WithOrigin a -> WithOrigin a -> Bool)
-> (WithOrigin a -> WithOrigin a -> Bool) -> Eq (WithOrigin a)
forall a. Eq a => WithOrigin a -> WithOrigin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithOrigin a -> WithOrigin a -> Bool
== :: WithOrigin a -> WithOrigin a -> Bool
$c/= :: forall a. Eq a => WithOrigin a -> WithOrigin a -> Bool
/= :: WithOrigin a -> WithOrigin a -> Bool
Eq, Eq (WithOrigin a)
Eq (WithOrigin a) =>
(WithOrigin a -> WithOrigin a -> Ordering)
-> (WithOrigin a -> WithOrigin a -> Bool)
-> (WithOrigin a -> WithOrigin a -> Bool)
-> (WithOrigin a -> WithOrigin a -> Bool)
-> (WithOrigin a -> WithOrigin a -> Bool)
-> (WithOrigin a -> WithOrigin a -> WithOrigin a)
-> (WithOrigin a -> WithOrigin a -> WithOrigin a)
-> Ord (WithOrigin a)
WithOrigin a -> WithOrigin a -> Bool
WithOrigin a -> WithOrigin a -> Ordering
WithOrigin a -> WithOrigin a -> WithOrigin a
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
forall a. Ord a => Eq (WithOrigin a)
forall a. Ord a => WithOrigin a -> WithOrigin a -> Bool
forall a. Ord a => WithOrigin a -> WithOrigin a -> Ordering
forall a. Ord a => WithOrigin a -> WithOrigin a -> WithOrigin a
$ccompare :: forall a. Ord a => WithOrigin a -> WithOrigin a -> Ordering
compare :: WithOrigin a -> WithOrigin a -> Ordering
$c< :: forall a. Ord a => WithOrigin a -> WithOrigin a -> Bool
< :: WithOrigin a -> WithOrigin a -> Bool
$c<= :: forall a. Ord a => WithOrigin a -> WithOrigin a -> Bool
<= :: WithOrigin a -> WithOrigin a -> Bool
$c> :: forall a. Ord a => WithOrigin a -> WithOrigin a -> Bool
> :: WithOrigin a -> WithOrigin a -> Bool
$c>= :: forall a. Ord a => WithOrigin a -> WithOrigin a -> Bool
>= :: WithOrigin a -> WithOrigin a -> Bool
$cmax :: forall a. Ord a => WithOrigin a -> WithOrigin a -> WithOrigin a
max :: WithOrigin a -> WithOrigin a -> WithOrigin a
$cmin :: forall a. Ord a => WithOrigin a -> WithOrigin a -> WithOrigin a
min :: WithOrigin a -> WithOrigin a -> WithOrigin a
Ord, Int -> WithOrigin a -> ShowS
[WithOrigin a] -> ShowS
WithOrigin a -> String
(Int -> WithOrigin a -> ShowS)
-> (WithOrigin a -> String)
-> ([WithOrigin a] -> ShowS)
-> Show (WithOrigin a)
forall a. Show a => Int -> WithOrigin a -> ShowS
forall a. Show a => [WithOrigin a] -> ShowS
forall a. Show a => WithOrigin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithOrigin a -> ShowS
showsPrec :: Int -> WithOrigin a -> ShowS
$cshow :: forall a. Show a => WithOrigin a -> String
show :: WithOrigin a -> String
$cshowList :: forall a. Show a => [WithOrigin a] -> ShowS
showList :: [WithOrigin a] -> ShowS
Show, (forall a b. (a -> b) -> WithOrigin a -> WithOrigin b)
-> (forall a b. a -> WithOrigin b -> WithOrigin a)
-> Functor WithOrigin
forall a b. a -> WithOrigin b -> WithOrigin a
forall a b. (a -> b) -> WithOrigin a -> WithOrigin b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithOrigin a -> WithOrigin b
fmap :: forall a b. (a -> b) -> WithOrigin a -> WithOrigin b
$c<$ :: forall a b. a -> WithOrigin b -> WithOrigin a
<$ :: forall a b. a -> WithOrigin b -> WithOrigin a
Functor, (forall m. Monoid m => WithOrigin m -> m)
-> (forall m a. Monoid m => (a -> m) -> WithOrigin a -> m)
-> (forall m a. Monoid m => (a -> m) -> WithOrigin a -> m)
-> (forall a b. (a -> b -> b) -> b -> WithOrigin a -> b)
-> (forall a b. (a -> b -> b) -> b -> WithOrigin a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithOrigin a -> b)
-> (forall b a. (b -> a -> b) -> b -> WithOrigin a -> b)
-> (forall a. (a -> a -> a) -> WithOrigin a -> a)
-> (forall a. (a -> a -> a) -> WithOrigin a -> a)
-> (forall a. WithOrigin a -> [a])
-> (forall a. WithOrigin a -> Bool)
-> (forall a. WithOrigin a -> Int)
-> (forall a. Eq a => a -> WithOrigin a -> Bool)
-> (forall a. Ord a => WithOrigin a -> a)
-> (forall a. Ord a => WithOrigin a -> a)
-> (forall a. Num a => WithOrigin a -> a)
-> (forall a. Num a => WithOrigin a -> a)
-> Foldable WithOrigin
forall a. Eq a => a -> WithOrigin a -> Bool
forall a. Num a => WithOrigin a -> a
forall a. Ord a => WithOrigin a -> a
forall m. Monoid m => WithOrigin m -> m
forall a. WithOrigin a -> Bool
forall a. WithOrigin a -> Int
forall a. WithOrigin a -> [a]
forall a. (a -> a -> a) -> WithOrigin a -> a
forall m a. Monoid m => (a -> m) -> WithOrigin a -> m
forall b a. (b -> a -> b) -> b -> WithOrigin a -> b
forall a b. (a -> b -> b) -> b -> WithOrigin a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => WithOrigin m -> m
fold :: forall m. Monoid m => WithOrigin m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> WithOrigin a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> WithOrigin a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> WithOrigin a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> WithOrigin a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> WithOrigin a -> b
foldr :: forall a b. (a -> b -> b) -> b -> WithOrigin a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> WithOrigin a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> WithOrigin a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> WithOrigin a -> b
foldl :: forall b a. (b -> a -> b) -> b -> WithOrigin a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> WithOrigin a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> WithOrigin a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> WithOrigin a -> a
foldr1 :: forall a. (a -> a -> a) -> WithOrigin a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> WithOrigin a -> a
foldl1 :: forall a. (a -> a -> a) -> WithOrigin a -> a
$ctoList :: forall a. WithOrigin a -> [a]
toList :: forall a. WithOrigin a -> [a]
$cnull :: forall a. WithOrigin a -> Bool
null :: forall a. WithOrigin a -> Bool
$clength :: forall a. WithOrigin a -> Int
length :: forall a. WithOrigin a -> Int
$celem :: forall a. Eq a => a -> WithOrigin a -> Bool
elem :: forall a. Eq a => a -> WithOrigin a -> Bool
$cmaximum :: forall a. Ord a => WithOrigin a -> a
maximum :: forall a. Ord a => WithOrigin a -> a
$cminimum :: forall a. Ord a => WithOrigin a -> a
minimum :: forall a. Ord a => WithOrigin a -> a
$csum :: forall a. Num a => WithOrigin a -> a
sum :: forall a. Num a => WithOrigin a -> a
$cproduct :: forall a. Num a => WithOrigin a -> a
product :: forall a. Num a => WithOrigin a -> a
Foldable, Functor WithOrigin
Foldable WithOrigin
(Functor WithOrigin, Foldable WithOrigin) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> WithOrigin a -> f (WithOrigin b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithOrigin (f a) -> f (WithOrigin a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> WithOrigin a -> m (WithOrigin b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithOrigin (m a) -> m (WithOrigin a))
-> Traversable WithOrigin
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithOrigin (m a) -> m (WithOrigin a)
forall (f :: * -> *) a.
Applicative f =>
WithOrigin (f a) -> f (WithOrigin a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithOrigin a -> m (WithOrigin b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithOrigin a -> f (WithOrigin b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithOrigin a -> f (WithOrigin b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> WithOrigin a -> f (WithOrigin b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithOrigin (f a) -> f (WithOrigin a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
WithOrigin (f a) -> f (WithOrigin a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithOrigin a -> m (WithOrigin b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> WithOrigin a -> m (WithOrigin b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
WithOrigin (m a) -> m (WithOrigin a)
sequence :: forall (m :: * -> *) a.
Monad m =>
WithOrigin (m a) -> m (WithOrigin a)
Traversable)

instance Decoration WithOrigin where
  traverseF :: forall (m :: * -> *) a b.
Functor m =>
(a -> m b) -> WithOrigin a -> m (WithOrigin b)
traverseF a -> m b
f (WithOrigin Origin
h a
a) = Origin -> b -> WithOrigin b
forall a. Origin -> a -> WithOrigin a
WithOrigin Origin
h (b -> WithOrigin b) -> m b -> m (WithOrigin b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a

instance Pretty a => Pretty (WithOrigin a) where
  prettyPrec :: Int -> WithOrigin a -> Doc
prettyPrec Int
p = Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p (a -> Doc) -> (WithOrigin a -> a) -> WithOrigin a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithOrigin a -> a
forall a. WithOrigin a -> a
woThing

instance HasRange a => HasRange (WithOrigin a) where
  getRange :: WithOrigin a -> Range
getRange = a -> Range
forall a. HasRange a => a -> Range
getRange (a -> Range) -> (WithOrigin a -> a) -> WithOrigin a -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithOrigin a -> a
forall (t :: * -> *) a. Decoration t => t a -> a
dget

instance SetRange a => SetRange (WithOrigin a) where
  setRange :: Range -> WithOrigin a -> WithOrigin a
setRange = (a -> a) -> WithOrigin a -> WithOrigin a
forall a b. (a -> b) -> WithOrigin a -> WithOrigin b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> WithOrigin a -> WithOrigin a)
-> (Range -> a -> a) -> Range -> WithOrigin a -> WithOrigin a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> a -> a
forall a. SetRange a => Range -> a -> a
setRange

instance KillRange a => KillRange (WithOrigin a) where
  killRange :: KillRangeT (WithOrigin a)
killRange = (a -> a) -> KillRangeT (WithOrigin a)
forall a b. (a -> b) -> WithOrigin a -> WithOrigin b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. KillRange a => KillRangeT a
killRange

instance NFData a => NFData (WithOrigin a) where
  rnf :: WithOrigin a -> ()
rnf (WithOrigin Origin
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

-- | A lens to access the 'Origin' attribute in data structures.
--   Minimal implementation: @getOrigin@ and @mapOrigin@ or @LensArgInfo@.

class LensOrigin a where

  getOrigin :: a -> Origin

  setOrigin :: Origin -> a -> a
  setOrigin Origin
o = (Origin -> Origin) -> a -> a
forall a. LensOrigin a => (Origin -> Origin) -> a -> a
mapOrigin (Origin -> Origin -> Origin
forall a b. a -> b -> a
const Origin
o)

  mapOrigin :: (Origin -> Origin) -> a -> a

  default getOrigin :: LensArgInfo a => a -> Origin
  getOrigin = ArgInfo -> Origin
argInfoOrigin (ArgInfo -> Origin) -> (a -> ArgInfo) -> a -> Origin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo

  default mapOrigin :: LensArgInfo a => (Origin -> Origin) -> a -> a
  mapOrigin Origin -> Origin
f = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a) -> (ArgInfo -> ArgInfo) -> a -> a
forall a b. (a -> b) -> a -> b
$ \ ArgInfo
ai -> ArgInfo
ai { argInfoOrigin = f $ argInfoOrigin ai }

instance LensOrigin Origin where
  getOrigin :: Origin -> Origin
getOrigin = Origin -> Origin
forall a. a -> a
id
  setOrigin :: Origin -> Origin -> Origin
setOrigin = Origin -> Origin -> Origin
forall a b. a -> b -> a
const
  mapOrigin :: (Origin -> Origin) -> Origin -> Origin
mapOrigin = (Origin -> Origin) -> Origin -> Origin
forall a. a -> a
id

instance LensOrigin (WithOrigin a) where
  getOrigin :: WithOrigin a -> Origin
getOrigin   (WithOrigin Origin
h a
_) = Origin
h
  setOrigin :: Origin -> WithOrigin a -> WithOrigin a
setOrigin Origin
h (WithOrigin Origin
_ a
a) = Origin -> a -> WithOrigin a
forall a. Origin -> a -> WithOrigin a
WithOrigin Origin
h a
a
  mapOrigin :: (Origin -> Origin) -> WithOrigin a -> WithOrigin a
mapOrigin Origin -> Origin
f (WithOrigin Origin
h a
a) = Origin -> a -> WithOrigin a
forall a. Origin -> a -> WithOrigin a
WithOrigin (Origin -> Origin
f Origin
h) a
a

------------------------------------------------------------------------
-- Origin of binder names
------------------------------------------------------------------------

data BinderNameOrigin
  = UserBinderName
  | InsertedBinderName
  deriving (Int -> BinderNameOrigin -> ShowS
[BinderNameOrigin] -> ShowS
BinderNameOrigin -> String
(Int -> BinderNameOrigin -> ShowS)
-> (BinderNameOrigin -> String)
-> ([BinderNameOrigin] -> ShowS)
-> Show BinderNameOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinderNameOrigin -> ShowS
showsPrec :: Int -> BinderNameOrigin -> ShowS
$cshow :: BinderNameOrigin -> String
show :: BinderNameOrigin -> String
$cshowList :: [BinderNameOrigin] -> ShowS
showList :: [BinderNameOrigin] -> ShowS
Show, BinderNameOrigin -> BinderNameOrigin -> Bool
(BinderNameOrigin -> BinderNameOrigin -> Bool)
-> (BinderNameOrigin -> BinderNameOrigin -> Bool)
-> Eq BinderNameOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinderNameOrigin -> BinderNameOrigin -> Bool
== :: BinderNameOrigin -> BinderNameOrigin -> Bool
$c/= :: BinderNameOrigin -> BinderNameOrigin -> Bool
/= :: BinderNameOrigin -> BinderNameOrigin -> Bool
Eq, (forall x. BinderNameOrigin -> Rep BinderNameOrigin x)
-> (forall x. Rep BinderNameOrigin x -> BinderNameOrigin)
-> Generic BinderNameOrigin
forall x. Rep BinderNameOrigin x -> BinderNameOrigin
forall x. BinderNameOrigin -> Rep BinderNameOrigin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinderNameOrigin -> Rep BinderNameOrigin x
from :: forall x. BinderNameOrigin -> Rep BinderNameOrigin x
$cto :: forall x. Rep BinderNameOrigin x -> BinderNameOrigin
to :: forall x. Rep BinderNameOrigin x -> BinderNameOrigin
Generic)

instance KillRange BinderNameOrigin where
  killRange :: KillRangeT BinderNameOrigin
killRange = \case
    BinderNameOrigin
InsertedBinderName -> BinderNameOrigin
InsertedBinderName
    BinderNameOrigin
UserBinderName     -> BinderNameOrigin
UserBinderName

instance NFData BinderNameOrigin

-----------------------------------------------------------------------------
-- * Free variable annotations
-----------------------------------------------------------------------------

data FreeVariables = UnknownFVs | KnownFVs !VarSet
  deriving (FreeVariables -> FreeVariables -> Bool
(FreeVariables -> FreeVariables -> Bool)
-> (FreeVariables -> FreeVariables -> Bool) -> Eq FreeVariables
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FreeVariables -> FreeVariables -> Bool
== :: FreeVariables -> FreeVariables -> Bool
$c/= :: FreeVariables -> FreeVariables -> Bool
/= :: FreeVariables -> FreeVariables -> Bool
Eq, Eq FreeVariables
Eq FreeVariables =>
(FreeVariables -> FreeVariables -> Ordering)
-> (FreeVariables -> FreeVariables -> Bool)
-> (FreeVariables -> FreeVariables -> Bool)
-> (FreeVariables -> FreeVariables -> Bool)
-> (FreeVariables -> FreeVariables -> Bool)
-> (FreeVariables -> FreeVariables -> FreeVariables)
-> (FreeVariables -> FreeVariables -> FreeVariables)
-> Ord FreeVariables
FreeVariables -> FreeVariables -> Bool
FreeVariables -> FreeVariables -> Ordering
FreeVariables -> FreeVariables -> FreeVariables
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
$ccompare :: FreeVariables -> FreeVariables -> Ordering
compare :: FreeVariables -> FreeVariables -> Ordering
$c< :: FreeVariables -> FreeVariables -> Bool
< :: FreeVariables -> FreeVariables -> Bool
$c<= :: FreeVariables -> FreeVariables -> Bool
<= :: FreeVariables -> FreeVariables -> Bool
$c> :: FreeVariables -> FreeVariables -> Bool
> :: FreeVariables -> FreeVariables -> Bool
$c>= :: FreeVariables -> FreeVariables -> Bool
>= :: FreeVariables -> FreeVariables -> Bool
$cmax :: FreeVariables -> FreeVariables -> FreeVariables
max :: FreeVariables -> FreeVariables -> FreeVariables
$cmin :: FreeVariables -> FreeVariables -> FreeVariables
min :: FreeVariables -> FreeVariables -> FreeVariables
Ord, Int -> FreeVariables -> ShowS
[FreeVariables] -> ShowS
FreeVariables -> String
(Int -> FreeVariables -> ShowS)
-> (FreeVariables -> String)
-> ([FreeVariables] -> ShowS)
-> Show FreeVariables
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FreeVariables -> ShowS
showsPrec :: Int -> FreeVariables -> ShowS
$cshow :: FreeVariables -> String
show :: FreeVariables -> String
$cshowList :: [FreeVariables] -> ShowS
showList :: [FreeVariables] -> ShowS
Show)

instance Semigroup FreeVariables where
  FreeVariables
UnknownFVs   <> :: FreeVariables -> FreeVariables -> FreeVariables
<> FreeVariables
_            = FreeVariables
UnknownFVs
  FreeVariables
_            <> FreeVariables
UnknownFVs   = FreeVariables
UnknownFVs
  KnownFVs VarSet
vs1 <> KnownFVs VarSet
vs2 = VarSet -> FreeVariables
KnownFVs (VarSet -> VarSet -> VarSet
VarSet.union VarSet
vs1 VarSet
vs2)

instance Monoid FreeVariables where
  mempty :: FreeVariables
mempty  = VarSet -> FreeVariables
KnownFVs VarSet
forall a. Null a => a
empty
  mappend :: FreeVariables -> FreeVariables -> FreeVariables
mappend = FreeVariables -> FreeVariables -> FreeVariables
forall a. Semigroup a => a -> a -> a
(<>)

instance KillRange FreeVariables where
  killRange :: FreeVariables -> FreeVariables
killRange = FreeVariables -> FreeVariables
forall a. a -> a
id

instance NFData FreeVariables where
  rnf :: FreeVariables -> ()
rnf FreeVariables
UnknownFVs    = ()
  rnf (KnownFVs VarSet
fv) = VarSet -> ()
forall a. NFData a => a -> ()
rnf VarSet
fv

unknownFreeVariables :: FreeVariables
unknownFreeVariables :: FreeVariables
unknownFreeVariables = FreeVariables
UnknownFVs

noFreeVariables :: FreeVariables
noFreeVariables :: FreeVariables
noFreeVariables = FreeVariables
forall a. Monoid a => a
mempty

oneFreeVariable :: Int -> FreeVariables
oneFreeVariable :: Int -> FreeVariables
oneFreeVariable = VarSet -> FreeVariables
KnownFVs (VarSet -> FreeVariables)
-> (Int -> VarSet) -> Int -> FreeVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarSet
forall el coll. Singleton el coll => el -> coll
singleton

freeVariablesFromList :: [Int] -> FreeVariables
freeVariablesFromList :: [Int] -> FreeVariables
freeVariablesFromList = [FreeVariables] -> FreeVariables
forall a. Monoid a => [a] -> a
mconcat ([FreeVariables] -> FreeVariables)
-> ([Int] -> [FreeVariables]) -> [Int] -> FreeVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> FreeVariables) -> [Int] -> [FreeVariables]
forall a b. (a -> b) -> [a] -> [b]
map Int -> FreeVariables
oneFreeVariable

-- | A lens to access the 'FreeVariables' attribute in data structures.
--   Minimal implementation: @getFreeVariables@ and @mapFreeVariables@ or @LensArgInfo@.
class LensFreeVariables a where

  getFreeVariables :: a -> FreeVariables

  setFreeVariables :: FreeVariables -> a -> a
  setFreeVariables FreeVariables
o = (FreeVariables -> FreeVariables) -> a -> a
forall a.
LensFreeVariables a =>
(FreeVariables -> FreeVariables) -> a -> a
mapFreeVariables (FreeVariables -> FreeVariables -> FreeVariables
forall a b. a -> b -> a
const FreeVariables
o)

  mapFreeVariables :: (FreeVariables -> FreeVariables) -> a -> a

  default getFreeVariables :: LensArgInfo a => a -> FreeVariables
  getFreeVariables = ArgInfo -> FreeVariables
argInfoFreeVariables (ArgInfo -> FreeVariables) -> (a -> ArgInfo) -> a -> FreeVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo

  default mapFreeVariables :: LensArgInfo a => (FreeVariables -> FreeVariables) -> a -> a
  mapFreeVariables FreeVariables -> FreeVariables
f = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a) -> (ArgInfo -> ArgInfo) -> a -> a
forall a b. (a -> b) -> a -> b
$ \ ArgInfo
ai -> ArgInfo
ai { argInfoFreeVariables = f $ argInfoFreeVariables ai }

instance LensFreeVariables FreeVariables where
  getFreeVariables :: FreeVariables -> FreeVariables
getFreeVariables = FreeVariables -> FreeVariables
forall a. a -> a
id
  setFreeVariables :: FreeVariables -> FreeVariables -> FreeVariables
setFreeVariables = FreeVariables -> FreeVariables -> FreeVariables
forall a b. a -> b -> a
const
  mapFreeVariables :: (FreeVariables -> FreeVariables) -> FreeVariables -> FreeVariables
mapFreeVariables = (FreeVariables -> FreeVariables) -> FreeVariables -> FreeVariables
forall a. a -> a
id

hasNoFreeVariables :: LensFreeVariables a => a -> Bool
hasNoFreeVariables :: forall a. LensFreeVariables a => a -> Bool
hasNoFreeVariables a
x =
  case a -> FreeVariables
forall a. LensFreeVariables a => a -> FreeVariables
getFreeVariables a
x of
    FreeVariables
UnknownFVs  -> Bool
False
    KnownFVs VarSet
fv -> VarSet -> Bool
forall a. Null a => a -> Bool
null VarSet
fv

---------------------------------------------------------------------------
-- * Argument decoration
---------------------------------------------------------------------------

-- | A function argument can be hidden.

data ArgInfo = ArgInfo
  { ArgInfo -> Hiding
argInfoHiding        :: Hiding
  , ArgInfo -> Origin
argInfoOrigin        :: Origin
  , ArgInfo -> FreeVariables
argInfoFreeVariables :: FreeVariables
  } deriving (ArgInfo -> ArgInfo -> Bool
(ArgInfo -> ArgInfo -> Bool)
-> (ArgInfo -> ArgInfo -> Bool) -> Eq ArgInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArgInfo -> ArgInfo -> Bool
== :: ArgInfo -> ArgInfo -> Bool
$c/= :: ArgInfo -> ArgInfo -> Bool
/= :: ArgInfo -> ArgInfo -> Bool
Eq, Eq ArgInfo
Eq ArgInfo =>
(ArgInfo -> ArgInfo -> Ordering)
-> (ArgInfo -> ArgInfo -> Bool)
-> (ArgInfo -> ArgInfo -> Bool)
-> (ArgInfo -> ArgInfo -> Bool)
-> (ArgInfo -> ArgInfo -> Bool)
-> (ArgInfo -> ArgInfo -> ArgInfo)
-> (ArgInfo -> ArgInfo -> ArgInfo)
-> Ord ArgInfo
ArgInfo -> ArgInfo -> Bool
ArgInfo -> ArgInfo -> Ordering
ArgInfo -> ArgInfo -> ArgInfo
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
$ccompare :: ArgInfo -> ArgInfo -> Ordering
compare :: ArgInfo -> ArgInfo -> Ordering
$c< :: ArgInfo -> ArgInfo -> Bool
< :: ArgInfo -> ArgInfo -> Bool
$c<= :: ArgInfo -> ArgInfo -> Bool
<= :: ArgInfo -> ArgInfo -> Bool
$c> :: ArgInfo -> ArgInfo -> Bool
> :: ArgInfo -> ArgInfo -> Bool
$c>= :: ArgInfo -> ArgInfo -> Bool
>= :: ArgInfo -> ArgInfo -> Bool
$cmax :: ArgInfo -> ArgInfo -> ArgInfo
max :: ArgInfo -> ArgInfo -> ArgInfo
$cmin :: ArgInfo -> ArgInfo -> ArgInfo
min :: ArgInfo -> ArgInfo -> ArgInfo
Ord, Int -> ArgInfo -> ShowS
[ArgInfo] -> ShowS
ArgInfo -> String
(Int -> ArgInfo -> ShowS)
-> (ArgInfo -> String) -> ([ArgInfo] -> ShowS) -> Show ArgInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArgInfo -> ShowS
showsPrec :: Int -> ArgInfo -> ShowS
$cshow :: ArgInfo -> String
show :: ArgInfo -> String
$cshowList :: [ArgInfo] -> ShowS
showList :: [ArgInfo] -> ShowS
Show)

instance HasRange ArgInfo where
  getRange :: ArgInfo -> Range
getRange (ArgInfo Hiding
h Origin
o FreeVariables
_fv) = (Hiding, Origin) -> Range
forall a. HasRange a => a -> Range
getRange (Hiding
h, Origin
o)

instance KillRange ArgInfo where
  killRange :: ArgInfo -> ArgInfo
killRange (ArgInfo Hiding
h Origin
o FreeVariables
fv) = (Hiding -> Origin -> FreeVariables -> ArgInfo)
-> Hiding -> Origin -> FreeVariables -> ArgInfo
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN Hiding -> Origin -> FreeVariables -> ArgInfo
ArgInfo Hiding
h Origin
o FreeVariables
fv

class LensArgInfo a where
  getArgInfo :: a -> ArgInfo
  setArgInfo :: ArgInfo -> a -> a
  setArgInfo ArgInfo
ai = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo (ArgInfo -> ArgInfo -> ArgInfo
forall a b. a -> b -> a
const ArgInfo
ai)
  mapArgInfo :: (ArgInfo -> ArgInfo) -> a -> a
  mapArgInfo ArgInfo -> ArgInfo
f a
a = ArgInfo -> a -> a
forall a. LensArgInfo a => ArgInfo -> a -> a
setArgInfo (ArgInfo -> ArgInfo
f (ArgInfo -> ArgInfo) -> ArgInfo -> ArgInfo
forall a b. (a -> b) -> a -> b
$ a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo a
a) a
a
  {-# MINIMAL getArgInfo , (setArgInfo | mapArgInfo) #-}

instance LensArgInfo ArgInfo where
  getArgInfo :: ArgInfo -> ArgInfo
getArgInfo = ArgInfo -> ArgInfo
forall a. a -> a
id
  setArgInfo :: ArgInfo -> ArgInfo -> ArgInfo
setArgInfo = ArgInfo -> ArgInfo -> ArgInfo
forall a b. a -> b -> a
const
  mapArgInfo :: (ArgInfo -> ArgInfo) -> ArgInfo -> ArgInfo
mapArgInfo = (ArgInfo -> ArgInfo) -> ArgInfo -> ArgInfo
forall a. a -> a
id

instance NFData ArgInfo where
  rnf :: ArgInfo -> ()
rnf (ArgInfo Hiding
a Origin
b FreeVariables
c) = Hiding -> ()
forall a. NFData a => a -> ()
rnf Hiding
a () -> () -> ()
forall a b. a -> b -> b
`seq` Origin -> ()
forall a. NFData a => a -> ()
rnf Origin
b () -> () -> ()
forall a b. a -> b -> b
`seq` FreeVariables -> ()
forall a. NFData a => a -> ()
rnf FreeVariables
c

instance LensHiding ArgInfo where
  getHiding :: ArgInfo -> Hiding
getHiding = ArgInfo -> Hiding
argInfoHiding
  setHiding :: Hiding -> ArgInfo -> ArgInfo
setHiding Hiding
h ArgInfo
ai = ArgInfo
ai { argInfoHiding = h }
  mapHiding :: (Hiding -> Hiding) -> ArgInfo -> ArgInfo
mapHiding Hiding -> Hiding
f ArgInfo
ai = ArgInfo
ai { argInfoHiding = f (argInfoHiding ai) }

instance LensOrigin ArgInfo where
  getOrigin :: ArgInfo -> Origin
getOrigin = ArgInfo -> Origin
argInfoOrigin
  setOrigin :: Origin -> ArgInfo -> ArgInfo
setOrigin Origin
o ArgInfo
ai = ArgInfo
ai { argInfoOrigin = o }
  mapOrigin :: (Origin -> Origin) -> ArgInfo -> ArgInfo
mapOrigin Origin -> Origin
f ArgInfo
ai = ArgInfo
ai { argInfoOrigin = f (argInfoOrigin ai) }

instance LensFreeVariables ArgInfo where
  getFreeVariables :: ArgInfo -> FreeVariables
getFreeVariables = ArgInfo -> FreeVariables
argInfoFreeVariables
  setFreeVariables :: FreeVariables -> ArgInfo -> ArgInfo
setFreeVariables FreeVariables
o ArgInfo
ai = ArgInfo
ai { argInfoFreeVariables = o }
  mapFreeVariables :: (FreeVariables -> FreeVariables) -> ArgInfo -> ArgInfo
mapFreeVariables FreeVariables -> FreeVariables
f ArgInfo
ai = ArgInfo
ai { argInfoFreeVariables = f (argInfoFreeVariables ai) }

instance Null ArgInfo where
  empty :: ArgInfo
empty = ArgInfo
defaultArgInfo
  null :: ArgInfo -> Bool
null (ArgInfo Hiding
h Origin
_o FreeVariables
_fv) = Hiding -> Bool
forall a. Null a => a -> Bool
null Hiding
h

defaultArgInfo :: ArgInfo
defaultArgInfo :: ArgInfo
defaultArgInfo =  ArgInfo
  { argInfoHiding :: Hiding
argInfoHiding        = Hiding
NotHidden
  , argInfoOrigin :: Origin
argInfoOrigin        = Origin
UserWritten
  , argInfoFreeVariables :: FreeVariables
argInfoFreeVariables = FreeVariables
UnknownFVs
  }


-- Accessing through ArgInfo

-- default accessors for Hiding

getHidingArgInfo :: LensArgInfo a => LensGet a Hiding
getHidingArgInfo :: forall a. LensArgInfo a => LensGet a Hiding
getHidingArgInfo = ArgInfo -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding (ArgInfo -> Hiding) -> (a -> ArgInfo) -> a -> Hiding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo

setHidingArgInfo :: LensArgInfo a => LensSet a Hiding
setHidingArgInfo :: forall a. LensArgInfo a => LensSet a Hiding
setHidingArgInfo = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a)
-> (Hiding -> ArgInfo -> ArgInfo) -> Hiding -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hiding -> ArgInfo -> ArgInfo
forall a. LensHiding a => Hiding -> a -> a
setHiding

mapHidingArgInfo :: LensArgInfo a => LensMap a Hiding
mapHidingArgInfo :: forall a. LensArgInfo a => LensMap a Hiding
mapHidingArgInfo = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a)
-> ((Hiding -> Hiding) -> ArgInfo -> ArgInfo)
-> (Hiding -> Hiding)
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Hiding -> Hiding) -> ArgInfo -> ArgInfo
forall a. LensHiding a => (Hiding -> Hiding) -> a -> a
mapHiding

-- default accessors for Origin

getOriginArgInfo :: LensArgInfo a => LensGet a Origin
getOriginArgInfo :: forall a. LensArgInfo a => LensGet a Origin
getOriginArgInfo = ArgInfo -> Origin
forall a. LensOrigin a => a -> Origin
getOrigin (ArgInfo -> Origin) -> (a -> ArgInfo) -> a -> Origin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo

setOriginArgInfo :: LensArgInfo a => LensSet a Origin
setOriginArgInfo :: forall a. LensArgInfo a => LensSet a Origin
setOriginArgInfo = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a)
-> (Origin -> ArgInfo -> ArgInfo) -> Origin -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin -> ArgInfo -> ArgInfo
forall a. LensOrigin a => Origin -> a -> a
setOrigin

mapOriginArgInfo :: LensArgInfo a => LensMap a Origin
mapOriginArgInfo :: forall a. LensArgInfo a => LensMap a Origin
mapOriginArgInfo = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a)
-> ((Origin -> Origin) -> ArgInfo -> ArgInfo)
-> (Origin -> Origin)
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Origin -> Origin) -> ArgInfo -> ArgInfo
forall a. LensOrigin a => (Origin -> Origin) -> a -> a
mapOrigin

-- default accessors for FreeVariables

getFreeVariablesArgInfo :: LensArgInfo a => LensGet a FreeVariables
getFreeVariablesArgInfo :: forall a. LensArgInfo a => LensGet a FreeVariables
getFreeVariablesArgInfo = ArgInfo -> FreeVariables
forall a. LensFreeVariables a => a -> FreeVariables
getFreeVariables (ArgInfo -> FreeVariables) -> (a -> ArgInfo) -> a -> FreeVariables
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ArgInfo
forall a. LensArgInfo a => a -> ArgInfo
getArgInfo

setFreeVariablesArgInfo :: LensArgInfo a => LensSet a FreeVariables
setFreeVariablesArgInfo :: forall a. LensArgInfo a => LensSet a FreeVariables
setFreeVariablesArgInfo = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a)
-> (FreeVariables -> ArgInfo -> ArgInfo) -> FreeVariables -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeVariables -> ArgInfo -> ArgInfo
forall a. LensFreeVariables a => FreeVariables -> a -> a
setFreeVariables

mapFreeVariablesArgInfo :: LensArgInfo a => LensMap a FreeVariables
mapFreeVariablesArgInfo :: forall a. LensArgInfo a => LensMap a FreeVariables
mapFreeVariablesArgInfo = (ArgInfo -> ArgInfo) -> a -> a
forall a. LensArgInfo a => (ArgInfo -> ArgInfo) -> a -> a
mapArgInfo ((ArgInfo -> ArgInfo) -> a -> a)
-> ((FreeVariables -> FreeVariables) -> ArgInfo -> ArgInfo)
-> (FreeVariables -> FreeVariables)
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeVariables -> FreeVariables) -> ArgInfo -> ArgInfo
forall a.
LensFreeVariables a =>
(FreeVariables -> FreeVariables) -> a -> a
mapFreeVariables

-- inserted hidden arguments

isInsertedHidden :: (LensHiding a, LensOrigin a) => a -> Bool
isInsertedHidden :: forall a. (LensHiding a, LensOrigin a) => a -> Bool
isInsertedHidden a
a = a -> Hiding
forall a. LensHiding a => a -> Hiding
getHiding a
a Hiding -> Hiding -> Bool
forall a. Eq a => a -> a -> Bool
== Hiding
Hidden Bool -> Bool -> Bool
&& a -> Origin
forall a. LensOrigin a => a -> Origin
getOrigin a
a Origin -> Origin -> Bool
forall a. Eq a => a -> a -> Bool
== Origin
Inserted

---------------------------------------------------------------------------
-- * Arguments
---------------------------------------------------------------------------

data Arg e  = Arg
  { forall e. Arg e -> ArgInfo
argInfo :: ArgInfo
  , forall e. Arg e -> e
unArg :: e
  } deriving (Arg e -> Arg e -> Bool
(Arg e -> Arg e -> Bool) -> (Arg e -> Arg e -> Bool) -> Eq (Arg e)
forall e. Eq e => Arg e -> Arg e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Arg e -> Arg e -> Bool
== :: Arg e -> Arg e -> Bool
$c/= :: forall e. Eq e => Arg e -> Arg e -> Bool
/= :: Arg e -> Arg e -> Bool
Eq, Eq (Arg e)
Eq (Arg e) =>
(Arg e -> Arg e -> Ordering)
-> (Arg e -> Arg e -> Bool)
-> (Arg e -> Arg e -> Bool)
-> (Arg e -> Arg e -> Bool)
-> (Arg e -> Arg e -> Bool)
-> (Arg e -> Arg e -> Arg e)
-> (Arg e -> Arg e -> Arg e)
-> Ord (Arg e)
Arg e -> Arg e -> Bool
Arg e -> Arg e -> Ordering
Arg e -> Arg e -> Arg e
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
forall e. Ord e => Eq (Arg e)
forall e. Ord e => Arg e -> Arg e -> Bool
forall e. Ord e => Arg e -> Arg e -> Ordering
forall e. Ord e => Arg e -> Arg e -> Arg e
$ccompare :: forall e. Ord e => Arg e -> Arg e -> Ordering
compare :: Arg e -> Arg e -> Ordering
$c< :: forall e. Ord e => Arg e -> Arg e -> Bool
< :: Arg e -> Arg e -> Bool
$c<= :: forall e. Ord e => Arg e -> Arg e -> Bool
<= :: Arg e -> Arg e -> Bool
$c> :: forall e. Ord e => Arg e -> Arg e -> Bool
> :: Arg e -> Arg e -> Bool
$c>= :: forall e. Ord e => Arg e -> Arg e -> Bool
>= :: Arg e -> Arg e -> Bool
$cmax :: forall e. Ord e => Arg e -> Arg e -> Arg e
max :: Arg e -> Arg e -> Arg e
$cmin :: forall e. Ord e => Arg e -> Arg e -> Arg e
min :: Arg e -> Arg e -> Arg e
Ord, Int -> Arg e -> ShowS
[Arg e] -> ShowS
Arg e -> String
(Int -> Arg e -> ShowS)
-> (Arg e -> String) -> ([Arg e] -> ShowS) -> Show (Arg e)
forall e. Show e => Int -> Arg e -> ShowS
forall e. Show e => [Arg e] -> ShowS
forall e. Show e => Arg e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Arg e -> ShowS
showsPrec :: Int -> Arg e -> ShowS
$cshow :: forall e. Show e => Arg e -> String
show :: Arg e -> String
$cshowList :: forall e. Show e => [Arg e] -> ShowS
showList :: [Arg e] -> ShowS
Show, (forall m. Monoid m => Arg m -> m)
-> (forall m a. Monoid m => (a -> m) -> Arg a -> m)
-> (forall m a. Monoid m => (a -> m) -> Arg a -> m)
-> (forall a b. (a -> b -> b) -> b -> Arg a -> b)
-> (forall a b. (a -> b -> b) -> b -> Arg a -> b)
-> (forall b a. (b -> a -> b) -> b -> Arg a -> b)
-> (forall b a. (b -> a -> b) -> b -> Arg a -> b)
-> (forall a. (a -> a -> a) -> Arg a -> a)
-> (forall a. (a -> a -> a) -> Arg a -> a)
-> (forall a. Arg a -> [a])
-> (forall a. Arg a -> Bool)
-> (forall a. Arg a -> Int)
-> (forall a. Eq a => a -> Arg a -> Bool)
-> (forall a. Ord a => Arg a -> a)
-> (forall a. Ord a => Arg a -> a)
-> (forall a. Num a => Arg a -> a)
-> (forall a. Num a => Arg a -> a)
-> Foldable Arg
forall a. Eq a => a -> Arg a -> Bool
forall a. Num a => Arg a -> a
forall a. Ord a => Arg a -> a
forall m. Monoid m => Arg m -> m
forall a. Arg a -> Bool
forall a. Arg a -> Int
forall a. Arg a -> [a]
forall a. (a -> a -> a) -> Arg a -> a
forall m a. Monoid m => (a -> m) -> Arg a -> m
forall b a. (b -> a -> b) -> b -> Arg a -> b
forall a b. (a -> b -> b) -> b -> Arg a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Arg m -> m
fold :: forall m. Monoid m => Arg m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Arg a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Arg a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Arg a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Arg a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Arg a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Arg a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Arg a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Arg a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Arg a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Arg a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Arg a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Arg a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Arg a -> a
foldr1 :: forall a. (a -> a -> a) -> Arg a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Arg a -> a
foldl1 :: forall a. (a -> a -> a) -> Arg a -> a
$ctoList :: forall a. Arg a -> [a]
toList :: forall a. Arg a -> [a]
$cnull :: forall a. Arg a -> Bool
null :: forall a. Arg a -> Bool
$clength :: forall a. Arg a -> Int
length :: forall a. Arg a -> Int
$celem :: forall a. Eq a => a -> Arg a -> Bool
elem :: forall a. Eq a => a -> Arg a -> Bool
$cmaximum :: forall a. Ord a => Arg a -> a
maximum :: forall a. Ord a => Arg a -> a
$cminimum :: forall a. Ord a => Arg a -> a
minimum :: forall a. Ord a => Arg a -> a
$csum :: forall a. Num a => Arg a -> a
sum :: forall a. Num a => Arg a -> a
$cproduct :: forall a. Num a => Arg a -> a
product :: forall a. Num a => Arg a -> a
Foldable, Functor Arg
Foldable Arg
(Functor Arg, Foldable Arg) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Arg a -> f (Arg b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Arg (f a) -> f (Arg a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Arg a -> m (Arg b))
-> (forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a))
-> Traversable Arg
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a)
forall (f :: * -> *) a. Applicative f => Arg (f a) -> f (Arg a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arg a -> m (Arg b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Arg (f a) -> f (Arg a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Arg (f a) -> f (Arg a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arg a -> m (Arg b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Arg a -> m (Arg b)
$csequence :: forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a)
sequence :: forall (m :: * -> *) a. Monad m => Arg (m a) -> m (Arg a)
Traversable)

instance Functor Arg where
  fmap :: forall a b. (a -> b) -> Arg a -> Arg b
fmap a -> b
f = \(Arg ArgInfo
x a
y) -> ArgInfo -> b -> Arg b
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
x (b -> Arg b) -> b -> Arg b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
y

instance Decoration Arg where
  traverseF :: forall (m :: * -> *) a b.
Functor m =>
(a -> m b) -> Arg a -> m (Arg b)
traverseF a -> m b
f (Arg ArgInfo
ai a
a) = ArgInfo -> b -> Arg b
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
ai (b -> Arg b) -> m b -> m (Arg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a

instance HasRange a => HasRange (Arg a) where
    getRange :: Arg a -> Range
getRange = a -> Range
forall a. HasRange a => a -> Range
getRange (a -> Range) -> (Arg a -> a) -> Arg a -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arg a -> a
forall e. Arg e -> e
unArg

instance SetRange a => SetRange (Arg a) where
  setRange :: Range -> Arg a -> Arg a
setRange Range
r = (a -> a) -> Arg a -> Arg a
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Arg a -> Arg a) -> (a -> a) -> Arg a -> Arg a
forall a b. (a -> b) -> a -> b
$ Range -> a -> a
forall a. SetRange a => Range -> a -> a
setRange Range
r

instance KillRange a => KillRange (Arg a) where
  killRange :: KillRangeT (Arg a)
killRange (Arg ArgInfo
info a
a) = (ArgInfo -> a -> Arg a) -> ArgInfo -> a -> Arg a
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN ArgInfo -> a -> Arg a
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
info a
a

instance Pretty a => Pretty (Arg a) where
  prettyPrec :: Int -> Arg a -> Doc
prettyPrec Int
p (Arg ArgInfo
ai a
e) = ArgInfo -> (Doc -> Doc) -> Doc -> Doc
forall a. LensHiding a => a -> (Doc -> Doc) -> Doc -> Doc
prettyHiding ArgInfo
ai Doc -> Doc
localParens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p' a
e
      where p' :: Int
p' | ArgInfo -> Bool
forall a. LensHiding a => a -> Bool
visible ArgInfo
ai = Int
p
               | Bool
otherwise  = Int
0
            localParens :: Doc -> Doc
localParens | ArgInfo -> Origin
forall a. LensOrigin a => a -> Origin
getOrigin ArgInfo
ai Origin -> Origin -> Bool
forall a. Eq a => a -> a -> Bool
== Origin
Substitution = Doc -> Doc
parens
                        | Bool
otherwise = Doc -> Doc
forall a. a -> a
id

instance NFData e => NFData (Arg e) where
  rnf :: Arg e -> ()
rnf (Arg ArgInfo
a e
b) = ArgInfo -> ()
forall a. NFData a => a -> ()
rnf ArgInfo
a () -> () -> ()
forall a b. a -> b -> b
`seq` e -> ()
forall a. NFData a => a -> ()
rnf e
b

instance LensArgInfo (Arg a) where
  getArgInfo :: Arg a -> ArgInfo
getArgInfo        = Arg a -> ArgInfo
forall e. Arg e -> ArgInfo
argInfo
  setArgInfo :: ArgInfo -> Arg a -> Arg a
setArgInfo ArgInfo
ai Arg a
arg = Arg a
arg { argInfo = ai }
  mapArgInfo :: (ArgInfo -> ArgInfo) -> Arg a -> Arg a
mapArgInfo ArgInfo -> ArgInfo
f Arg a
arg  = Arg a
arg { argInfo = f $ argInfo arg }

-- The other lenses are defined through LensArgInfo

instance LensHiding (Arg e) where
  getHiding :: Arg e -> Hiding
getHiding = Arg e -> Hiding
forall a. LensArgInfo a => LensGet a Hiding
getHidingArgInfo
  setHiding :: Hiding -> Arg e -> Arg e
setHiding = Hiding -> Arg e -> Arg e
forall a. LensArgInfo a => LensSet a Hiding
setHidingArgInfo
  mapHiding :: (Hiding -> Hiding) -> Arg e -> Arg e
mapHiding = (Hiding -> Hiding) -> Arg e -> Arg e
forall a. LensArgInfo a => LensMap a Hiding
mapHidingArgInfo

instance LensOrigin (Arg e) where
  getOrigin :: Arg e -> Origin
getOrigin = Arg e -> Origin
forall a. LensArgInfo a => LensGet a Origin
getOriginArgInfo
  setOrigin :: Origin -> Arg e -> Arg e
setOrigin = Origin -> Arg e -> Arg e
forall a. LensArgInfo a => LensSet a Origin
setOriginArgInfo
  mapOrigin :: (Origin -> Origin) -> Arg e -> Arg e
mapOrigin = (Origin -> Origin) -> Arg e -> Arg e
forall a. LensArgInfo a => LensMap a Origin
mapOriginArgInfo

instance LensFreeVariables (Arg e) where
  getFreeVariables :: Arg e -> FreeVariables
getFreeVariables = Arg e -> FreeVariables
forall a. LensArgInfo a => LensGet a FreeVariables
getFreeVariablesArgInfo
  setFreeVariables :: FreeVariables -> Arg e -> Arg e
setFreeVariables = FreeVariables -> Arg e -> Arg e
forall a. LensArgInfo a => LensSet a FreeVariables
setFreeVariablesArgInfo
  mapFreeVariables :: (FreeVariables -> FreeVariables) -> Arg e -> Arg e
mapFreeVariables = (FreeVariables -> FreeVariables) -> Arg e -> Arg e
forall a. LensArgInfo a => LensMap a FreeVariables
mapFreeVariablesArgInfo

{-# INLINE defaultArg #-}
defaultArg :: a -> Arg a
defaultArg :: forall a. a -> Arg a
defaultArg = ArgInfo -> a -> Arg a
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
defaultArgInfo

-- | @xs \`withArgsFrom\` args@ translates @xs@ into a list of 'Arg's,
-- using the elements in @args@ to fill in the non-'unArg' fields.
--
-- Precondition: The two lists should have equal length.

withArgsFrom :: [a] -> [Arg b] -> [Arg a]
[a]
xs withArgsFrom :: forall a b. [a] -> [Arg b] -> [Arg a]
`withArgsFrom` [Arg b]
args =
  (a -> Arg b -> Arg a) -> [a] -> [Arg b] -> [Arg a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x Arg b
arg -> (b -> a) -> Arg b -> Arg a
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> a
forall a b. a -> b -> a
const a
x) Arg b
arg) [a]
xs [Arg b]
args

withNamedArgsFrom :: [a] -> [NamedArg b] -> [NamedArg a]
[a]
xs withNamedArgsFrom :: forall a b. [a] -> [NamedArg b] -> [NamedArg a]
`withNamedArgsFrom` [NamedArg b]
args =
  (a -> NamedArg b -> NamedArg a)
-> [a] -> [NamedArg b] -> [NamedArg a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x -> (Named NamedName b -> Named_ a) -> NamedArg b -> NamedArg a
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x a -> Named NamedName b -> Named_ a
forall a b. a -> Named NamedName b -> Named NamedName a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)) [a]
xs [NamedArg b]
args

---------------------------------------------------------------------------
-- * Names
---------------------------------------------------------------------------

class Eq a => Underscore a where
  underscore   :: a
  isUnderscore :: a -> Bool
  isUnderscore = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Underscore a => a
underscore)

instance Underscore String where
  underscore :: String
underscore = String
"_"

instance Underscore Text where
  underscore :: Text
underscore = Text
"_"

instance Underscore ShortText where
  underscore :: ArgName
underscore = ArgName
"_"

instance Underscore ByteString where
  underscore :: ByteString
underscore = String -> ByteString
ByteString.pack String
forall a. Underscore a => a
underscore

instance Underscore Doc where
  underscore :: Doc
underscore = String -> Doc
forall a. String -> Doc a
text String
forall a. Underscore a => a
underscore

---------------------------------------------------------------------------
-- * Named arguments
---------------------------------------------------------------------------

-- | Something potentially carrying a name.
data Named name a =
    Named { forall name a. Named name a -> Maybe name
nameOf     :: Maybe name
          , forall name a. Named name a -> a
namedThing :: a
          }
    deriving (Named name a -> Named name a -> Bool
(Named name a -> Named name a -> Bool)
-> (Named name a -> Named name a -> Bool) -> Eq (Named name a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall name a.
(Eq name, Eq a) =>
Named name a -> Named name a -> Bool
$c== :: forall name a.
(Eq name, Eq a) =>
Named name a -> Named name a -> Bool
== :: Named name a -> Named name a -> Bool
$c/= :: forall name a.
(Eq name, Eq a) =>
Named name a -> Named name a -> Bool
/= :: Named name a -> Named name a -> Bool
Eq, Eq (Named name a)
Eq (Named name a) =>
(Named name a -> Named name a -> Ordering)
-> (Named name a -> Named name a -> Bool)
-> (Named name a -> Named name a -> Bool)
-> (Named name a -> Named name a -> Bool)
-> (Named name a -> Named name a -> Bool)
-> (Named name a -> Named name a -> Named name a)
-> (Named name a -> Named name a -> Named name a)
-> Ord (Named name a)
Named name a -> Named name a -> Bool
Named name a -> Named name a -> Ordering
Named name a -> Named name a -> Named name a
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
forall name a. (Ord name, Ord a) => Eq (Named name a)
forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Bool
forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Ordering
forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Named name a
$ccompare :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Ordering
compare :: Named name a -> Named name a -> Ordering
$c< :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Bool
< :: Named name a -> Named name a -> Bool
$c<= :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Bool
<= :: Named name a -> Named name a -> Bool
$c> :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Bool
> :: Named name a -> Named name a -> Bool
$c>= :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Bool
>= :: Named name a -> Named name a -> Bool
$cmax :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Named name a
max :: Named name a -> Named name a -> Named name a
$cmin :: forall name a.
(Ord name, Ord a) =>
Named name a -> Named name a -> Named name a
min :: Named name a -> Named name a -> Named name a
Ord, Int -> Named name a -> ShowS
[Named name a] -> ShowS
Named name a -> String
(Int -> Named name a -> ShowS)
-> (Named name a -> String)
-> ([Named name a] -> ShowS)
-> Show (Named name a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall name a. (Show name, Show a) => Int -> Named name a -> ShowS
forall name a. (Show name, Show a) => [Named name a] -> ShowS
forall name a. (Show name, Show a) => Named name a -> String
$cshowsPrec :: forall name a. (Show name, Show a) => Int -> Named name a -> ShowS
showsPrec :: Int -> Named name a -> ShowS
$cshow :: forall name a. (Show name, Show a) => Named name a -> String
show :: Named name a -> String
$cshowList :: forall name a. (Show name, Show a) => [Named name a] -> ShowS
showList :: [Named name a] -> ShowS
Show, (forall a b. (a -> b) -> Named name a -> Named name b)
-> (forall a b. a -> Named name b -> Named name a)
-> Functor (Named name)
forall a b. a -> Named name b -> Named name a
forall a b. (a -> b) -> Named name a -> Named name b
forall name a b. a -> Named name b -> Named name a
forall name a b. (a -> b) -> Named name a -> Named name b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall name a b. (a -> b) -> Named name a -> Named name b
fmap :: forall a b. (a -> b) -> Named name a -> Named name b
$c<$ :: forall name a b. a -> Named name b -> Named name a
<$ :: forall a b. a -> Named name b -> Named name a
Functor, (forall m. Monoid m => Named name m -> m)
-> (forall m a. Monoid m => (a -> m) -> Named name a -> m)
-> (forall m a. Monoid m => (a -> m) -> Named name a -> m)
-> (forall a b. (a -> b -> b) -> b -> Named name a -> b)
-> (forall a b. (a -> b -> b) -> b -> Named name a -> b)
-> (forall b a. (b -> a -> b) -> b -> Named name a -> b)
-> (forall b a. (b -> a -> b) -> b -> Named name a -> b)
-> (forall a. (a -> a -> a) -> Named name a -> a)
-> (forall a. (a -> a -> a) -> Named name a -> a)
-> (forall a. Named name a -> [a])
-> (forall a. Named name a -> Bool)
-> (forall a. Named name a -> Int)
-> (forall a. Eq a => a -> Named name a -> Bool)
-> (forall a. Ord a => Named name a -> a)
-> (forall a. Ord a => Named name a -> a)
-> (forall a. Num a => Named name a -> a)
-> (forall a. Num a => Named name a -> a)
-> Foldable (Named name)
forall a. Eq a => a -> Named name a -> Bool
forall a. Num a => Named name a -> a
forall a. Ord a => Named name a -> a
forall m. Monoid m => Named name m -> m
forall a. Named name a -> Bool
forall a. Named name a -> Int
forall a. Named name a -> [a]
forall a. (a -> a -> a) -> Named name a -> a
forall name a. Eq a => a -> Named name a -> Bool
forall name a. Num a => Named name a -> a
forall name a. Ord a => Named name a -> a
forall name m. Monoid m => Named name m -> m
forall m a. Monoid m => (a -> m) -> Named name a -> m
forall name a. Named name a -> Bool
forall name a. Named name a -> Int
forall name a. Named name a -> [a]
forall b a. (b -> a -> b) -> b -> Named name a -> b
forall a b. (a -> b -> b) -> b -> Named name a -> b
forall name a. (a -> a -> a) -> Named name a -> a
forall name m a. Monoid m => (a -> m) -> Named name a -> m
forall name b a. (b -> a -> b) -> b -> Named name a -> b
forall name a b. (a -> b -> b) -> b -> Named name a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall name m. Monoid m => Named name m -> m
fold :: forall m. Monoid m => Named name m -> m
$cfoldMap :: forall name m a. Monoid m => (a -> m) -> Named name a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Named name a -> m
$cfoldMap' :: forall name m a. Monoid m => (a -> m) -> Named name a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Named name a -> m
$cfoldr :: forall name a b. (a -> b -> b) -> b -> Named name a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Named name a -> b
$cfoldr' :: forall name a b. (a -> b -> b) -> b -> Named name a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Named name a -> b
$cfoldl :: forall name b a. (b -> a -> b) -> b -> Named name a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Named name a -> b
$cfoldl' :: forall name b a. (b -> a -> b) -> b -> Named name a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Named name a -> b
$cfoldr1 :: forall name a. (a -> a -> a) -> Named name a -> a
foldr1 :: forall a. (a -> a -> a) -> Named name a -> a
$cfoldl1 :: forall name a. (a -> a -> a) -> Named name a -> a
foldl1 :: forall a. (a -> a -> a) -> Named name a -> a
$ctoList :: forall name a. Named name a -> [a]
toList :: forall a. Named name a -> [a]
$cnull :: forall name a. Named name a -> Bool
null :: forall a. Named name a -> Bool
$clength :: forall name a. Named name a -> Int
length :: forall a. Named name a -> Int
$celem :: forall name a. Eq a => a -> Named name a -> Bool
elem :: forall a. Eq a => a -> Named name a -> Bool
$cmaximum :: forall name a. Ord a => Named name a -> a
maximum :: forall a. Ord a => Named name a -> a
$cminimum :: forall name a. Ord a => Named name a -> a
minimum :: forall a. Ord a => Named name a -> a
$csum :: forall name a. Num a => Named name a -> a
sum :: forall a. Num a => Named name a -> a
$cproduct :: forall name a. Num a => Named name a -> a
product :: forall a. Num a => Named name a -> a
Foldable, Functor (Named name)
Foldable (Named name)
(Functor (Named name), Foldable (Named name)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Named name a -> f (Named name b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Named name (f a) -> f (Named name a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Named name a -> m (Named name b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Named name (m a) -> m (Named name a))
-> Traversable (Named name)
forall name. Functor (Named name)
forall name. Foldable (Named name)
forall name (m :: * -> *) a.
Monad m =>
Named name (m a) -> m (Named name a)
forall name (f :: * -> *) a.
Applicative f =>
Named name (f a) -> f (Named name a)
forall name (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named name a -> m (Named name b)
forall name (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named name a -> f (Named name b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Named name (m a) -> m (Named name a)
forall (f :: * -> *) a.
Applicative f =>
Named name (f a) -> f (Named name a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named name a -> m (Named name b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named name a -> f (Named name b)
$ctraverse :: forall name (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named name a -> f (Named name b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named name a -> f (Named name b)
$csequenceA :: forall name (f :: * -> *) a.
Applicative f =>
Named name (f a) -> f (Named name a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Named name (f a) -> f (Named name a)
$cmapM :: forall name (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named name a -> m (Named name b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Named name a -> m (Named name b)
$csequence :: forall name (m :: * -> *) a.
Monad m =>
Named name (m a) -> m (Named name a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Named name (m a) -> m (Named name a)
Traversable)

-- | Standard naming.
type Named_ = Named NamedName

-- | Standard argument names.
type NamedName = WithOrigin (Ranged ArgName)

-- | Equality of argument names of things modulo 'Range' and 'Origin'.
sameName :: NamedName -> NamedName -> Bool
sameName :: NamedName -> NamedName -> Bool
sameName = ArgName -> ArgName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ArgName -> ArgName -> Bool)
-> (NamedName -> ArgName) -> NamedName -> NamedName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Ranged ArgName -> ArgName
forall a. Ranged a -> a
rangedThing (Ranged ArgName -> ArgName)
-> (NamedName -> Ranged ArgName) -> NamedName -> ArgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedName -> Ranged ArgName
forall a. WithOrigin a -> a
woThing)

unnamed :: a -> Named name a
unnamed :: forall a name. a -> Named name a
unnamed = Maybe name -> a -> Named name a
forall name a. Maybe name -> a -> Named name a
Named Maybe name
forall a. Maybe a
Nothing

isUnnamed :: Named name a -> Maybe a
isUnnamed :: forall name a. Named name a -> Maybe a
isUnnamed = \case
  Named Maybe name
Nothing a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
  Named Just{}  a
_ -> Maybe a
forall a. Maybe a
Nothing

named :: name -> a -> Named name a
named :: forall name a. name -> a -> Named name a
named = Maybe name -> a -> Named name a
forall name a. Maybe name -> a -> Named name a
Named (Maybe name -> a -> Named name a)
-> (name -> Maybe name) -> name -> a -> Named name a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> Maybe name
forall a. a -> Maybe a
Just

userNamed :: Ranged ArgName -> a -> Named_ a
userNamed :: forall a. Ranged ArgName -> a -> Named_ a
userNamed = Maybe NamedName -> a -> Named NamedName a
forall name a. Maybe name -> a -> Named name a
Named (Maybe NamedName -> a -> Named NamedName a)
-> (Ranged ArgName -> Maybe NamedName)
-> Ranged ArgName
-> a
-> Named NamedName a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedName -> Maybe NamedName
forall a. a -> Maybe a
Just (NamedName -> Maybe NamedName)
-> (Ranged ArgName -> NamedName)
-> Ranged ArgName
-> Maybe NamedName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin -> Ranged ArgName -> NamedName
forall a. Origin -> a -> WithOrigin a
WithOrigin Origin
UserWritten

-- | Accessor/editor for the 'nameOf' component.
class LensNamed a where
  -- | The type of the name
  type NameOf a
  lensNamed :: Lens' a (Maybe (NameOf a))

  -- Lenses lift through decorations:
  default lensNamed :: (Decoration f, LensNamed b, NameOf b ~ NameOf a, f b ~ a) => Lens' a (Maybe (NameOf a))
  lensNamed = (b -> f b) -> a -> f a
(b -> f b) -> f b -> f (f b)
forall (t :: * -> *) (m :: * -> *) a b.
(Decoration t, Functor m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Functor m => (a -> m b) -> f a -> m (f b)
traverseF ((b -> f b) -> a -> f a)
-> ((Maybe (NameOf b) -> f (Maybe (NameOf b))) -> b -> f b)
-> (Maybe (NameOf b) -> f (Maybe (NameOf b)))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (NameOf b) -> f (Maybe (NameOf b))) -> b -> f b
forall a. LensNamed a => Lens' a (Maybe (NameOf a))
Lens' b (Maybe (NameOf b))
lensNamed

instance LensNamed a => LensNamed (Arg a) where
  type NameOf (Arg a) = NameOf a

instance LensNamed (Maybe a) where
  type NameOf (Maybe a) = a
  lensNamed :: Lens' (Maybe a) (Maybe (NameOf (Maybe a)))
lensNamed = (Maybe a -> f (Maybe a)) -> Maybe a -> f (Maybe a)
(Maybe (NameOf (Maybe a)) -> f (Maybe (NameOf (Maybe a))))
-> Maybe a -> f (Maybe a)
forall a. a -> a
id

instance LensNamed (Named name a) where
  type NameOf (Named name a) = name

  lensNamed :: Lens' (Named name a) (Maybe (NameOf (Named name a)))
lensNamed Maybe (NameOf (Named name a)) -> f (Maybe (NameOf (Named name a)))
f (Named Maybe name
mn a
a) = Maybe (NameOf (Named name a)) -> f (Maybe (NameOf (Named name a)))
f Maybe name
Maybe (NameOf (Named name a))
mn f (Maybe name) -> (Maybe name -> Named name a) -> f (Named name a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Maybe name
mn' -> Maybe name -> a -> Named name a
forall name a. Maybe name -> a -> Named name a
Named Maybe name
mn' a
a

getNameOf :: LensNamed a => a -> Maybe (NameOf a)
getNameOf :: forall a. LensNamed a => a -> Maybe (NameOf a)
getNameOf a
a = a
a a
-> Getting (Maybe (NameOf a)) a (Maybe (NameOf a))
-> Maybe (NameOf a)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (NameOf a)) a (Maybe (NameOf a))
forall a. LensNamed a => Lens' a (Maybe (NameOf a))
Lens' a (Maybe (NameOf a))
lensNamed

setNameOf :: LensNamed a => Maybe (NameOf a) -> a -> a
setNameOf :: forall a. LensNamed a => Maybe (NameOf a) -> a -> a
setNameOf = ASetter a a (Maybe (NameOf a)) (Maybe (NameOf a))
-> Maybe (NameOf a) -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter a a (Maybe (NameOf a)) (Maybe (NameOf a))
forall a. LensNamed a => Lens' a (Maybe (NameOf a))
Lens' a (Maybe (NameOf a))
lensNamed

mapNameOf :: LensNamed a => (Maybe (NameOf a) -> Maybe (NameOf a)) -> a -> a
mapNameOf :: forall a.
LensNamed a =>
(Maybe (NameOf a) -> Maybe (NameOf a)) -> a -> a
mapNameOf = ASetter a a (Maybe (NameOf a)) (Maybe (NameOf a))
-> (Maybe (NameOf a) -> Maybe (NameOf a)) -> a -> a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter a a (Maybe (NameOf a)) (Maybe (NameOf a))
forall a. LensNamed a => Lens' a (Maybe (NameOf a))
Lens' a (Maybe (NameOf a))
lensNamed

bareNameOf :: (LensNamed a, NameOf a ~ NamedName) => a -> Maybe ArgName
bareNameOf :: forall a. (LensNamed a, NameOf a ~ NamedName) => a -> Maybe ArgName
bareNameOf a
a = Ranged ArgName -> ArgName
forall a. Ranged a -> a
rangedThing (Ranged ArgName -> ArgName)
-> (NamedName -> Ranged ArgName) -> NamedName -> ArgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedName -> Ranged ArgName
forall a. WithOrigin a -> a
woThing (NamedName -> ArgName) -> Maybe NamedName -> Maybe ArgName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe (NameOf a)
forall a. LensNamed a => a -> Maybe (NameOf a)
getNameOf a
a

bareNameWithDefault :: (LensNamed a, NameOf a ~ NamedName) => ArgName -> a -> ArgName
bareNameWithDefault :: forall a.
(LensNamed a, NameOf a ~ NamedName) =>
ArgName -> a -> ArgName
bareNameWithDefault ArgName
x a
a = ArgName -> (NamedName -> ArgName) -> Maybe NamedName -> ArgName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ArgName
x (Ranged ArgName -> ArgName
forall a. Ranged a -> a
rangedThing (Ranged ArgName -> ArgName)
-> (NamedName -> Ranged ArgName) -> NamedName -> ArgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedName -> Ranged ArgName
forall a. WithOrigin a -> a
woThing) (Maybe NamedName -> ArgName) -> Maybe NamedName -> ArgName
forall a b. (a -> b) -> a -> b
$ a -> Maybe (NameOf a)
forall a. LensNamed a => a -> Maybe (NameOf a)
getNameOf a
a

-- | Equality of argument names of things modulo 'Range' and 'Origin'.
namedSame :: (LensNamed a, LensNamed b, NameOf a ~ NamedName, NameOf b ~ NamedName) => a -> b -> Bool
namedSame :: forall a b.
(LensNamed a, LensNamed b, NameOf a ~ NamedName,
 NameOf b ~ NamedName) =>
a -> b -> Bool
namedSame a
a b
b = case (a -> Maybe (NameOf a)
forall a. LensNamed a => a -> Maybe (NameOf a)
getNameOf a
a, b -> Maybe (NameOf b)
forall a. LensNamed a => a -> Maybe (NameOf a)
getNameOf b
b) of
  (Maybe NamedName
Nothing, Maybe NamedName
Nothing) -> Bool
True
  (Just NamedName
x , Just NamedName
y ) -> NamedName -> NamedName -> Bool
sameName NamedName
x NamedName
y
  (Maybe NamedName, Maybe NamedName)
_ -> Bool
False

-- | Does an argument @arg@ fit the shape @dom@ of the next expected argument?
--
--   The hiding has to match, and if the argument has a name, it should match
--   the name of the domain.
--
--   'Nothing' should be '__IMPOSSIBLE__', so use as
--   @@
--     fromMaybe __IMPOSSIBLE__ $ fittingNamedArg arg dom
--   @@
--
fittingNamedArg
  :: ( LensNamed arg, NameOf arg ~ NamedName, LensHiding arg
     , LensNamed dom, NameOf dom ~ NamedName, LensHiding dom )
  => arg -> dom -> Maybe Bool
fittingNamedArg :: forall arg dom.
(LensNamed arg, NameOf arg ~ NamedName, LensHiding arg,
 LensNamed dom, NameOf dom ~ NamedName, LensHiding dom) =>
arg -> dom -> Maybe Bool
fittingNamedArg arg
arg dom
dom
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ arg -> dom -> Bool
forall a b. (LensHiding a, LensHiding b) => a -> b -> Bool
sameHiding arg
arg dom
dom = Maybe Bool
no
    | arg -> Bool
forall a. LensHiding a => a -> Bool
visible arg
arg              = Maybe Bool
yes
    | Bool
otherwise =
        Maybe ArgName
-> Maybe Bool -> (ArgName -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe (arg -> Maybe ArgName
forall a. (LensNamed a, NameOf a ~ NamedName) => a -> Maybe ArgName
bareNameOf arg
arg) Maybe Bool
yes        ((ArgName -> Maybe Bool) -> Maybe Bool)
-> (ArgName -> Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ \ ArgName
x ->
        Maybe ArgName
-> Maybe Bool -> (ArgName -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> b -> (a -> b) -> b
caseMaybe (dom -> Maybe ArgName
forall a. (LensNamed a, NameOf a ~ NamedName) => a -> Maybe ArgName
bareNameOf dom
dom) Maybe Bool
forall a. Maybe a
impossible ((ArgName -> Maybe Bool) -> Maybe Bool)
-> (ArgName -> Maybe Bool) -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ \ ArgName
y ->
        Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ ArgName
x ArgName -> ArgName -> Bool
forall a. Eq a => a -> a -> Bool
== ArgName
y
  where
    yes :: Maybe Bool
yes = Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    no :: Maybe Bool
no  = Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    impossible :: Maybe a
impossible = Maybe a
forall a. Maybe a
Nothing

-- Standard instances for 'Named':

instance Decoration (Named name) where
  traverseF :: forall (m :: * -> *) a b.
Functor m =>
(a -> m b) -> Named name a -> m (Named name b)
traverseF a -> m b
f (Named Maybe name
n a
a) = Maybe name -> b -> Named name b
forall name a. Maybe name -> a -> Named name a
Named Maybe name
n (b -> Named name b) -> m b -> m (Named name b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a

instance HasRange a => HasRange (Named name a) where
    getRange :: Named name a -> Range
getRange = a -> Range
forall a. HasRange a => a -> Range
getRange (a -> Range) -> (Named name a -> a) -> Named name a -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named name a -> a
forall name a. Named name a -> a
namedThing

instance SetRange a => SetRange (Named name a) where
  setRange :: Range -> Named name a -> Named name a
setRange Range
r = (a -> a) -> Named name a -> Named name a
forall a b. (a -> b) -> Named name a -> Named name b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Named name a -> Named name a)
-> (a -> a) -> Named name a -> Named name a
forall a b. (a -> b) -> a -> b
$ Range -> a -> a
forall a. SetRange a => Range -> a -> a
setRange Range
r

instance (KillRange name, KillRange a) => KillRange (Named name a) where
  killRange :: KillRangeT (Named name a)
killRange (Named Maybe name
n a
a) = Maybe name -> a -> Named name a
forall name a. Maybe name -> a -> Named name a
Named (KillRangeT (Maybe name)
forall a. KillRange a => KillRangeT a
killRange Maybe name
n) (KillRangeT a
forall a. KillRange a => KillRangeT a
killRange a
a)

-- instance Show a => Show (Named_ a) where
--     show (Named Nothing a)  = show a
--     show (Named (Just n) a) = rawNameToString (rangedThing n) ++ " = " ++ show a

-- -- Defined in Concrete.Pretty
-- instance Pretty a => Pretty (Named_ a) where
--     pretty (Named Nothing a)  = pretty a
--     pretty (Named (Just n) a) = text (rawNameToString (rangedThing n)) <+> "=" <+> pretty a

instance (NFData name, NFData a) => NFData (Named name a) where
  rnf :: Named name a -> ()
rnf (Named Maybe name
a a
b) = Maybe name -> ()
forall a. NFData a => a -> ()
rnf Maybe name
a () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
b

instance Pretty e => Pretty (Named_ e) where
  prettyPrec :: Int -> Named_ e -> Doc
prettyPrec Int
p (Named Maybe NamedName
nm e
e)
    | Just ArgName
s <- Maybe NamedName -> Maybe ArgName
forall a. (LensNamed a, NameOf a ~ NamedName) => a -> Maybe ArgName
bareNameOf Maybe NamedName
nm = Bool -> Doc -> Doc
mparens (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ String -> Doc
forall a. String -> Doc a
text (ArgName -> String
TS.unpack ArgName
s) Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc
"=", e -> Doc
forall a. Pretty a => a -> Doc
pretty e
e ]
    | Bool
otherwise               = Int -> e -> Doc
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p e
e

-- | Only 'Hidden' arguments can have names.
type NamedArg a = Arg (Named_ a)

-- | Get the content of a 'NamedArg'.
namedArg :: NamedArg a -> a
namedArg :: forall a. NamedArg a -> a
namedArg = Named NamedName a -> a
forall name a. Named name a -> a
namedThing (Named NamedName a -> a)
-> (NamedArg a -> Named NamedName a) -> NamedArg a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedArg a -> Named NamedName a
forall e. Arg e -> e
unArg

defaultNamedArg :: a -> NamedArg a
defaultNamedArg :: forall a. a -> NamedArg a
defaultNamedArg = ArgInfo -> a -> NamedArg a
forall a. ArgInfo -> a -> NamedArg a
unnamedArg ArgInfo
defaultArgInfo

unnamedArg :: ArgInfo -> a -> NamedArg a
unnamedArg :: forall a. ArgInfo -> a -> NamedArg a
unnamedArg ArgInfo
info = ArgInfo -> Named_ a -> Arg (Named_ a)
forall e. ArgInfo -> e -> Arg e
Arg ArgInfo
info (Named_ a -> Arg (Named_ a))
-> (a -> Named_ a) -> a -> Arg (Named_ a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Named_ a
forall a name. a -> Named name a
unnamed

-- | The functor instance for 'NamedArg' would be ambiguous,
--   so we give it another name here.
updateNamedArg :: (a -> b) -> NamedArg a -> NamedArg b
updateNamedArg :: forall a b. (a -> b) -> NamedArg a -> NamedArg b
updateNamedArg = (Named_ a -> Named_ b) -> Arg (Named_ a) -> Arg (Named_ b)
forall a b. (a -> b) -> Arg a -> Arg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Named_ a -> Named_ b) -> Arg (Named_ a) -> Arg (Named_ b))
-> ((a -> b) -> Named_ a -> Named_ b)
-> (a -> b)
-> Arg (Named_ a)
-> Arg (Named_ b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Named_ a -> Named_ b
forall a b. (a -> b) -> Named NamedName a -> Named NamedName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

updateNamedArgA :: Applicative f => (a -> f b) -> NamedArg a -> f (NamedArg b)
updateNamedArgA :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NamedArg a -> f (NamedArg b)
updateNamedArgA = (Named_ a -> f (Named_ b)) -> Arg (Named_ a) -> f (Arg (Named_ b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Arg a -> f (Arg b)
traverse ((Named_ a -> f (Named_ b))
 -> Arg (Named_ a) -> f (Arg (Named_ b)))
-> ((a -> f b) -> Named_ a -> f (Named_ b))
-> (a -> f b)
-> Arg (Named_ a)
-> f (Arg (Named_ b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> Named_ a -> f (Named_ b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Named NamedName a -> f (Named NamedName b)
traverse

-- | @setNamedArg a b = updateNamedArg (const b) a@
setNamedArg :: NamedArg a -> b -> NamedArg b
setNamedArg :: forall a b. NamedArg a -> b -> NamedArg b
setNamedArg NamedArg a
a b
b = (b
b b -> Named NamedName a -> Named NamedName b
forall a b. a -> Named NamedName b -> Named NamedName a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Named NamedName a -> Named NamedName b)
-> NamedArg a -> Arg (Named NamedName b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedArg a
a

-- ** ArgName

-- | Names in binders and arguments.
type ArgName = ShortText

argNameToString :: ArgName -> ShortText
argNameToString :: ArgName -> ArgName
argNameToString = ArgName -> ArgName
forall a. a -> a
id

stringToArgName :: ShortText -> ArgName
stringToArgName :: ArgName -> ArgName
stringToArgName = ArgName -> ArgName
forall a. a -> a
id

appendArgNames :: ArgName -> ArgName -> ArgName
appendArgNames :: ArgName -> ArgName -> ArgName
appendArgNames = ArgName -> ArgName -> ArgName
forall a. Semigroup a => a -> a -> a
(<>)

---------------------------------------------------------------------------
-- * Range decoration.
---------------------------------------------------------------------------

-- | Thing with range info.
data Ranged a = Ranged
  { forall a. Ranged a -> Range
rangeOf     :: Range
  , forall a. Ranged a -> a
rangedThing :: a
  }
  deriving (Int -> Ranged a -> ShowS
[Ranged a] -> ShowS
Ranged a -> String
(Int -> Ranged a -> ShowS)
-> (Ranged a -> String) -> ([Ranged a] -> ShowS) -> Show (Ranged a)
forall a. Show a => Int -> Ranged a -> ShowS
forall a. Show a => [Ranged a] -> ShowS
forall a. Show a => Ranged a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Ranged a -> ShowS
showsPrec :: Int -> Ranged a -> ShowS
$cshow :: forall a. Show a => Ranged a -> String
show :: Ranged a -> String
$cshowList :: forall a. Show a => [Ranged a] -> ShowS
showList :: [Ranged a] -> ShowS
Show, (forall a b. (a -> b) -> Ranged a -> Ranged b)
-> (forall a b. a -> Ranged b -> Ranged a) -> Functor Ranged
forall a b. a -> Ranged b -> Ranged a
forall a b. (a -> b) -> Ranged a -> Ranged b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Ranged a -> Ranged b
fmap :: forall a b. (a -> b) -> Ranged a -> Ranged b
$c<$ :: forall a b. a -> Ranged b -> Ranged a
<$ :: forall a b. a -> Ranged b -> Ranged a
Functor, (forall m. Monoid m => Ranged m -> m)
-> (forall m a. Monoid m => (a -> m) -> Ranged a -> m)
-> (forall m a. Monoid m => (a -> m) -> Ranged a -> m)
-> (forall a b. (a -> b -> b) -> b -> Ranged a -> b)
-> (forall a b. (a -> b -> b) -> b -> Ranged a -> b)
-> (forall b a. (b -> a -> b) -> b -> Ranged a -> b)
-> (forall b a. (b -> a -> b) -> b -> Ranged a -> b)
-> (forall a. (a -> a -> a) -> Ranged a -> a)
-> (forall a. (a -> a -> a) -> Ranged a -> a)
-> (forall a. Ranged a -> [a])
-> (forall a. Ranged a -> Bool)
-> (forall a. Ranged a -> Int)
-> (forall a. Eq a => a -> Ranged a -> Bool)
-> (forall a. Ord a => Ranged a -> a)
-> (forall a. Ord a => Ranged a -> a)
-> (forall a. Num a => Ranged a -> a)
-> (forall a. Num a => Ranged a -> a)
-> Foldable Ranged
forall a. Eq a => a -> Ranged a -> Bool
forall a. Num a => Ranged a -> a
forall a. Ord a => Ranged a -> a
forall m. Monoid m => Ranged m -> m
forall a. Ranged a -> Bool
forall a. Ranged a -> Int
forall a. Ranged a -> [a]
forall a. (a -> a -> a) -> Ranged a -> a
forall m a. Monoid m => (a -> m) -> Ranged a -> m
forall b a. (b -> a -> b) -> b -> Ranged a -> b
forall a b. (a -> b -> b) -> b -> Ranged a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Ranged m -> m
fold :: forall m. Monoid m => Ranged m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Ranged a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Ranged a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Ranged a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Ranged a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Ranged a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Ranged a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Ranged a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Ranged a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Ranged a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Ranged a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Ranged a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Ranged a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Ranged a -> a
foldr1 :: forall a. (a -> a -> a) -> Ranged a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Ranged a -> a
foldl1 :: forall a. (a -> a -> a) -> Ranged a -> a
$ctoList :: forall a. Ranged a -> [a]
toList :: forall a. Ranged a -> [a]
$cnull :: forall a. Ranged a -> Bool
null :: forall a. Ranged a -> Bool
$clength :: forall a. Ranged a -> Int
length :: forall a. Ranged a -> Int
$celem :: forall a. Eq a => a -> Ranged a -> Bool
elem :: forall a. Eq a => a -> Ranged a -> Bool
$cmaximum :: forall a. Ord a => Ranged a -> a
maximum :: forall a. Ord a => Ranged a -> a
$cminimum :: forall a. Ord a => Ranged a -> a
minimum :: forall a. Ord a => Ranged a -> a
$csum :: forall a. Num a => Ranged a -> a
sum :: forall a. Num a => Ranged a -> a
$cproduct :: forall a. Num a => Ranged a -> a
product :: forall a. Num a => Ranged a -> a
Foldable, Functor Ranged
Foldable Ranged
(Functor Ranged, Foldable Ranged) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Ranged a -> f (Ranged b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Ranged (f a) -> f (Ranged a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Ranged a -> m (Ranged b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Ranged (m a) -> m (Ranged a))
-> Traversable Ranged
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Ranged (m a) -> m (Ranged a)
forall (f :: * -> *) a.
Applicative f =>
Ranged (f a) -> f (Ranged a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ranged a -> m (Ranged b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ranged a -> f (Ranged b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ranged a -> f (Ranged b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Ranged a -> f (Ranged b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Ranged (f a) -> f (Ranged a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Ranged (f a) -> f (Ranged a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ranged a -> m (Ranged b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Ranged a -> m (Ranged b)
$csequence :: forall (m :: * -> *) a. Monad m => Ranged (m a) -> m (Ranged a)
sequence :: forall (m :: * -> *) a. Monad m => Ranged (m a) -> m (Ranged a)
Traversable)

-- | Thing with no range info.
unranged :: a -> Ranged a
unranged :: forall a. a -> Ranged a
unranged = Range -> a -> Ranged a
forall a. Range -> a -> Ranged a
Ranged Range
forall a. Range' a
noRange

-- | Pair the thing with its own range.
itsRange :: HasRange a => a -> Ranged a
itsRange :: forall a. HasRange a => a -> Ranged a
itsRange a
a = Range -> a -> Ranged a
forall a. Range -> a -> Ranged a
Ranged (a -> Range
forall a. HasRange a => a -> Range
getRange a
a) a
a

-- | Ignores range.
instance Pretty a => Pretty (Ranged a) where
  pretty :: Ranged a -> Doc
pretty = a -> Doc
forall a. Pretty a => a -> Doc
pretty (a -> Doc) -> (Ranged a -> a) -> Ranged a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ranged a -> a
forall a. Ranged a -> a
rangedThing

-- | Ignores range.
instance Eq a => Eq (Ranged a) where
  == :: Ranged a -> Ranged a -> Bool
(==) = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> (Ranged a -> a) -> Ranged a -> Ranged a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Ranged a -> a
forall a. Ranged a -> a
rangedThing

-- | Ignores range.
instance Ord a => Ord (Ranged a) where
  compare :: Ranged a -> Ranged a -> Ordering
compare = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a -> Ordering)
-> (Ranged a -> a) -> Ranged a -> Ranged a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Ranged a -> a
forall a. Ranged a -> a
rangedThing

instance HasRange (Ranged a) where
  getRange :: Ranged a -> Range
getRange = Ranged a -> Range
forall a. Ranged a -> Range
rangeOf

instance KillRange (Ranged a) where
  killRange :: KillRangeT (Ranged a)
killRange (Ranged Range
_ a
x) = Range -> a -> Ranged a
forall a. Range -> a -> Ranged a
Ranged Range
forall a. Range' a
noRange a
x

instance Decoration Ranged where
  traverseF :: forall (m :: * -> *) a b.
Functor m =>
(a -> m b) -> Ranged a -> m (Ranged b)
traverseF a -> m b
f (Ranged Range
r a
x) = Range -> b -> Ranged b
forall a. Range -> a -> Ranged a
Ranged Range
r (b -> Ranged b) -> m b -> m (Ranged b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
x

-- | Ranges are not forced.

instance NFData a => NFData (Ranged a) where
  rnf :: Ranged a -> ()
rnf (Ranged Range
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

---------------------------------------------------------------------------
-- * Raw names (before parsing into name parts).
---------------------------------------------------------------------------

-- | A @RawName@ is some sort of string.
type RawName = ShortText

rawNameToString :: RawName -> ShortText
rawNameToString :: ArgName -> ArgName
rawNameToString = ArgName -> ArgName
forall a. a -> a
id

stringToRawName :: ShortText -> RawName
stringToRawName :: ArgName -> ArgName
stringToRawName = ArgName -> ArgName
forall a. a -> a
id

-- | String with range info.
type RString = Ranged RawName

---------------------------------------------------------------------------
-- * Further constructor and projection info
---------------------------------------------------------------------------

-- | Where does the 'ConP' or 'Con' come from?
data ConOrigin
  = ConOSystem   -- ^ Inserted by system or expanded from an implicit pattern.
  | ConOCon      -- ^ User wrote a constructor (pattern).
  | ConORec      -- ^ User wrote a record (pattern).
  | ConOSplit    -- ^ Generated by interactive case splitting.
  | ConORecWhere -- ^ User wrote a @record where@ expression.
  deriving (Int -> ConOrigin -> ShowS
[ConOrigin] -> ShowS
ConOrigin -> String
(Int -> ConOrigin -> ShowS)
-> (ConOrigin -> String)
-> ([ConOrigin] -> ShowS)
-> Show ConOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConOrigin -> ShowS
showsPrec :: Int -> ConOrigin -> ShowS
$cshow :: ConOrigin -> String
show :: ConOrigin -> String
$cshowList :: [ConOrigin] -> ShowS
showList :: [ConOrigin] -> ShowS
Show, ConOrigin -> ConOrigin -> Bool
(ConOrigin -> ConOrigin -> Bool)
-> (ConOrigin -> ConOrigin -> Bool) -> Eq ConOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConOrigin -> ConOrigin -> Bool
== :: ConOrigin -> ConOrigin -> Bool
$c/= :: ConOrigin -> ConOrigin -> Bool
/= :: ConOrigin -> ConOrigin -> Bool
Eq, Eq ConOrigin
Eq ConOrigin =>
(ConOrigin -> ConOrigin -> Ordering)
-> (ConOrigin -> ConOrigin -> Bool)
-> (ConOrigin -> ConOrigin -> Bool)
-> (ConOrigin -> ConOrigin -> Bool)
-> (ConOrigin -> ConOrigin -> Bool)
-> (ConOrigin -> ConOrigin -> ConOrigin)
-> (ConOrigin -> ConOrigin -> ConOrigin)
-> Ord ConOrigin
ConOrigin -> ConOrigin -> Bool
ConOrigin -> ConOrigin -> Ordering
ConOrigin -> ConOrigin -> ConOrigin
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
$ccompare :: ConOrigin -> ConOrigin -> Ordering
compare :: ConOrigin -> ConOrigin -> Ordering
$c< :: ConOrigin -> ConOrigin -> Bool
< :: ConOrigin -> ConOrigin -> Bool
$c<= :: ConOrigin -> ConOrigin -> Bool
<= :: ConOrigin -> ConOrigin -> Bool
$c> :: ConOrigin -> ConOrigin -> Bool
> :: ConOrigin -> ConOrigin -> Bool
$c>= :: ConOrigin -> ConOrigin -> Bool
>= :: ConOrigin -> ConOrigin -> Bool
$cmax :: ConOrigin -> ConOrigin -> ConOrigin
max :: ConOrigin -> ConOrigin -> ConOrigin
$cmin :: ConOrigin -> ConOrigin -> ConOrigin
min :: ConOrigin -> ConOrigin -> ConOrigin
Ord, Int -> ConOrigin
ConOrigin -> Int
ConOrigin -> [ConOrigin]
ConOrigin -> ConOrigin
ConOrigin -> ConOrigin -> [ConOrigin]
ConOrigin -> ConOrigin -> ConOrigin -> [ConOrigin]
(ConOrigin -> ConOrigin)
-> (ConOrigin -> ConOrigin)
-> (Int -> ConOrigin)
-> (ConOrigin -> Int)
-> (ConOrigin -> [ConOrigin])
-> (ConOrigin -> ConOrigin -> [ConOrigin])
-> (ConOrigin -> ConOrigin -> [ConOrigin])
-> (ConOrigin -> ConOrigin -> ConOrigin -> [ConOrigin])
-> Enum ConOrigin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConOrigin -> ConOrigin
succ :: ConOrigin -> ConOrigin
$cpred :: ConOrigin -> ConOrigin
pred :: ConOrigin -> ConOrigin
$ctoEnum :: Int -> ConOrigin
toEnum :: Int -> ConOrigin
$cfromEnum :: ConOrigin -> Int
fromEnum :: ConOrigin -> Int
$cenumFrom :: ConOrigin -> [ConOrigin]
enumFrom :: ConOrigin -> [ConOrigin]
$cenumFromThen :: ConOrigin -> ConOrigin -> [ConOrigin]
enumFromThen :: ConOrigin -> ConOrigin -> [ConOrigin]
$cenumFromTo :: ConOrigin -> ConOrigin -> [ConOrigin]
enumFromTo :: ConOrigin -> ConOrigin -> [ConOrigin]
$cenumFromThenTo :: ConOrigin -> ConOrigin -> ConOrigin -> [ConOrigin]
enumFromThenTo :: ConOrigin -> ConOrigin -> ConOrigin -> [ConOrigin]
Enum, ConOrigin
ConOrigin -> ConOrigin -> Bounded ConOrigin
forall a. a -> a -> Bounded a
$cminBound :: ConOrigin
minBound :: ConOrigin
$cmaxBound :: ConOrigin
maxBound :: ConOrigin
Bounded, (forall x. ConOrigin -> Rep ConOrigin x)
-> (forall x. Rep ConOrigin x -> ConOrigin) -> Generic ConOrigin
forall x. Rep ConOrigin x -> ConOrigin
forall x. ConOrigin -> Rep ConOrigin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConOrigin -> Rep ConOrigin x
from :: forall x. ConOrigin -> Rep ConOrigin x
$cto :: forall x. Rep ConOrigin x -> ConOrigin
to :: forall x. Rep ConOrigin x -> ConOrigin
Generic)

instance NFData ConOrigin

instance KillRange ConOrigin where
  killRange :: ConOrigin -> ConOrigin
killRange = ConOrigin -> ConOrigin
forall a. a -> a
id

-- | Prefer user-written over system-inserted.
bestConInfo :: ConOrigin -> ConOrigin -> ConOrigin
bestConInfo :: ConOrigin -> ConOrigin -> ConOrigin
bestConInfo ConOrigin
ConOSystem ConOrigin
o = ConOrigin
o
bestConInfo ConOrigin
o ConOrigin
_ = ConOrigin
o

-- | Where does a projection come from?
data ProjOrigin
  = ProjPrefix    -- ^ User wrote a prefix projection.
  | ProjPostfix   -- ^ User wrote a postfix projection.
  | ProjSystem    -- ^ Projection was generated by the system.
  deriving (Int -> ProjOrigin -> ShowS
[ProjOrigin] -> ShowS
ProjOrigin -> String
(Int -> ProjOrigin -> ShowS)
-> (ProjOrigin -> String)
-> ([ProjOrigin] -> ShowS)
-> Show ProjOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjOrigin -> ShowS
showsPrec :: Int -> ProjOrigin -> ShowS
$cshow :: ProjOrigin -> String
show :: ProjOrigin -> String
$cshowList :: [ProjOrigin] -> ShowS
showList :: [ProjOrigin] -> ShowS
Show, ProjOrigin -> ProjOrigin -> Bool
(ProjOrigin -> ProjOrigin -> Bool)
-> (ProjOrigin -> ProjOrigin -> Bool) -> Eq ProjOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjOrigin -> ProjOrigin -> Bool
== :: ProjOrigin -> ProjOrigin -> Bool
$c/= :: ProjOrigin -> ProjOrigin -> Bool
/= :: ProjOrigin -> ProjOrigin -> Bool
Eq, Eq ProjOrigin
Eq ProjOrigin =>
(ProjOrigin -> ProjOrigin -> Ordering)
-> (ProjOrigin -> ProjOrigin -> Bool)
-> (ProjOrigin -> ProjOrigin -> Bool)
-> (ProjOrigin -> ProjOrigin -> Bool)
-> (ProjOrigin -> ProjOrigin -> Bool)
-> (ProjOrigin -> ProjOrigin -> ProjOrigin)
-> (ProjOrigin -> ProjOrigin -> ProjOrigin)
-> Ord ProjOrigin
ProjOrigin -> ProjOrigin -> Bool
ProjOrigin -> ProjOrigin -> Ordering
ProjOrigin -> ProjOrigin -> ProjOrigin
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
$ccompare :: ProjOrigin -> ProjOrigin -> Ordering
compare :: ProjOrigin -> ProjOrigin -> Ordering
$c< :: ProjOrigin -> ProjOrigin -> Bool
< :: ProjOrigin -> ProjOrigin -> Bool
$c<= :: ProjOrigin -> ProjOrigin -> Bool
<= :: ProjOrigin -> ProjOrigin -> Bool
$c> :: ProjOrigin -> ProjOrigin -> Bool
> :: ProjOrigin -> ProjOrigin -> Bool
$c>= :: ProjOrigin -> ProjOrigin -> Bool
>= :: ProjOrigin -> ProjOrigin -> Bool
$cmax :: ProjOrigin -> ProjOrigin -> ProjOrigin
max :: ProjOrigin -> ProjOrigin -> ProjOrigin
$cmin :: ProjOrigin -> ProjOrigin -> ProjOrigin
min :: ProjOrigin -> ProjOrigin -> ProjOrigin
Ord, Int -> ProjOrigin
ProjOrigin -> Int
ProjOrigin -> [ProjOrigin]
ProjOrigin -> ProjOrigin
ProjOrigin -> ProjOrigin -> [ProjOrigin]
ProjOrigin -> ProjOrigin -> ProjOrigin -> [ProjOrigin]
(ProjOrigin -> ProjOrigin)
-> (ProjOrigin -> ProjOrigin)
-> (Int -> ProjOrigin)
-> (ProjOrigin -> Int)
-> (ProjOrigin -> [ProjOrigin])
-> (ProjOrigin -> ProjOrigin -> [ProjOrigin])
-> (ProjOrigin -> ProjOrigin -> [ProjOrigin])
-> (ProjOrigin -> ProjOrigin -> ProjOrigin -> [ProjOrigin])
-> Enum ProjOrigin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ProjOrigin -> ProjOrigin
succ :: ProjOrigin -> ProjOrigin
$cpred :: ProjOrigin -> ProjOrigin
pred :: ProjOrigin -> ProjOrigin
$ctoEnum :: Int -> ProjOrigin
toEnum :: Int -> ProjOrigin
$cfromEnum :: ProjOrigin -> Int
fromEnum :: ProjOrigin -> Int
$cenumFrom :: ProjOrigin -> [ProjOrigin]
enumFrom :: ProjOrigin -> [ProjOrigin]
$cenumFromThen :: ProjOrigin -> ProjOrigin -> [ProjOrigin]
enumFromThen :: ProjOrigin -> ProjOrigin -> [ProjOrigin]
$cenumFromTo :: ProjOrigin -> ProjOrigin -> [ProjOrigin]
enumFromTo :: ProjOrigin -> ProjOrigin -> [ProjOrigin]
$cenumFromThenTo :: ProjOrigin -> ProjOrigin -> ProjOrigin -> [ProjOrigin]
enumFromThenTo :: ProjOrigin -> ProjOrigin -> ProjOrigin -> [ProjOrigin]
Enum, ProjOrigin
ProjOrigin -> ProjOrigin -> Bounded ProjOrigin
forall a. a -> a -> Bounded a
$cminBound :: ProjOrigin
minBound :: ProjOrigin
$cmaxBound :: ProjOrigin
maxBound :: ProjOrigin
Bounded, (forall x. ProjOrigin -> Rep ProjOrigin x)
-> (forall x. Rep ProjOrigin x -> ProjOrigin) -> Generic ProjOrigin
forall x. Rep ProjOrigin x -> ProjOrigin
forall x. ProjOrigin -> Rep ProjOrigin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjOrigin -> Rep ProjOrigin x
from :: forall x. ProjOrigin -> Rep ProjOrigin x
$cto :: forall x. Rep ProjOrigin x -> ProjOrigin
to :: forall x. Rep ProjOrigin x -> ProjOrigin
Generic)

instance NFData ProjOrigin

instance KillRange ProjOrigin where
  killRange :: ProjOrigin -> ProjOrigin
killRange = ProjOrigin -> ProjOrigin
forall a. a -> a
id

---------------------------------------------------------------------------
-- * Infixity, access, abstract, etc.
---------------------------------------------------------------------------

-- | Functions can be defined in both infix and prefix style. See
--   'Agda.Syntax.Concrete.LHS'.
data IsInfix = InfixDef | PrefixDef
    deriving (Int -> IsInfix -> ShowS
[IsInfix] -> ShowS
IsInfix -> String
(Int -> IsInfix -> ShowS)
-> (IsInfix -> String) -> ([IsInfix] -> ShowS) -> Show IsInfix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsInfix -> ShowS
showsPrec :: Int -> IsInfix -> ShowS
$cshow :: IsInfix -> String
show :: IsInfix -> String
$cshowList :: [IsInfix] -> ShowS
showList :: [IsInfix] -> ShowS
Show, IsInfix -> IsInfix -> Bool
(IsInfix -> IsInfix -> Bool)
-> (IsInfix -> IsInfix -> Bool) -> Eq IsInfix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsInfix -> IsInfix -> Bool
== :: IsInfix -> IsInfix -> Bool
$c/= :: IsInfix -> IsInfix -> Bool
/= :: IsInfix -> IsInfix -> Bool
Eq, Eq IsInfix
Eq IsInfix =>
(IsInfix -> IsInfix -> Ordering)
-> (IsInfix -> IsInfix -> Bool)
-> (IsInfix -> IsInfix -> Bool)
-> (IsInfix -> IsInfix -> Bool)
-> (IsInfix -> IsInfix -> Bool)
-> (IsInfix -> IsInfix -> IsInfix)
-> (IsInfix -> IsInfix -> IsInfix)
-> Ord IsInfix
IsInfix -> IsInfix -> Bool
IsInfix -> IsInfix -> Ordering
IsInfix -> IsInfix -> IsInfix
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
$ccompare :: IsInfix -> IsInfix -> Ordering
compare :: IsInfix -> IsInfix -> Ordering
$c< :: IsInfix -> IsInfix -> Bool
< :: IsInfix -> IsInfix -> Bool
$c<= :: IsInfix -> IsInfix -> Bool
<= :: IsInfix -> IsInfix -> Bool
$c> :: IsInfix -> IsInfix -> Bool
> :: IsInfix -> IsInfix -> Bool
$c>= :: IsInfix -> IsInfix -> Bool
>= :: IsInfix -> IsInfix -> Bool
$cmax :: IsInfix -> IsInfix -> IsInfix
max :: IsInfix -> IsInfix -> IsInfix
$cmin :: IsInfix -> IsInfix -> IsInfix
min :: IsInfix -> IsInfix -> IsInfix
Ord)

-- ** private blocks, public imports

-- | Access modifier.
data Access
  = PrivateAccess KwRange Origin
      -- ^ Store the 'Origin' of the private block that lead to this qualifier.
      --   This is needed for more faithful printing of declarations.
      --   'KwRange' is the range of the @private@ keyword.
  | PublicAccess
    deriving (Int -> Access -> ShowS
[Access] -> ShowS
Access -> String
(Int -> Access -> ShowS)
-> (Access -> String) -> ([Access] -> ShowS) -> Show Access
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Access -> ShowS
showsPrec :: Int -> Access -> ShowS
$cshow :: Access -> String
show :: Access -> String
$cshowList :: [Access] -> ShowS
showList :: [Access] -> ShowS
Show, Access -> Access -> Bool
(Access -> Access -> Bool)
-> (Access -> Access -> Bool) -> Eq Access
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Access -> Access -> Bool
== :: Access -> Access -> Bool
$c/= :: Access -> Access -> Bool
/= :: Access -> Access -> Bool
Eq, Eq Access
Eq Access =>
(Access -> Access -> Ordering)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Bool)
-> (Access -> Access -> Access)
-> (Access -> Access -> Access)
-> Ord Access
Access -> Access -> Bool
Access -> Access -> Ordering
Access -> Access -> Access
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
$ccompare :: Access -> Access -> Ordering
compare :: Access -> Access -> Ordering
$c< :: Access -> Access -> Bool
< :: Access -> Access -> Bool
$c<= :: Access -> Access -> Bool
<= :: Access -> Access -> Bool
$c> :: Access -> Access -> Bool
> :: Access -> Access -> Bool
$c>= :: Access -> Access -> Bool
>= :: Access -> Access -> Bool
$cmax :: Access -> Access -> Access
max :: Access -> Access -> Access
$cmin :: Access -> Access -> Access
min :: Access -> Access -> Access
Ord)

instance Pretty Access where
  pretty :: Access -> Doc
pretty = String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> (Access -> String) -> Access -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    PrivateAccess KwRange
_ Origin
_ -> String
"private"
    Access
PublicAccess      -> String
"public"

instance NFData Access where
  rnf :: Access -> ()
rnf Access
_ = ()

instance HasRange Access where
  getRange :: Access -> Range
getRange Access
_ = Range
forall a. Range' a
noRange

instance KillRange Access where
  killRange :: Access -> Access
killRange = Access -> Access
forall a. a -> a
id

privateAccessInserted :: Access
privateAccessInserted :: Access
privateAccessInserted = KwRange -> Origin -> Access
PrivateAccess KwRange
forall a. Null a => a
empty Origin
Inserted

-- ** abstract blocks

-- | Abstract or concrete.
data IsAbstract = AbstractDef | ConcreteDef
    deriving (Int -> IsAbstract -> ShowS
[IsAbstract] -> ShowS
IsAbstract -> String
(Int -> IsAbstract -> ShowS)
-> (IsAbstract -> String)
-> ([IsAbstract] -> ShowS)
-> Show IsAbstract
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsAbstract -> ShowS
showsPrec :: Int -> IsAbstract -> ShowS
$cshow :: IsAbstract -> String
show :: IsAbstract -> String
$cshowList :: [IsAbstract] -> ShowS
showList :: [IsAbstract] -> ShowS
Show, IsAbstract -> IsAbstract -> Bool
(IsAbstract -> IsAbstract -> Bool)
-> (IsAbstract -> IsAbstract -> Bool) -> Eq IsAbstract
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsAbstract -> IsAbstract -> Bool
== :: IsAbstract -> IsAbstract -> Bool
$c/= :: IsAbstract -> IsAbstract -> Bool
/= :: IsAbstract -> IsAbstract -> Bool
Eq, Eq IsAbstract
Eq IsAbstract =>
(IsAbstract -> IsAbstract -> Ordering)
-> (IsAbstract -> IsAbstract -> Bool)
-> (IsAbstract -> IsAbstract -> Bool)
-> (IsAbstract -> IsAbstract -> Bool)
-> (IsAbstract -> IsAbstract -> Bool)
-> (IsAbstract -> IsAbstract -> IsAbstract)
-> (IsAbstract -> IsAbstract -> IsAbstract)
-> Ord IsAbstract
IsAbstract -> IsAbstract -> Bool
IsAbstract -> IsAbstract -> Ordering
IsAbstract -> IsAbstract -> IsAbstract
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
$ccompare :: IsAbstract -> IsAbstract -> Ordering
compare :: IsAbstract -> IsAbstract -> Ordering
$c< :: IsAbstract -> IsAbstract -> Bool
< :: IsAbstract -> IsAbstract -> Bool
$c<= :: IsAbstract -> IsAbstract -> Bool
<= :: IsAbstract -> IsAbstract -> Bool
$c> :: IsAbstract -> IsAbstract -> Bool
> :: IsAbstract -> IsAbstract -> Bool
$c>= :: IsAbstract -> IsAbstract -> Bool
>= :: IsAbstract -> IsAbstract -> Bool
$cmax :: IsAbstract -> IsAbstract -> IsAbstract
max :: IsAbstract -> IsAbstract -> IsAbstract
$cmin :: IsAbstract -> IsAbstract -> IsAbstract
min :: IsAbstract -> IsAbstract -> IsAbstract
Ord, (forall x. IsAbstract -> Rep IsAbstract x)
-> (forall x. Rep IsAbstract x -> IsAbstract) -> Generic IsAbstract
forall x. Rep IsAbstract x -> IsAbstract
forall x. IsAbstract -> Rep IsAbstract x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsAbstract -> Rep IsAbstract x
from :: forall x. IsAbstract -> Rep IsAbstract x
$cto :: forall x. Rep IsAbstract x -> IsAbstract
to :: forall x. Rep IsAbstract x -> IsAbstract
Generic)

-- | Semigroup computes if any of several is an 'AbstractDef'.
instance Semigroup IsAbstract where
  IsAbstract
AbstractDef <> :: IsAbstract -> IsAbstract -> IsAbstract
<> IsAbstract
_ = IsAbstract
AbstractDef
  IsAbstract
ConcreteDef <> IsAbstract
a = IsAbstract
a

-- | Default is 'ConcreteDef'.
instance Monoid IsAbstract where
  mempty :: IsAbstract
mempty  = IsAbstract
ConcreteDef
  mappend :: IsAbstract -> IsAbstract -> IsAbstract
mappend = IsAbstract -> IsAbstract -> IsAbstract
forall a. Semigroup a => a -> a -> a
(<>)

instance Boolean IsAbstract where
  fromBool :: Bool -> IsAbstract
fromBool Bool
True  = IsAbstract
AbstractDef
  fromBool Bool
False = IsAbstract
ConcreteDef

instance IsBool IsAbstract where
  toBool :: IsAbstract -> Bool
toBool IsAbstract
AbstractDef = Bool
True
  toBool IsAbstract
ConcreteDef = Bool
False

instance KillRange IsAbstract where
  killRange :: IsAbstract -> IsAbstract
killRange = IsAbstract -> IsAbstract
forall a. a -> a
id

instance NFData IsAbstract

class LensIsAbstract a where
  lensIsAbstract :: Lens' a IsAbstract

instance LensIsAbstract IsAbstract where
  lensIsAbstract :: Lens' IsAbstract IsAbstract
lensIsAbstract = (IsAbstract -> f IsAbstract) -> IsAbstract -> f IsAbstract
forall a. a -> a
id

-- | Is any element of a collection an 'AbstractDef'.
class AnyIsAbstract a where
  anyIsAbstract :: a -> IsAbstract

  default anyIsAbstract :: (Foldable t, AnyIsAbstract b, t b ~ a) => a -> IsAbstract
  anyIsAbstract = (b -> IsAbstract) -> t b -> IsAbstract
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap b -> IsAbstract
forall a. AnyIsAbstract a => a -> IsAbstract
anyIsAbstract

instance AnyIsAbstract IsAbstract where
  anyIsAbstract :: IsAbstract -> IsAbstract
anyIsAbstract = IsAbstract -> IsAbstract
forall a. a -> a
id

instance AnyIsAbstract a => AnyIsAbstract [a] where
instance AnyIsAbstract a => AnyIsAbstract (Maybe a) where

-- ** instance blocks

-- | Is this definition eligible for instance search?
data IsInstance
  = InstanceDef KwRange  -- ^ Range of the @instance@ keyword.
  | NotInstanceDef
    deriving (Int -> IsInstance -> ShowS
[IsInstance] -> ShowS
IsInstance -> String
(Int -> IsInstance -> ShowS)
-> (IsInstance -> String)
-> ([IsInstance] -> ShowS)
-> Show IsInstance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsInstance -> ShowS
showsPrec :: Int -> IsInstance -> ShowS
$cshow :: IsInstance -> String
show :: IsInstance -> String
$cshowList :: [IsInstance] -> ShowS
showList :: [IsInstance] -> ShowS
Show, IsInstance -> IsInstance -> Bool
(IsInstance -> IsInstance -> Bool)
-> (IsInstance -> IsInstance -> Bool) -> Eq IsInstance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsInstance -> IsInstance -> Bool
== :: IsInstance -> IsInstance -> Bool
$c/= :: IsInstance -> IsInstance -> Bool
/= :: IsInstance -> IsInstance -> Bool
Eq, Eq IsInstance
Eq IsInstance =>
(IsInstance -> IsInstance -> Ordering)
-> (IsInstance -> IsInstance -> Bool)
-> (IsInstance -> IsInstance -> Bool)
-> (IsInstance -> IsInstance -> Bool)
-> (IsInstance -> IsInstance -> Bool)
-> (IsInstance -> IsInstance -> IsInstance)
-> (IsInstance -> IsInstance -> IsInstance)
-> Ord IsInstance
IsInstance -> IsInstance -> Bool
IsInstance -> IsInstance -> Ordering
IsInstance -> IsInstance -> IsInstance
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
$ccompare :: IsInstance -> IsInstance -> Ordering
compare :: IsInstance -> IsInstance -> Ordering
$c< :: IsInstance -> IsInstance -> Bool
< :: IsInstance -> IsInstance -> Bool
$c<= :: IsInstance -> IsInstance -> Bool
<= :: IsInstance -> IsInstance -> Bool
$c> :: IsInstance -> IsInstance -> Bool
> :: IsInstance -> IsInstance -> Bool
$c>= :: IsInstance -> IsInstance -> Bool
>= :: IsInstance -> IsInstance -> Bool
$cmax :: IsInstance -> IsInstance -> IsInstance
max :: IsInstance -> IsInstance -> IsInstance
$cmin :: IsInstance -> IsInstance -> IsInstance
min :: IsInstance -> IsInstance -> IsInstance
Ord)

instance Null IsInstance where
  empty :: IsInstance
empty = IsInstance
NotInstanceDef

instance KillRange IsInstance where
  killRange :: IsInstance -> IsInstance
killRange = \case
    InstanceDef KwRange
_    -> KwRange -> IsInstance
InstanceDef KwRange
forall a. Null a => a
empty
    i :: IsInstance
i@IsInstance
NotInstanceDef -> IsInstance
i

instance HasRange IsInstance where
  getRange :: IsInstance -> Range
getRange = \case
    InstanceDef KwRange
r  -> KwRange -> Range
forall a. HasRange a => a -> Range
getRange KwRange
r
    IsInstance
NotInstanceDef -> Range
forall a. Range' a
noRange

instance NFData IsInstance where
  rnf :: IsInstance -> ()
rnf (InstanceDef KwRange
_) = ()
  rnf IsInstance
NotInstanceDef  = ()

class IsInstanceDef a where
  isInstanceDef :: a -> Maybe KwRange

instance IsInstanceDef IsInstance where
  isInstanceDef :: IsInstance -> Maybe KwRange
isInstanceDef = \case
    InstanceDef KwRange
r  -> KwRange -> Maybe KwRange
forall a. a -> Maybe a
Just KwRange
r
    IsInstance
NotInstanceDef -> Maybe KwRange
forall a. Maybe a
Nothing

-- ** macro blocks

-- | Is this a macro definition?
data IsMacro = MacroDef | NotMacroDef
  deriving (Int -> IsMacro -> ShowS
[IsMacro] -> ShowS
IsMacro -> String
(Int -> IsMacro -> ShowS)
-> (IsMacro -> String) -> ([IsMacro] -> ShowS) -> Show IsMacro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsMacro -> ShowS
showsPrec :: Int -> IsMacro -> ShowS
$cshow :: IsMacro -> String
show :: IsMacro -> String
$cshowList :: [IsMacro] -> ShowS
showList :: [IsMacro] -> ShowS
Show, IsMacro -> IsMacro -> Bool
(IsMacro -> IsMacro -> Bool)
-> (IsMacro -> IsMacro -> Bool) -> Eq IsMacro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsMacro -> IsMacro -> Bool
== :: IsMacro -> IsMacro -> Bool
$c/= :: IsMacro -> IsMacro -> Bool
/= :: IsMacro -> IsMacro -> Bool
Eq, Eq IsMacro
Eq IsMacro =>
(IsMacro -> IsMacro -> Ordering)
-> (IsMacro -> IsMacro -> Bool)
-> (IsMacro -> IsMacro -> Bool)
-> (IsMacro -> IsMacro -> Bool)
-> (IsMacro -> IsMacro -> Bool)
-> (IsMacro -> IsMacro -> IsMacro)
-> (IsMacro -> IsMacro -> IsMacro)
-> Ord IsMacro
IsMacro -> IsMacro -> Bool
IsMacro -> IsMacro -> Ordering
IsMacro -> IsMacro -> IsMacro
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
$ccompare :: IsMacro -> IsMacro -> Ordering
compare :: IsMacro -> IsMacro -> Ordering
$c< :: IsMacro -> IsMacro -> Bool
< :: IsMacro -> IsMacro -> Bool
$c<= :: IsMacro -> IsMacro -> Bool
<= :: IsMacro -> IsMacro -> Bool
$c> :: IsMacro -> IsMacro -> Bool
> :: IsMacro -> IsMacro -> Bool
$c>= :: IsMacro -> IsMacro -> Bool
>= :: IsMacro -> IsMacro -> Bool
$cmax :: IsMacro -> IsMacro -> IsMacro
max :: IsMacro -> IsMacro -> IsMacro
$cmin :: IsMacro -> IsMacro -> IsMacro
min :: IsMacro -> IsMacro -> IsMacro
Ord, (forall x. IsMacro -> Rep IsMacro x)
-> (forall x. Rep IsMacro x -> IsMacro) -> Generic IsMacro
forall x. Rep IsMacro x -> IsMacro
forall x. IsMacro -> Rep IsMacro x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsMacro -> Rep IsMacro x
from :: forall x. IsMacro -> Rep IsMacro x
$cto :: forall x. Rep IsMacro x -> IsMacro
to :: forall x. Rep IsMacro x -> IsMacro
Generic)

instance KillRange IsMacro where killRange :: IsMacro -> IsMacro
killRange = IsMacro -> IsMacro
forall a. a -> a
id
instance HasRange  IsMacro where getRange :: IsMacro -> Range
getRange IsMacro
_ = Range
forall a. Range' a
noRange

instance NFData IsMacro

-- ** opaque blocks

-- | Opaque or transparent.
data IsOpaque
  = OpaqueDef {-# UNPACK #-} !OpaqueId
    -- ^ This definition is opaque, and it is guarded by the given
    -- opaque block.
  | TransparentDef
  deriving (Int -> IsOpaque -> ShowS
[IsOpaque] -> ShowS
IsOpaque -> String
(Int -> IsOpaque -> ShowS)
-> (IsOpaque -> String) -> ([IsOpaque] -> ShowS) -> Show IsOpaque
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsOpaque -> ShowS
showsPrec :: Int -> IsOpaque -> ShowS
$cshow :: IsOpaque -> String
show :: IsOpaque -> String
$cshowList :: [IsOpaque] -> ShowS
showList :: [IsOpaque] -> ShowS
Show, IsOpaque -> IsOpaque -> Bool
(IsOpaque -> IsOpaque -> Bool)
-> (IsOpaque -> IsOpaque -> Bool) -> Eq IsOpaque
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsOpaque -> IsOpaque -> Bool
== :: IsOpaque -> IsOpaque -> Bool
$c/= :: IsOpaque -> IsOpaque -> Bool
/= :: IsOpaque -> IsOpaque -> Bool
Eq, Eq IsOpaque
Eq IsOpaque =>
(IsOpaque -> IsOpaque -> Ordering)
-> (IsOpaque -> IsOpaque -> Bool)
-> (IsOpaque -> IsOpaque -> Bool)
-> (IsOpaque -> IsOpaque -> Bool)
-> (IsOpaque -> IsOpaque -> Bool)
-> (IsOpaque -> IsOpaque -> IsOpaque)
-> (IsOpaque -> IsOpaque -> IsOpaque)
-> Ord IsOpaque
IsOpaque -> IsOpaque -> Bool
IsOpaque -> IsOpaque -> Ordering
IsOpaque -> IsOpaque -> IsOpaque
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
$ccompare :: IsOpaque -> IsOpaque -> Ordering
compare :: IsOpaque -> IsOpaque -> Ordering
$c< :: IsOpaque -> IsOpaque -> Bool
< :: IsOpaque -> IsOpaque -> Bool
$c<= :: IsOpaque -> IsOpaque -> Bool
<= :: IsOpaque -> IsOpaque -> Bool
$c> :: IsOpaque -> IsOpaque -> Bool
> :: IsOpaque -> IsOpaque -> Bool
$c>= :: IsOpaque -> IsOpaque -> Bool
>= :: IsOpaque -> IsOpaque -> Bool
$cmax :: IsOpaque -> IsOpaque -> IsOpaque
max :: IsOpaque -> IsOpaque -> IsOpaque
$cmin :: IsOpaque -> IsOpaque -> IsOpaque
min :: IsOpaque -> IsOpaque -> IsOpaque
Ord, (forall x. IsOpaque -> Rep IsOpaque x)
-> (forall x. Rep IsOpaque x -> IsOpaque) -> Generic IsOpaque
forall x. Rep IsOpaque x -> IsOpaque
forall x. IsOpaque -> Rep IsOpaque x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IsOpaque -> Rep IsOpaque x
from :: forall x. IsOpaque -> Rep IsOpaque x
$cto :: forall x. Rep IsOpaque x -> IsOpaque
to :: forall x. Rep IsOpaque x -> IsOpaque
Generic)

instance KillRange IsOpaque where
  killRange :: IsOpaque -> IsOpaque
killRange = IsOpaque -> IsOpaque
forall a. a -> a
id

instance NFData IsOpaque

class LensIsOpaque a where
  lensIsOpaque :: Lens' a IsOpaque

instance LensIsOpaque IsOpaque where
  lensIsOpaque :: Lens' IsOpaque IsOpaque
lensIsOpaque = (IsOpaque -> f IsOpaque) -> IsOpaque -> f IsOpaque
forall a. a -> a
id

-- | Monoid representing the combined opaque blocks of a 'Foldable'
-- containing possibly-opaque declarations.
data JointOpacity
  = UniqueOpaque    {-# UNPACK #-} !OpaqueId
  -- ^ Every definition agrees on what opaque block they belong to.
  | DifferentOpaque !(HashSet OpaqueId)
  -- ^ More than one opaque block was found.
  | NoOpaque
  -- ^ Nothing here is opaque.

instance Semigroup JointOpacity where
  UniqueOpaque OpaqueId
i <> :: JointOpacity -> JointOpacity -> JointOpacity
<> UniqueOpaque OpaqueId
j
    | OpaqueId
i OpaqueId -> OpaqueId -> Bool
forall a. Eq a => a -> a -> Bool
== OpaqueId
j    = OpaqueId -> JointOpacity
UniqueOpaque OpaqueId
i
    | Bool
otherwise = HashSet OpaqueId -> JointOpacity
DifferentOpaque ([OpaqueId] -> HashSet OpaqueId
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [OpaqueId
i, OpaqueId
j])

  DifferentOpaque HashSet OpaqueId
is <> UniqueOpaque OpaqueId
j     = HashSet OpaqueId -> JointOpacity
DifferentOpaque (OpaqueId -> HashSet OpaqueId -> HashSet OpaqueId
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert OpaqueId
j HashSet OpaqueId
is)
  UniqueOpaque OpaqueId
i     <> DifferentOpaque HashSet OpaqueId
js = HashSet OpaqueId -> JointOpacity
DifferentOpaque (OpaqueId -> HashSet OpaqueId -> HashSet OpaqueId
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert OpaqueId
i HashSet OpaqueId
js)
  DifferentOpaque HashSet OpaqueId
is <> DifferentOpaque HashSet OpaqueId
js = HashSet OpaqueId -> JointOpacity
DifferentOpaque (HashSet OpaqueId -> HashSet OpaqueId -> HashSet OpaqueId
forall a. Eq a => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet OpaqueId
is HashSet OpaqueId
js)

  JointOpacity
NoOpaque <> JointOpacity
x = JointOpacity
x
  JointOpacity
x <> JointOpacity
NoOpaque = JointOpacity
x

instance Monoid JointOpacity where
  mappend :: JointOpacity -> JointOpacity -> JointOpacity
mappend = JointOpacity -> JointOpacity -> JointOpacity
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: JointOpacity
mempty = JointOpacity
NoOpaque

class AllAreOpaque a where
  jointOpacity :: a -> JointOpacity

  default jointOpacity :: (Foldable t, AllAreOpaque b, t b ~ a) => a -> JointOpacity
  jointOpacity = (b -> JointOpacity) -> t b -> JointOpacity
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap b -> JointOpacity
forall a. AllAreOpaque a => a -> JointOpacity
jointOpacity

instance AllAreOpaque IsOpaque where
  jointOpacity :: IsOpaque -> JointOpacity
jointOpacity = \case
    IsOpaque
TransparentDef -> JointOpacity
NoOpaque
    OpaqueDef OpaqueId
i    -> OpaqueId -> JointOpacity
UniqueOpaque OpaqueId
i

instance AllAreOpaque a => AllAreOpaque [a] where
instance AllAreOpaque a => AllAreOpaque (Maybe a) where

---------------------------------------------------------------------------
-- * NameId
---------------------------------------------------------------------------

-- | The unique identifier of a name. Second argument is the top-level module
--   identifier.
data NameId = NameId {-# UNPACK #-} !Word64 {-# UNPACK #-} !ModuleNameHash
    deriving (NameId -> NameId -> Bool
(NameId -> NameId -> Bool)
-> (NameId -> NameId -> Bool) -> Eq NameId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameId -> NameId -> Bool
== :: NameId -> NameId -> Bool
$c/= :: NameId -> NameId -> Bool
/= :: NameId -> NameId -> Bool
Eq, Eq NameId
Eq NameId =>
(NameId -> NameId -> Ordering)
-> (NameId -> NameId -> Bool)
-> (NameId -> NameId -> Bool)
-> (NameId -> NameId -> Bool)
-> (NameId -> NameId -> Bool)
-> (NameId -> NameId -> NameId)
-> (NameId -> NameId -> NameId)
-> Ord NameId
NameId -> NameId -> Bool
NameId -> NameId -> Ordering
NameId -> NameId -> NameId
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
$ccompare :: NameId -> NameId -> Ordering
compare :: NameId -> NameId -> Ordering
$c< :: NameId -> NameId -> Bool
< :: NameId -> NameId -> Bool
$c<= :: NameId -> NameId -> Bool
<= :: NameId -> NameId -> Bool
$c> :: NameId -> NameId -> Bool
> :: NameId -> NameId -> Bool
$c>= :: NameId -> NameId -> Bool
>= :: NameId -> NameId -> Bool
$cmax :: NameId -> NameId -> NameId
max :: NameId -> NameId -> NameId
$cmin :: NameId -> NameId -> NameId
min :: NameId -> NameId -> NameId
Ord, (forall x. NameId -> Rep NameId x)
-> (forall x. Rep NameId x -> NameId) -> Generic NameId
forall x. Rep NameId x -> NameId
forall x. NameId -> Rep NameId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NameId -> Rep NameId x
from :: forall x. NameId -> Rep NameId x
$cto :: forall x. Rep NameId x -> NameId
to :: forall x. Rep NameId x -> NameId
Generic, Int -> NameId -> ShowS
[NameId] -> ShowS
NameId -> String
(Int -> NameId -> ShowS)
-> (NameId -> String) -> ([NameId] -> ShowS) -> Show NameId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NameId -> ShowS
showsPrec :: Int -> NameId -> ShowS
$cshow :: NameId -> String
show :: NameId -> String
$cshowList :: [NameId] -> ShowS
showList :: [NameId] -> ShowS
Show)

instance Null NameId where
  empty :: NameId
empty = Word64 -> ModuleNameHash -> NameId
NameId Word64
forall a. Null a => a
empty ModuleNameHash
forall a. Null a => a
empty
  null :: NameId -> Bool
null (NameId Word64
n ModuleNameHash
m) = Word64 -> Bool
forall a. Null a => a -> Bool
null Word64
n Bool -> Bool -> Bool
&& ModuleNameHash -> Bool
forall a. Null a => a -> Bool
null ModuleNameHash
m

instance KillRange NameId where
  killRange :: NameId -> NameId
killRange = NameId -> NameId
forall a. a -> a
id

instance Pretty NameId where
  pretty :: NameId -> Doc
pretty (NameId Word64
n ModuleNameHash
m) = String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. Show a => a -> String
show Word64
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleNameHash -> String
forall a. Show a => a -> String
show ModuleNameHash
m

instance Enum NameId where
  succ :: NameId -> NameId
succ (NameId Word64
n ModuleNameHash
m)     = Word64 -> ModuleNameHash -> NameId
NameId (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) ModuleNameHash
m
  pred :: NameId -> NameId
pred (NameId Word64
n ModuleNameHash
m)     = Word64 -> ModuleNameHash -> NameId
NameId (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) ModuleNameHash
m
  toEnum :: Int -> NameId
toEnum Int
_              = NameId
forall a. HasCallStack => a
__IMPOSSIBLE__  -- should not be used
  fromEnum :: NameId -> Int
fromEnum (NameId Word64
n ModuleNameHash
_) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

instance NFData NameId where
  rnf :: NameId -> ()
rnf (NameId Word64
_ ModuleNameHash
_) = ()

instance Hashable NameId where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> NameId -> Int
hashWithSalt Int
salt (NameId Word64
n (ModuleNameHash Word64
m)) =
    Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
salt Word -> Word -> Word
`combineWord` Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n Word -> Word -> Word
`combineWord` Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m)

---------------------------------------------------------------------------
-- * Meta variables
---------------------------------------------------------------------------

-- | Meta-variable identifiers use the same structure as 'NameId's.

data MetaId = MetaId
  { MetaId -> Word64
metaId     :: {-# UNPACK #-} !Word64
  , MetaId -> ModuleNameHash
metaModule :: {-# UNPACK #-} !ModuleNameHash
  }
  deriving (MetaId -> MetaId -> Bool
(MetaId -> MetaId -> Bool)
-> (MetaId -> MetaId -> Bool) -> Eq MetaId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetaId -> MetaId -> Bool
== :: MetaId -> MetaId -> Bool
$c/= :: MetaId -> MetaId -> Bool
/= :: MetaId -> MetaId -> Bool
Eq, Eq MetaId
Eq MetaId =>
(MetaId -> MetaId -> Ordering)
-> (MetaId -> MetaId -> Bool)
-> (MetaId -> MetaId -> Bool)
-> (MetaId -> MetaId -> Bool)
-> (MetaId -> MetaId -> Bool)
-> (MetaId -> MetaId -> MetaId)
-> (MetaId -> MetaId -> MetaId)
-> Ord MetaId
MetaId -> MetaId -> Bool
MetaId -> MetaId -> Ordering
MetaId -> MetaId -> MetaId
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
$ccompare :: MetaId -> MetaId -> Ordering
compare :: MetaId -> MetaId -> Ordering
$c< :: MetaId -> MetaId -> Bool
< :: MetaId -> MetaId -> Bool
$c<= :: MetaId -> MetaId -> Bool
<= :: MetaId -> MetaId -> Bool
$c> :: MetaId -> MetaId -> Bool
> :: MetaId -> MetaId -> Bool
$c>= :: MetaId -> MetaId -> Bool
>= :: MetaId -> MetaId -> Bool
$cmax :: MetaId -> MetaId -> MetaId
max :: MetaId -> MetaId -> MetaId
$cmin :: MetaId -> MetaId -> MetaId
min :: MetaId -> MetaId -> MetaId
Ord, (forall x. MetaId -> Rep MetaId x)
-> (forall x. Rep MetaId x -> MetaId) -> Generic MetaId
forall x. Rep MetaId x -> MetaId
forall x. MetaId -> Rep MetaId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetaId -> Rep MetaId x
from :: forall x. MetaId -> Rep MetaId x
$cto :: forall x. Rep MetaId x -> MetaId
to :: forall x. Rep MetaId x -> MetaId
Generic)

instance Pretty MetaId where
  pretty :: MetaId -> Doc
pretty (MetaId Word64
n ModuleNameHash
m) =
    String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (ModuleNameHash -> Word64
moduleNameHash ModuleNameHash
m)

instance Enum MetaId where
  succ :: MetaId -> MetaId
succ m :: MetaId
m@MetaId{ Word64
metaId :: MetaId -> Word64
metaId :: Word64
metaId } = MetaId
m { metaId = succ metaId }
  pred :: MetaId -> MetaId
pred m :: MetaId
m@MetaId{ Word64
metaId :: MetaId -> Word64
metaId :: Word64
metaId } = MetaId
m { metaId = pred metaId }

  -- The following functions should not be used.
  toEnum :: Int -> MetaId
toEnum   = Int -> MetaId
forall a. HasCallStack => a
__IMPOSSIBLE__
  fromEnum :: MetaId -> Int
fromEnum = MetaId -> Int
forall a. HasCallStack => a
__IMPOSSIBLE__

-- | The record selectors are not included in the resulting strings.

instance Show MetaId where
  showsPrec :: Int -> MetaId -> ShowS
showsPrec Int
p (MetaId Word64
n ModuleNameHash
m) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"MetaId " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int -> Word64 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word64
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Int -> ModuleNameHash -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 ModuleNameHash
m

instance NFData MetaId where
  rnf :: MetaId -> ()
rnf (MetaId Word64
x ModuleNameHash
y) = Word64 -> ()
forall a. NFData a => a -> ()
rnf Word64
x () -> () -> ()
forall a b. a -> b -> b
`seq` ModuleNameHash -> ()
forall a. NFData a => a -> ()
rnf ModuleNameHash
y

instance Hashable MetaId where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> MetaId -> Int
hashWithSalt Int
salt (MetaId Word64
n ModuleNameHash
m) = Int -> (Word64, ModuleNameHash) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Word64
n, ModuleNameHash
m)

newtype Constr a = Constr a

-----------------------------------------------------------------------------
-- * Problems
-----------------------------------------------------------------------------

-- | A "problem" consists of a set of constraints and the same constraint can be part of multiple
--   problems.
newtype ProblemId = ProblemId Word64
  deriving (ProblemId -> ProblemId -> Bool
(ProblemId -> ProblemId -> Bool)
-> (ProblemId -> ProblemId -> Bool) -> Eq ProblemId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProblemId -> ProblemId -> Bool
== :: ProblemId -> ProblemId -> Bool
$c/= :: ProblemId -> ProblemId -> Bool
/= :: ProblemId -> ProblemId -> Bool
Eq, Eq ProblemId
Eq ProblemId =>
(ProblemId -> ProblemId -> Ordering)
-> (ProblemId -> ProblemId -> Bool)
-> (ProblemId -> ProblemId -> Bool)
-> (ProblemId -> ProblemId -> Bool)
-> (ProblemId -> ProblemId -> Bool)
-> (ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> ProblemId)
-> Ord ProblemId
ProblemId -> ProblemId -> Bool
ProblemId -> ProblemId -> Ordering
ProblemId -> ProblemId -> ProblemId
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
$ccompare :: ProblemId -> ProblemId -> Ordering
compare :: ProblemId -> ProblemId -> Ordering
$c< :: ProblemId -> ProblemId -> Bool
< :: ProblemId -> ProblemId -> Bool
$c<= :: ProblemId -> ProblemId -> Bool
<= :: ProblemId -> ProblemId -> Bool
$c> :: ProblemId -> ProblemId -> Bool
> :: ProblemId -> ProblemId -> Bool
$c>= :: ProblemId -> ProblemId -> Bool
>= :: ProblemId -> ProblemId -> Bool
$cmax :: ProblemId -> ProblemId -> ProblemId
max :: ProblemId -> ProblemId -> ProblemId
$cmin :: ProblemId -> ProblemId -> ProblemId
min :: ProblemId -> ProblemId -> ProblemId
Ord, Int -> ProblemId
ProblemId -> Int
ProblemId -> [ProblemId]
ProblemId -> ProblemId
ProblemId -> ProblemId -> [ProblemId]
ProblemId -> ProblemId -> ProblemId -> [ProblemId]
(ProblemId -> ProblemId)
-> (ProblemId -> ProblemId)
-> (Int -> ProblemId)
-> (ProblemId -> Int)
-> (ProblemId -> [ProblemId])
-> (ProblemId -> ProblemId -> [ProblemId])
-> (ProblemId -> ProblemId -> [ProblemId])
-> (ProblemId -> ProblemId -> ProblemId -> [ProblemId])
-> Enum ProblemId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ProblemId -> ProblemId
succ :: ProblemId -> ProblemId
$cpred :: ProblemId -> ProblemId
pred :: ProblemId -> ProblemId
$ctoEnum :: Int -> ProblemId
toEnum :: Int -> ProblemId
$cfromEnum :: ProblemId -> Int
fromEnum :: ProblemId -> Int
$cenumFrom :: ProblemId -> [ProblemId]
enumFrom :: ProblemId -> [ProblemId]
$cenumFromThen :: ProblemId -> ProblemId -> [ProblemId]
enumFromThen :: ProblemId -> ProblemId -> [ProblemId]
$cenumFromTo :: ProblemId -> ProblemId -> [ProblemId]
enumFromTo :: ProblemId -> ProblemId -> [ProblemId]
$cenumFromThenTo :: ProblemId -> ProblemId -> ProblemId -> [ProblemId]
enumFromThenTo :: ProblemId -> ProblemId -> ProblemId -> [ProblemId]
Enum, Num ProblemId
Ord ProblemId
(Num ProblemId, Ord ProblemId) =>
(ProblemId -> Rational) -> Real ProblemId
ProblemId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ProblemId -> Rational
toRational :: ProblemId -> Rational
Real, Enum ProblemId
Real ProblemId
(Real ProblemId, Enum ProblemId) =>
(ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> (ProblemId, ProblemId))
-> (ProblemId -> ProblemId -> (ProblemId, ProblemId))
-> (ProblemId -> Integer)
-> Integral ProblemId
ProblemId -> Integer
ProblemId -> ProblemId -> (ProblemId, ProblemId)
ProblemId -> ProblemId -> ProblemId
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ProblemId -> ProblemId -> ProblemId
quot :: ProblemId -> ProblemId -> ProblemId
$crem :: ProblemId -> ProblemId -> ProblemId
rem :: ProblemId -> ProblemId -> ProblemId
$cdiv :: ProblemId -> ProblemId -> ProblemId
div :: ProblemId -> ProblemId -> ProblemId
$cmod :: ProblemId -> ProblemId -> ProblemId
mod :: ProblemId -> ProblemId -> ProblemId
$cquotRem :: ProblemId -> ProblemId -> (ProblemId, ProblemId)
quotRem :: ProblemId -> ProblemId -> (ProblemId, ProblemId)
$cdivMod :: ProblemId -> ProblemId -> (ProblemId, ProblemId)
divMod :: ProblemId -> ProblemId -> (ProblemId, ProblemId)
$ctoInteger :: ProblemId -> Integer
toInteger :: ProblemId -> Integer
Integral, Integer -> ProblemId
ProblemId -> ProblemId
ProblemId -> ProblemId -> ProblemId
(ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId -> ProblemId)
-> (ProblemId -> ProblemId)
-> (ProblemId -> ProblemId)
-> (ProblemId -> ProblemId)
-> (Integer -> ProblemId)
-> Num ProblemId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ProblemId -> ProblemId -> ProblemId
+ :: ProblemId -> ProblemId -> ProblemId
$c- :: ProblemId -> ProblemId -> ProblemId
- :: ProblemId -> ProblemId -> ProblemId
$c* :: ProblemId -> ProblemId -> ProblemId
* :: ProblemId -> ProblemId -> ProblemId
$cnegate :: ProblemId -> ProblemId
negate :: ProblemId -> ProblemId
$cabs :: ProblemId -> ProblemId
abs :: ProblemId -> ProblemId
$csignum :: ProblemId -> ProblemId
signum :: ProblemId -> ProblemId
$cfromInteger :: Integer -> ProblemId
fromInteger :: Integer -> ProblemId
Num, ProblemId -> ()
(ProblemId -> ()) -> NFData ProblemId
forall a. (a -> ()) -> NFData a
$crnf :: ProblemId -> ()
rnf :: ProblemId -> ()
NFData)

-- This particular Show instance is ok because of the Num instance.
instance Show   ProblemId where show :: ProblemId -> String
show   (ProblemId Word64
n) = Word64 -> String
forall a. Show a => a -> String
show Word64
n
instance Pretty ProblemId where pretty :: ProblemId -> Doc
pretty (ProblemId Word64
n) = Word64 -> Doc
forall a. Pretty a => a -> Doc
pretty Word64
n

-- | The unique identifier of an opaque block. Second argument is the
-- top-level module identifier.
data OpaqueId = OpaqueId {-# UNPACK #-} !Word64 {-# UNPACK #-} !ModuleNameHash
    deriving (OpaqueId -> OpaqueId -> Bool
(OpaqueId -> OpaqueId -> Bool)
-> (OpaqueId -> OpaqueId -> Bool) -> Eq OpaqueId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpaqueId -> OpaqueId -> Bool
== :: OpaqueId -> OpaqueId -> Bool
$c/= :: OpaqueId -> OpaqueId -> Bool
/= :: OpaqueId -> OpaqueId -> Bool
Eq, Eq OpaqueId
Eq OpaqueId =>
(OpaqueId -> OpaqueId -> Ordering)
-> (OpaqueId -> OpaqueId -> Bool)
-> (OpaqueId -> OpaqueId -> Bool)
-> (OpaqueId -> OpaqueId -> Bool)
-> (OpaqueId -> OpaqueId -> Bool)
-> (OpaqueId -> OpaqueId -> OpaqueId)
-> (OpaqueId -> OpaqueId -> OpaqueId)
-> Ord OpaqueId
OpaqueId -> OpaqueId -> Bool
OpaqueId -> OpaqueId -> Ordering
OpaqueId -> OpaqueId -> OpaqueId
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
$ccompare :: OpaqueId -> OpaqueId -> Ordering
compare :: OpaqueId -> OpaqueId -> Ordering
$c< :: OpaqueId -> OpaqueId -> Bool
< :: OpaqueId -> OpaqueId -> Bool
$c<= :: OpaqueId -> OpaqueId -> Bool
<= :: OpaqueId -> OpaqueId -> Bool
$c> :: OpaqueId -> OpaqueId -> Bool
> :: OpaqueId -> OpaqueId -> Bool
$c>= :: OpaqueId -> OpaqueId -> Bool
>= :: OpaqueId -> OpaqueId -> Bool
$cmax :: OpaqueId -> OpaqueId -> OpaqueId
max :: OpaqueId -> OpaqueId -> OpaqueId
$cmin :: OpaqueId -> OpaqueId -> OpaqueId
min :: OpaqueId -> OpaqueId -> OpaqueId
Ord, (forall x. OpaqueId -> Rep OpaqueId x)
-> (forall x. Rep OpaqueId x -> OpaqueId) -> Generic OpaqueId
forall x. Rep OpaqueId x -> OpaqueId
forall x. OpaqueId -> Rep OpaqueId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpaqueId -> Rep OpaqueId x
from :: forall x. OpaqueId -> Rep OpaqueId x
$cto :: forall x. Rep OpaqueId x -> OpaqueId
to :: forall x. Rep OpaqueId x -> OpaqueId
Generic, Int -> OpaqueId -> ShowS
[OpaqueId] -> ShowS
OpaqueId -> String
(Int -> OpaqueId -> ShowS)
-> (OpaqueId -> String) -> ([OpaqueId] -> ShowS) -> Show OpaqueId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpaqueId -> ShowS
showsPrec :: Int -> OpaqueId -> ShowS
$cshow :: OpaqueId -> String
show :: OpaqueId -> String
$cshowList :: [OpaqueId] -> ShowS
showList :: [OpaqueId] -> ShowS
Show)

instance KillRange OpaqueId where
  killRange :: OpaqueId -> OpaqueId
killRange = OpaqueId -> OpaqueId
forall a. a -> a
id

instance Pretty OpaqueId where
  pretty :: OpaqueId -> Doc
pretty (OpaqueId Word64
n ModuleNameHash
m) = String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. Show a => a -> String
show Word64
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleNameHash -> String
forall a. Show a => a -> String
show ModuleNameHash
m

instance Enum OpaqueId where
  succ :: OpaqueId -> OpaqueId
succ (OpaqueId Word64
n ModuleNameHash
m)     = Word64 -> ModuleNameHash -> OpaqueId
OpaqueId (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) ModuleNameHash
m
  pred :: OpaqueId -> OpaqueId
pred (OpaqueId Word64
n ModuleNameHash
m)     = Word64 -> ModuleNameHash -> OpaqueId
OpaqueId (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) ModuleNameHash
m
  toEnum :: Int -> OpaqueId
toEnum Int
_                = OpaqueId
forall a. HasCallStack => a
__IMPOSSIBLE__  -- should not be used
  fromEnum :: OpaqueId -> Int
fromEnum (OpaqueId Word64
n ModuleNameHash
_) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

instance NFData OpaqueId where
  rnf :: OpaqueId -> ()
rnf (OpaqueId Word64
_ ModuleNameHash
_) = ()

instance Hashable OpaqueId where
  {-# INLINE hashWithSalt #-}
  hashWithSalt :: Int -> OpaqueId -> Int
hashWithSalt Int
salt (OpaqueId Word64
n (ModuleNameHash Word64
m)) = Int -> (Word64, Word64) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (Word64
n, Word64
m)

------------------------------------------------------------------------
-- * Placeholders (used to parse sections)
------------------------------------------------------------------------

-- | The position of a name part or underscore in a name.

data PositionInName
  = Beginning
    -- ^ The following underscore is at the beginning of the name:
    -- @_foo@.
  | Middle
    -- ^ The following underscore is in the middle of the name:
    -- @foo_bar@.
  | End
    -- ^ The following underscore is at the end of the name: @foo_@.
  deriving (Int -> PositionInName -> ShowS
[PositionInName] -> ShowS
PositionInName -> String
(Int -> PositionInName -> ShowS)
-> (PositionInName -> String)
-> ([PositionInName] -> ShowS)
-> Show PositionInName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PositionInName -> ShowS
showsPrec :: Int -> PositionInName -> ShowS
$cshow :: PositionInName -> String
show :: PositionInName -> String
$cshowList :: [PositionInName] -> ShowS
showList :: [PositionInName] -> ShowS
Show, PositionInName -> PositionInName -> Bool
(PositionInName -> PositionInName -> Bool)
-> (PositionInName -> PositionInName -> Bool) -> Eq PositionInName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PositionInName -> PositionInName -> Bool
== :: PositionInName -> PositionInName -> Bool
$c/= :: PositionInName -> PositionInName -> Bool
/= :: PositionInName -> PositionInName -> Bool
Eq, Eq PositionInName
Eq PositionInName =>
(PositionInName -> PositionInName -> Ordering)
-> (PositionInName -> PositionInName -> Bool)
-> (PositionInName -> PositionInName -> Bool)
-> (PositionInName -> PositionInName -> Bool)
-> (PositionInName -> PositionInName -> Bool)
-> (PositionInName -> PositionInName -> PositionInName)
-> (PositionInName -> PositionInName -> PositionInName)
-> Ord PositionInName
PositionInName -> PositionInName -> Bool
PositionInName -> PositionInName -> Ordering
PositionInName -> PositionInName -> PositionInName
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
$ccompare :: PositionInName -> PositionInName -> Ordering
compare :: PositionInName -> PositionInName -> Ordering
$c< :: PositionInName -> PositionInName -> Bool
< :: PositionInName -> PositionInName -> Bool
$c<= :: PositionInName -> PositionInName -> Bool
<= :: PositionInName -> PositionInName -> Bool
$c> :: PositionInName -> PositionInName -> Bool
> :: PositionInName -> PositionInName -> Bool
$c>= :: PositionInName -> PositionInName -> Bool
>= :: PositionInName -> PositionInName -> Bool
$cmax :: PositionInName -> PositionInName -> PositionInName
max :: PositionInName -> PositionInName -> PositionInName
$cmin :: PositionInName -> PositionInName -> PositionInName
min :: PositionInName -> PositionInName -> PositionInName
Ord)

-- | Placeholders are used to represent the underscores in a section.

data MaybePlaceholder e
  = Placeholder !PositionInName
  | NoPlaceholder !(Strict.Maybe PositionInName) e
    -- ^ The second argument is used only (but not always) for name
    -- parts other than underscores.
  deriving (MaybePlaceholder e -> MaybePlaceholder e -> Bool
(MaybePlaceholder e -> MaybePlaceholder e -> Bool)
-> (MaybePlaceholder e -> MaybePlaceholder e -> Bool)
-> Eq (MaybePlaceholder e)
forall e. Eq e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
== :: MaybePlaceholder e -> MaybePlaceholder e -> Bool
$c/= :: forall e. Eq e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
/= :: MaybePlaceholder e -> MaybePlaceholder e -> Bool
Eq, Eq (MaybePlaceholder e)
Eq (MaybePlaceholder e) =>
(MaybePlaceholder e -> MaybePlaceholder e -> Ordering)
-> (MaybePlaceholder e -> MaybePlaceholder e -> Bool)
-> (MaybePlaceholder e -> MaybePlaceholder e -> Bool)
-> (MaybePlaceholder e -> MaybePlaceholder e -> Bool)
-> (MaybePlaceholder e -> MaybePlaceholder e -> Bool)
-> (MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e)
-> (MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e)
-> Ord (MaybePlaceholder e)
MaybePlaceholder e -> MaybePlaceholder e -> Bool
MaybePlaceholder e -> MaybePlaceholder e -> Ordering
MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e
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
forall e. Ord e => Eq (MaybePlaceholder e)
forall e. Ord e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
forall e.
Ord e =>
MaybePlaceholder e -> MaybePlaceholder e -> Ordering
forall e.
Ord e =>
MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e
$ccompare :: forall e.
Ord e =>
MaybePlaceholder e -> MaybePlaceholder e -> Ordering
compare :: MaybePlaceholder e -> MaybePlaceholder e -> Ordering
$c< :: forall e. Ord e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
< :: MaybePlaceholder e -> MaybePlaceholder e -> Bool
$c<= :: forall e. Ord e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
<= :: MaybePlaceholder e -> MaybePlaceholder e -> Bool
$c> :: forall e. Ord e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
> :: MaybePlaceholder e -> MaybePlaceholder e -> Bool
$c>= :: forall e. Ord e => MaybePlaceholder e -> MaybePlaceholder e -> Bool
>= :: MaybePlaceholder e -> MaybePlaceholder e -> Bool
$cmax :: forall e.
Ord e =>
MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e
max :: MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e
$cmin :: forall e.
Ord e =>
MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e
min :: MaybePlaceholder e -> MaybePlaceholder e -> MaybePlaceholder e
Ord, (forall a b. (a -> b) -> MaybePlaceholder a -> MaybePlaceholder b)
-> (forall a b. a -> MaybePlaceholder b -> MaybePlaceholder a)
-> Functor MaybePlaceholder
forall a b. a -> MaybePlaceholder b -> MaybePlaceholder a
forall a b. (a -> b) -> MaybePlaceholder a -> MaybePlaceholder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MaybePlaceholder a -> MaybePlaceholder b
fmap :: forall a b. (a -> b) -> MaybePlaceholder a -> MaybePlaceholder b
$c<$ :: forall a b. a -> MaybePlaceholder b -> MaybePlaceholder a
<$ :: forall a b. a -> MaybePlaceholder b -> MaybePlaceholder a
Functor, (forall m. Monoid m => MaybePlaceholder m -> m)
-> (forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m)
-> (forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m)
-> (forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b)
-> (forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b)
-> (forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b)
-> (forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b)
-> (forall a. (a -> a -> a) -> MaybePlaceholder a -> a)
-> (forall a. (a -> a -> a) -> MaybePlaceholder a -> a)
-> (forall a. MaybePlaceholder a -> [a])
-> (forall a. MaybePlaceholder a -> Bool)
-> (forall a. MaybePlaceholder a -> Int)
-> (forall a. Eq a => a -> MaybePlaceholder a -> Bool)
-> (forall a. Ord a => MaybePlaceholder a -> a)
-> (forall a. Ord a => MaybePlaceholder a -> a)
-> (forall a. Num a => MaybePlaceholder a -> a)
-> (forall a. Num a => MaybePlaceholder a -> a)
-> Foldable MaybePlaceholder
forall a. Eq a => a -> MaybePlaceholder a -> Bool
forall a. Num a => MaybePlaceholder a -> a
forall a. Ord a => MaybePlaceholder a -> a
forall m. Monoid m => MaybePlaceholder m -> m
forall a. MaybePlaceholder a -> Bool
forall a. MaybePlaceholder a -> Int
forall a. MaybePlaceholder a -> [a]
forall a. (a -> a -> a) -> MaybePlaceholder a -> a
forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m
forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b
forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => MaybePlaceholder m -> m
fold :: forall m. Monoid m => MaybePlaceholder m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MaybePlaceholder a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MaybePlaceholder a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MaybePlaceholder a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> MaybePlaceholder a -> a
foldr1 :: forall a. (a -> a -> a) -> MaybePlaceholder a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MaybePlaceholder a -> a
foldl1 :: forall a. (a -> a -> a) -> MaybePlaceholder a -> a
$ctoList :: forall a. MaybePlaceholder a -> [a]
toList :: forall a. MaybePlaceholder a -> [a]
$cnull :: forall a. MaybePlaceholder a -> Bool
null :: forall a. MaybePlaceholder a -> Bool
$clength :: forall a. MaybePlaceholder a -> Int
length :: forall a. MaybePlaceholder a -> Int
$celem :: forall a. Eq a => a -> MaybePlaceholder a -> Bool
elem :: forall a. Eq a => a -> MaybePlaceholder a -> Bool
$cmaximum :: forall a. Ord a => MaybePlaceholder a -> a
maximum :: forall a. Ord a => MaybePlaceholder a -> a
$cminimum :: forall a. Ord a => MaybePlaceholder a -> a
minimum :: forall a. Ord a => MaybePlaceholder a -> a
$csum :: forall a. Num a => MaybePlaceholder a -> a
sum :: forall a. Num a => MaybePlaceholder a -> a
$cproduct :: forall a. Num a => MaybePlaceholder a -> a
product :: forall a. Num a => MaybePlaceholder a -> a
Foldable, Functor MaybePlaceholder
Foldable MaybePlaceholder
(Functor MaybePlaceholder, Foldable MaybePlaceholder) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> MaybePlaceholder a -> f (MaybePlaceholder b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MaybePlaceholder (f a) -> f (MaybePlaceholder a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MaybePlaceholder a -> m (MaybePlaceholder b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MaybePlaceholder (m a) -> m (MaybePlaceholder a))
-> Traversable MaybePlaceholder
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MaybePlaceholder (m a) -> m (MaybePlaceholder a)
forall (f :: * -> *) a.
Applicative f =>
MaybePlaceholder (f a) -> f (MaybePlaceholder a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MaybePlaceholder a -> m (MaybePlaceholder b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MaybePlaceholder a -> f (MaybePlaceholder b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MaybePlaceholder a -> f (MaybePlaceholder b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MaybePlaceholder a -> f (MaybePlaceholder b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MaybePlaceholder (f a) -> f (MaybePlaceholder a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MaybePlaceholder (f a) -> f (MaybePlaceholder a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MaybePlaceholder a -> m (MaybePlaceholder b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MaybePlaceholder a -> m (MaybePlaceholder b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MaybePlaceholder (m a) -> m (MaybePlaceholder a)
sequence :: forall (m :: * -> *) a.
Monad m =>
MaybePlaceholder (m a) -> m (MaybePlaceholder a)
Traversable, Int -> MaybePlaceholder e -> ShowS
[MaybePlaceholder e] -> ShowS
MaybePlaceholder e -> String
(Int -> MaybePlaceholder e -> ShowS)
-> (MaybePlaceholder e -> String)
-> ([MaybePlaceholder e] -> ShowS)
-> Show (MaybePlaceholder e)
forall e. Show e => Int -> MaybePlaceholder e -> ShowS
forall e. Show e => [MaybePlaceholder e] -> ShowS
forall e. Show e => MaybePlaceholder e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> MaybePlaceholder e -> ShowS
showsPrec :: Int -> MaybePlaceholder e -> ShowS
$cshow :: forall e. Show e => MaybePlaceholder e -> String
show :: MaybePlaceholder e -> String
$cshowList :: forall e. Show e => [MaybePlaceholder e] -> ShowS
showList :: [MaybePlaceholder e] -> ShowS
Show)

-- | An abbreviation: @noPlaceholder = 'NoPlaceholder'
-- 'Strict.Nothing'@.

noPlaceholder :: e -> MaybePlaceholder e
noPlaceholder :: forall e. e -> MaybePlaceholder e
noPlaceholder = Maybe PositionInName -> e -> MaybePlaceholder e
forall e. Maybe PositionInName -> e -> MaybePlaceholder e
NoPlaceholder Maybe PositionInName
forall a. Maybe a
Strict.Nothing

instance HasRange a => HasRange (MaybePlaceholder a) where
  getRange :: MaybePlaceholder a -> Range
getRange Placeholder{}       = Range
forall a. Range' a
noRange
  getRange (NoPlaceholder Maybe PositionInName
_ a
e) = a -> Range
forall a. HasRange a => a -> Range
getRange a
e

instance KillRange a => KillRange (MaybePlaceholder a) where
  killRange :: KillRangeT (MaybePlaceholder a)
killRange p :: MaybePlaceholder a
p@Placeholder{}     = MaybePlaceholder a
p
  killRange (NoPlaceholder Maybe PositionInName
p a
e) = (a -> MaybePlaceholder a) -> a -> MaybePlaceholder a
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN (Maybe PositionInName -> a -> MaybePlaceholder a
forall e. Maybe PositionInName -> e -> MaybePlaceholder e
NoPlaceholder Maybe PositionInName
p) a
e

instance NFData a => NFData (MaybePlaceholder a) where
  rnf :: MaybePlaceholder a -> ()
rnf (Placeholder PositionInName
_)     = ()
  rnf (NoPlaceholder Maybe PositionInName
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

---------------------------------------------------------------------------
-- * Interaction meta variables
---------------------------------------------------------------------------

newtype InteractionId = InteractionId { InteractionId -> Int
interactionId :: Nat }
    deriving ( InteractionId -> InteractionId -> Bool
(InteractionId -> InteractionId -> Bool)
-> (InteractionId -> InteractionId -> Bool) -> Eq InteractionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InteractionId -> InteractionId -> Bool
== :: InteractionId -> InteractionId -> Bool
$c/= :: InteractionId -> InteractionId -> Bool
/= :: InteractionId -> InteractionId -> Bool
Eq
             , Eq InteractionId
Eq InteractionId =>
(InteractionId -> InteractionId -> Ordering)
-> (InteractionId -> InteractionId -> Bool)
-> (InteractionId -> InteractionId -> Bool)
-> (InteractionId -> InteractionId -> Bool)
-> (InteractionId -> InteractionId -> Bool)
-> (InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId -> InteractionId)
-> Ord InteractionId
InteractionId -> InteractionId -> Bool
InteractionId -> InteractionId -> Ordering
InteractionId -> InteractionId -> InteractionId
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
$ccompare :: InteractionId -> InteractionId -> Ordering
compare :: InteractionId -> InteractionId -> Ordering
$c< :: InteractionId -> InteractionId -> Bool
< :: InteractionId -> InteractionId -> Bool
$c<= :: InteractionId -> InteractionId -> Bool
<= :: InteractionId -> InteractionId -> Bool
$c> :: InteractionId -> InteractionId -> Bool
> :: InteractionId -> InteractionId -> Bool
$c>= :: InteractionId -> InteractionId -> Bool
>= :: InteractionId -> InteractionId -> Bool
$cmax :: InteractionId -> InteractionId -> InteractionId
max :: InteractionId -> InteractionId -> InteractionId
$cmin :: InteractionId -> InteractionId -> InteractionId
min :: InteractionId -> InteractionId -> InteractionId
Ord
             , Int -> InteractionId -> ShowS
[InteractionId] -> ShowS
InteractionId -> String
(Int -> InteractionId -> ShowS)
-> (InteractionId -> String)
-> ([InteractionId] -> ShowS)
-> Show InteractionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InteractionId -> ShowS
showsPrec :: Int -> InteractionId -> ShowS
$cshow :: InteractionId -> String
show :: InteractionId -> String
$cshowList :: [InteractionId] -> ShowS
showList :: [InteractionId] -> ShowS
Show
             , Integer -> InteractionId
InteractionId -> InteractionId
InteractionId -> InteractionId -> InteractionId
(InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId)
-> (InteractionId -> InteractionId)
-> (InteractionId -> InteractionId)
-> (Integer -> InteractionId)
-> Num InteractionId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: InteractionId -> InteractionId -> InteractionId
+ :: InteractionId -> InteractionId -> InteractionId
$c- :: InteractionId -> InteractionId -> InteractionId
- :: InteractionId -> InteractionId -> InteractionId
$c* :: InteractionId -> InteractionId -> InteractionId
* :: InteractionId -> InteractionId -> InteractionId
$cnegate :: InteractionId -> InteractionId
negate :: InteractionId -> InteractionId
$cabs :: InteractionId -> InteractionId
abs :: InteractionId -> InteractionId
$csignum :: InteractionId -> InteractionId
signum :: InteractionId -> InteractionId
$cfromInteger :: Integer -> InteractionId
fromInteger :: Integer -> InteractionId
Num
             , Enum InteractionId
Real InteractionId
(Real InteractionId, Enum InteractionId) =>
(InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId -> InteractionId)
-> (InteractionId -> InteractionId -> InteractionId)
-> (InteractionId
    -> InteractionId -> (InteractionId, InteractionId))
-> (InteractionId
    -> InteractionId -> (InteractionId, InteractionId))
-> (InteractionId -> Integer)
-> Integral InteractionId
InteractionId -> Integer
InteractionId -> InteractionId -> (InteractionId, InteractionId)
InteractionId -> InteractionId -> InteractionId
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: InteractionId -> InteractionId -> InteractionId
quot :: InteractionId -> InteractionId -> InteractionId
$crem :: InteractionId -> InteractionId -> InteractionId
rem :: InteractionId -> InteractionId -> InteractionId
$cdiv :: InteractionId -> InteractionId -> InteractionId
div :: InteractionId -> InteractionId -> InteractionId
$cmod :: InteractionId -> InteractionId -> InteractionId
mod :: InteractionId -> InteractionId -> InteractionId
$cquotRem :: InteractionId -> InteractionId -> (InteractionId, InteractionId)
quotRem :: InteractionId -> InteractionId -> (InteractionId, InteractionId)
$cdivMod :: InteractionId -> InteractionId -> (InteractionId, InteractionId)
divMod :: InteractionId -> InteractionId -> (InteractionId, InteractionId)
$ctoInteger :: InteractionId -> Integer
toInteger :: InteractionId -> Integer
Integral
             , Num InteractionId
Ord InteractionId
(Num InteractionId, Ord InteractionId) =>
(InteractionId -> Rational) -> Real InteractionId
InteractionId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: InteractionId -> Rational
toRational :: InteractionId -> Rational
Real
             , Int -> InteractionId
InteractionId -> Int
InteractionId -> [InteractionId]
InteractionId -> InteractionId
InteractionId -> InteractionId -> [InteractionId]
InteractionId -> InteractionId -> InteractionId -> [InteractionId]
(InteractionId -> InteractionId)
-> (InteractionId -> InteractionId)
-> (Int -> InteractionId)
-> (InteractionId -> Int)
-> (InteractionId -> [InteractionId])
-> (InteractionId -> InteractionId -> [InteractionId])
-> (InteractionId -> InteractionId -> [InteractionId])
-> (InteractionId
    -> InteractionId -> InteractionId -> [InteractionId])
-> Enum InteractionId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: InteractionId -> InteractionId
succ :: InteractionId -> InteractionId
$cpred :: InteractionId -> InteractionId
pred :: InteractionId -> InteractionId
$ctoEnum :: Int -> InteractionId
toEnum :: Int -> InteractionId
$cfromEnum :: InteractionId -> Int
fromEnum :: InteractionId -> Int
$cenumFrom :: InteractionId -> [InteractionId]
enumFrom :: InteractionId -> [InteractionId]
$cenumFromThen :: InteractionId -> InteractionId -> [InteractionId]
enumFromThen :: InteractionId -> InteractionId -> [InteractionId]
$cenumFromTo :: InteractionId -> InteractionId -> [InteractionId]
enumFromTo :: InteractionId -> InteractionId -> [InteractionId]
$cenumFromThenTo :: InteractionId -> InteractionId -> InteractionId -> [InteractionId]
enumFromThenTo :: InteractionId -> InteractionId -> InteractionId -> [InteractionId]
Enum
             , InteractionId -> ()
(InteractionId -> ()) -> NFData InteractionId
forall a. (a -> ()) -> NFData a
$crnf :: InteractionId -> ()
rnf :: InteractionId -> ()
NFData
             )

instance Pretty InteractionId where
    pretty :: InteractionId -> Doc
pretty (InteractionId Int
i) = String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

instance KillRange InteractionId where killRange :: InteractionId -> InteractionId
killRange = InteractionId -> InteractionId
forall a. a -> a
id

---------------------------------------------------------------------------
-- * Fixity
---------------------------------------------------------------------------

-- | Precedence levels for operators.

type PrecedenceLevel = Double

data FixityLevel
  = Unrelated
    -- ^ No fixity declared.
  | Related !PrecedenceLevel
    -- ^ Fixity level declared as the number.
  deriving (FixityLevel -> FixityLevel -> Bool
(FixityLevel -> FixityLevel -> Bool)
-> (FixityLevel -> FixityLevel -> Bool) -> Eq FixityLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FixityLevel -> FixityLevel -> Bool
== :: FixityLevel -> FixityLevel -> Bool
$c/= :: FixityLevel -> FixityLevel -> Bool
/= :: FixityLevel -> FixityLevel -> Bool
Eq, Eq FixityLevel
Eq FixityLevel =>
(FixityLevel -> FixityLevel -> Ordering)
-> (FixityLevel -> FixityLevel -> Bool)
-> (FixityLevel -> FixityLevel -> Bool)
-> (FixityLevel -> FixityLevel -> Bool)
-> (FixityLevel -> FixityLevel -> Bool)
-> (FixityLevel -> FixityLevel -> FixityLevel)
-> (FixityLevel -> FixityLevel -> FixityLevel)
-> Ord FixityLevel
FixityLevel -> FixityLevel -> Bool
FixityLevel -> FixityLevel -> Ordering
FixityLevel -> FixityLevel -> FixityLevel
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
$ccompare :: FixityLevel -> FixityLevel -> Ordering
compare :: FixityLevel -> FixityLevel -> Ordering
$c< :: FixityLevel -> FixityLevel -> Bool
< :: FixityLevel -> FixityLevel -> Bool
$c<= :: FixityLevel -> FixityLevel -> Bool
<= :: FixityLevel -> FixityLevel -> Bool
$c> :: FixityLevel -> FixityLevel -> Bool
> :: FixityLevel -> FixityLevel -> Bool
$c>= :: FixityLevel -> FixityLevel -> Bool
>= :: FixityLevel -> FixityLevel -> Bool
$cmax :: FixityLevel -> FixityLevel -> FixityLevel
max :: FixityLevel -> FixityLevel -> FixityLevel
$cmin :: FixityLevel -> FixityLevel -> FixityLevel
min :: FixityLevel -> FixityLevel -> FixityLevel
Ord, Int -> FixityLevel -> ShowS
[FixityLevel] -> ShowS
FixityLevel -> String
(Int -> FixityLevel -> ShowS)
-> (FixityLevel -> String)
-> ([FixityLevel] -> ShowS)
-> Show FixityLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FixityLevel -> ShowS
showsPrec :: Int -> FixityLevel -> ShowS
$cshow :: FixityLevel -> String
show :: FixityLevel -> String
$cshowList :: [FixityLevel] -> ShowS
showList :: [FixityLevel] -> ShowS
Show)

instance Null FixityLevel where
  null :: FixityLevel -> Bool
null FixityLevel
Unrelated = Bool
True
  null Related{} = Bool
False
  empty :: FixityLevel
empty = FixityLevel
Unrelated

instance NFData FixityLevel where
  rnf :: FixityLevel -> ()
rnf FixityLevel
Unrelated   = ()
  rnf (Related PrecedenceLevel
_) = ()

instance Pretty FixityLevel where
  pretty :: FixityLevel -> Doc
pretty = \case
    FixityLevel
Unrelated  -> Doc
forall a. Null a => a
empty
    Related PrecedenceLevel
d  -> String -> Doc
forall a. String -> Doc a
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ PrecedenceLevel -> String
toStringWithoutDotZero PrecedenceLevel
d

-- | Associativity.

data Associativity = NonAssoc | LeftAssoc | RightAssoc
   deriving (Associativity -> Associativity -> Bool
(Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool) -> Eq Associativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Associativity -> Associativity -> Bool
== :: Associativity -> Associativity -> Bool
$c/= :: Associativity -> Associativity -> Bool
/= :: Associativity -> Associativity -> Bool
Eq, Eq Associativity
Eq Associativity =>
(Associativity -> Associativity -> Ordering)
-> (Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Associativity)
-> (Associativity -> Associativity -> Associativity)
-> Ord Associativity
Associativity -> Associativity -> Bool
Associativity -> Associativity -> Ordering
Associativity -> Associativity -> Associativity
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
$ccompare :: Associativity -> Associativity -> Ordering
compare :: Associativity -> Associativity -> Ordering
$c< :: Associativity -> Associativity -> Bool
< :: Associativity -> Associativity -> Bool
$c<= :: Associativity -> Associativity -> Bool
<= :: Associativity -> Associativity -> Bool
$c> :: Associativity -> Associativity -> Bool
> :: Associativity -> Associativity -> Bool
$c>= :: Associativity -> Associativity -> Bool
>= :: Associativity -> Associativity -> Bool
$cmax :: Associativity -> Associativity -> Associativity
max :: Associativity -> Associativity -> Associativity
$cmin :: Associativity -> Associativity -> Associativity
min :: Associativity -> Associativity -> Associativity
Ord, Int -> Associativity -> ShowS
[Associativity] -> ShowS
Associativity -> String
(Int -> Associativity -> ShowS)
-> (Associativity -> String)
-> ([Associativity] -> ShowS)
-> Show Associativity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Associativity -> ShowS
showsPrec :: Int -> Associativity -> ShowS
$cshow :: Associativity -> String
show :: Associativity -> String
$cshowList :: [Associativity] -> ShowS
showList :: [Associativity] -> ShowS
Show)

instance Pretty Associativity where
  pretty :: Associativity -> Doc
pretty = \case
    Associativity
LeftAssoc  -> Doc
"infixl"
    Associativity
RightAssoc -> Doc
"infixr"
    Associativity
NonAssoc   -> Doc
"infix"

-- | Fixity of operators.

data Fixity = Fixity
  { Fixity -> Range
fixityRange :: Range
    -- ^ Range of the whole fixity declaration.
  , Fixity -> FixityLevel
fixityLevel :: !FixityLevel
  , Fixity -> Associativity
fixityAssoc :: !Associativity
  }
  deriving Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fixity -> ShowS
showsPrec :: Int -> Fixity -> ShowS
$cshow :: Fixity -> String
show :: Fixity -> String
$cshowList :: [Fixity] -> ShowS
showList :: [Fixity] -> ShowS
Show

noFixity :: Fixity
noFixity :: Fixity
noFixity = Range -> FixityLevel -> Associativity -> Fixity
Fixity Range
forall a. Range' a
noRange FixityLevel
Unrelated Associativity
NonAssoc

defaultFixity :: Fixity
defaultFixity :: Fixity
defaultFixity = Range -> FixityLevel -> Associativity -> Fixity
Fixity Range
forall a. Range' a
noRange (PrecedenceLevel -> FixityLevel
Related PrecedenceLevel
20) Associativity
NonAssoc

-- For @instance Pretty Fixity@, see Agda.Syntax.Concrete.Pretty

instance Eq Fixity where
  Fixity
f1 == :: Fixity -> Fixity -> Bool
== Fixity
f2 = Fixity -> Fixity -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Fixity
f1 Fixity
f2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord Fixity where
  compare :: Fixity -> Fixity -> Ordering
compare = (FixityLevel, Associativity)
-> (FixityLevel, Associativity) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((FixityLevel, Associativity)
 -> (FixityLevel, Associativity) -> Ordering)
-> (Fixity -> (FixityLevel, Associativity))
-> Fixity
-> Fixity
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Fixity -> FixityLevel
fixityLevel (Fixity -> FixityLevel)
-> (Fixity -> Associativity)
-> Fixity
-> (FixityLevel, Associativity)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Fixity -> Associativity
fixityAssoc)

instance Null Fixity where
  null :: Fixity -> Bool
null  = FixityLevel -> Bool
forall a. Null a => a -> Bool
null (FixityLevel -> Bool) -> (Fixity -> FixityLevel) -> Fixity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixity -> FixityLevel
fixityLevel
  empty :: Fixity
empty = Fixity
noFixity

instance HasRange Fixity where
  getRange :: Fixity -> Range
getRange = Fixity -> Range
fixityRange

instance KillRange Fixity where
  killRange :: Fixity -> Fixity
killRange Fixity
f = Fixity
f { fixityRange = noRange }

instance NFData Fixity where
  rnf :: Fixity -> ()
rnf (Fixity Range
_ FixityLevel
_ Associativity
_) = ()     -- Ranges are not forced, the other fields are strict.

instance Pretty Fixity where
  pretty :: Fixity -> Doc
pretty (Fixity Range
_ FixityLevel
level Associativity
ass) = case FixityLevel
level of
    FixityLevel
Unrelated  -> Doc
forall a. Null a => a
empty
    Related{}  -> Associativity -> Doc
forall a. Pretty a => a -> Doc
pretty Associativity
ass Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> FixityLevel -> Doc
forall a. Pretty a => a -> Doc
pretty FixityLevel
level

-- ** Notation coupled with 'Fixity'

-- | The notation is handled as the fixity in the renamer.
--   Hence, they are grouped together in this type.
data Fixity' = Fixity'
    { Fixity' -> Fixity
theFixity   :: !Fixity
    , Fixity' -> Notation
theNotation :: Notation
    , Fixity' -> Range
theNameRange :: Range
      -- ^ Range of the name in the fixity declaration
      --   (used for correct highlighting, see issue #2140).
    }
  deriving Int -> Fixity' -> ShowS
[Fixity'] -> ShowS
Fixity' -> String
(Int -> Fixity' -> ShowS)
-> (Fixity' -> String) -> ([Fixity'] -> ShowS) -> Show Fixity'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fixity' -> ShowS
showsPrec :: Int -> Fixity' -> ShowS
$cshow :: Fixity' -> String
show :: Fixity' -> String
$cshowList :: [Fixity'] -> ShowS
showList :: [Fixity'] -> ShowS
Show

noFixity' :: Fixity'
noFixity' :: Fixity'
noFixity' = Fixity -> Notation -> Range -> Fixity'
Fixity' Fixity
noFixity Notation
noNotation Range
forall a. Range' a
noRange

instance Eq Fixity' where
  Fixity' Fixity
f Notation
n Range
_ == :: Fixity' -> Fixity' -> Bool
== Fixity' Fixity
f' Notation
n' Range
_ = Fixity
f Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
f' Bool -> Bool -> Bool
&& Notation
n Notation -> Notation -> Bool
forall a. Eq a => a -> a -> Bool
== Notation
n'

instance Null Fixity' where
  null :: Fixity' -> Bool
null (Fixity' Fixity
f Notation
n Range
_) = Fixity -> Bool
forall a. Null a => a -> Bool
null Fixity
f Bool -> Bool -> Bool
&& Notation -> Bool
forall a. Null a => a -> Bool
null Notation
n
  empty :: Fixity'
empty = Fixity'
noFixity'

instance NFData Fixity' where
  rnf :: Fixity' -> ()
rnf (Fixity' Fixity
_ Notation
a Range
_) = Notation -> ()
forall a. NFData a => a -> ()
rnf Notation
a

-- Note that there are ranges also in 'Fixity' and 'Notation',
-- but we are biased here on the range for the error reporting.
instance HasRange Fixity' where
  getRange :: Fixity' -> Range
getRange = Fixity' -> Range
theNameRange

-- Kills all ranges, not just 'theNameRange'.
instance KillRange Fixity' where
  killRange :: KillRangeT Fixity'
killRange (Fixity' Fixity
f Notation
n Range
r) = (Fixity -> Notation -> Range -> Fixity')
-> Fixity -> Notation -> Range -> Fixity'
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN Fixity -> Notation -> Range -> Fixity'
Fixity' Fixity
f Notation
n Range
r

instance Pretty Fixity' where
    pretty :: Fixity' -> Doc
pretty (Fixity' Fixity
fix Notation
nota Range
_range)
      | Notation -> Bool
forall a. Null a => a -> Bool
null Notation
nota = Fixity -> Doc
forall a. Pretty a => a -> Doc
pretty Fixity
fix
      | Bool
otherwise = Doc -> Doc
hlKeyword Doc
"syntax" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Notation -> Doc
forall a. Pretty a => a -> Doc
pretty Notation
nota

-- lenses

_fixityAssoc :: Lens' Fixity Associativity
_fixityAssoc :: Lens' Fixity Associativity
_fixityAssoc Associativity -> f Associativity
f Fixity
r = Associativity -> f Associativity
f (Fixity -> Associativity
fixityAssoc Fixity
r) f Associativity -> (Associativity -> Fixity) -> f Fixity
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Associativity
x -> Fixity
r { fixityAssoc = x }

_fixityLevel :: Lens' Fixity FixityLevel
_fixityLevel :: Lens' Fixity FixityLevel
_fixityLevel FixityLevel -> f FixityLevel
f Fixity
r = FixityLevel -> f FixityLevel
f (Fixity -> FixityLevel
fixityLevel Fixity
r) f FixityLevel -> (FixityLevel -> Fixity) -> f Fixity
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \FixityLevel
x -> Fixity
r { fixityLevel = x }

-- Lens focusing on Fixity

class LensFixity a where
  lensFixity :: Lens' a Fixity

instance LensFixity Fixity where
  lensFixity :: Lens' Fixity Fixity
lensFixity = (Fixity -> f Fixity) -> Fixity -> f Fixity
forall a. a -> a
id

instance LensFixity Fixity' where
  lensFixity :: Lens' Fixity' Fixity
lensFixity Fixity -> f Fixity
f Fixity'
fix' = Fixity -> f Fixity
f (Fixity' -> Fixity
theFixity Fixity'
fix') f Fixity -> (Fixity -> Fixity') -> f Fixity'
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Fixity
fx -> Fixity'
fix' { theFixity = fx }

-- Lens focusing on Fixity'

class LensFixity' a where
  lensFixity' :: Lens' a Fixity'

instance LensFixity' Fixity' where
  lensFixity' :: Lens' Fixity' Fixity'
lensFixity' = (Fixity' -> f Fixity') -> Fixity' -> f Fixity'
forall a. a -> a
id

---------------------------------------------------------------------------
-- * Import directive
---------------------------------------------------------------------------

-- | The things you are allowed to say when you shuffle names between name
--   spaces (i.e. in @import@, @namespace@, or @open@ declarations).
data ImportDirective' n m = ImportDirective
  { forall n m. ImportDirective' n m -> Range
importDirRange :: Range
  , forall n m. ImportDirective' n m -> Using' n m
using          :: Using' n m
  , forall n m. ImportDirective' n m -> HidingDirective' n m
hiding         :: HidingDirective' n m
  , forall n m. ImportDirective' n m -> RenamingDirective' n m
impRenaming    :: RenamingDirective' n m
  , forall n m. ImportDirective' n m -> Maybe KwRange
publicOpen     :: Maybe KwRange
      -- ^ Only for @open@. Exports the opened names from the current module.
      --   Range of the @public@ keyword.
  }
  deriving (ImportDirective' n m -> ImportDirective' n m -> Bool
(ImportDirective' n m -> ImportDirective' n m -> Bool)
-> (ImportDirective' n m -> ImportDirective' n m -> Bool)
-> Eq (ImportDirective' n m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n m.
(Eq m, Eq n) =>
ImportDirective' n m -> ImportDirective' n m -> Bool
$c== :: forall n m.
(Eq m, Eq n) =>
ImportDirective' n m -> ImportDirective' n m -> Bool
== :: ImportDirective' n m -> ImportDirective' n m -> Bool
$c/= :: forall n m.
(Eq m, Eq n) =>
ImportDirective' n m -> ImportDirective' n m -> Bool
/= :: ImportDirective' n m -> ImportDirective' n m -> Bool
Eq, Int -> ImportDirective' n m -> ShowS
[ImportDirective' n m] -> ShowS
ImportDirective' n m -> String
(Int -> ImportDirective' n m -> ShowS)
-> (ImportDirective' n m -> String)
-> ([ImportDirective' n m] -> ShowS)
-> Show (ImportDirective' n m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n m.
(Show m, Show n) =>
Int -> ImportDirective' n m -> ShowS
forall n m. (Show m, Show n) => [ImportDirective' n m] -> ShowS
forall n m. (Show m, Show n) => ImportDirective' n m -> String
$cshowsPrec :: forall n m.
(Show m, Show n) =>
Int -> ImportDirective' n m -> ShowS
showsPrec :: Int -> ImportDirective' n m -> ShowS
$cshow :: forall n m. (Show m, Show n) => ImportDirective' n m -> String
show :: ImportDirective' n m -> String
$cshowList :: forall n m. (Show m, Show n) => [ImportDirective' n m] -> ShowS
showList :: [ImportDirective' n m] -> ShowS
Show)

type HidingDirective'   n m = [ImportedName' n m]
type RenamingDirective' n m = [Renaming' n m]

-- | @null@ for import directives holds when everything is imported unchanged
--   (no names are hidden or renamed).
instance Null (ImportDirective' n m) where
  null :: ImportDirective' n m -> Bool
null = \case
    ImportDirective Range
_ Using' n m
UseEverything [] [] Maybe KwRange
_ -> Bool
True
    ImportDirective' n m
_ -> Bool
False
  empty :: ImportDirective' n m
empty = ImportDirective' n m
forall n m. ImportDirective' n m
defaultImportDir

instance Semigroup (ImportDirective' n m) where
  ImportDirective' n m
i1 <> :: ImportDirective' n m
-> ImportDirective' n m -> ImportDirective' n m
<> ImportDirective' n m
i2 = ImportDirective
    { importDirRange :: Range
importDirRange = ImportDirective' n m -> ImportDirective' n m -> Range
forall u t. (HasRange u, HasRange t) => u -> t -> Range
fuseRange ImportDirective' n m
i1 ImportDirective' n m
i2
    , using :: Using' n m
using          = ImportDirective' n m -> Using' n m
forall n m. ImportDirective' n m -> Using' n m
using ImportDirective' n m
i1 Using' n m -> Using' n m -> Using' n m
forall a. Semigroup a => a -> a -> a
<> ImportDirective' n m -> Using' n m
forall n m. ImportDirective' n m -> Using' n m
using ImportDirective' n m
i2
    , hiding :: HidingDirective' n m
hiding         = ImportDirective' n m -> HidingDirective' n m
forall n m. ImportDirective' n m -> HidingDirective' n m
hiding ImportDirective' n m
i1 HidingDirective' n m
-> HidingDirective' n m -> HidingDirective' n m
forall a. [a] -> [a] -> [a]
++ ImportDirective' n m -> HidingDirective' n m
forall n m. ImportDirective' n m -> HidingDirective' n m
hiding ImportDirective' n m
i2
    , impRenaming :: RenamingDirective' n m
impRenaming    = ImportDirective' n m -> RenamingDirective' n m
forall n m. ImportDirective' n m -> RenamingDirective' n m
impRenaming ImportDirective' n m
i1 RenamingDirective' n m
-> RenamingDirective' n m -> RenamingDirective' n m
forall a. [a] -> [a] -> [a]
++ ImportDirective' n m -> RenamingDirective' n m
forall n m. ImportDirective' n m -> RenamingDirective' n m
impRenaming ImportDirective' n m
i2
    , publicOpen :: Maybe KwRange
publicOpen     = ImportDirective' n m -> Maybe KwRange
forall n m. ImportDirective' n m -> Maybe KwRange
publicOpen ImportDirective' n m
i1 Maybe KwRange -> Maybe KwRange -> Maybe KwRange
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ImportDirective' n m -> Maybe KwRange
forall n m. ImportDirective' n m -> Maybe KwRange
publicOpen ImportDirective' n m
i2
    }

instance Monoid (ImportDirective' n m) where
  mempty :: ImportDirective' n m
mempty  = ImportDirective' n m
forall a. Null a => a
empty
  mappend :: ImportDirective' n m
-> ImportDirective' n m -> ImportDirective' n m
mappend = ImportDirective' n m
-> ImportDirective' n m -> ImportDirective' n m
forall a. Semigroup a => a -> a -> a
(<>)

-- | Default is directive is @private@ (use everything, but do not export).
defaultImportDir :: ImportDirective' n m
defaultImportDir :: forall n m. ImportDirective' n m
defaultImportDir = Range
-> Using' n m
-> HidingDirective' n m
-> RenamingDirective' n m
-> Maybe KwRange
-> ImportDirective' n m
forall n m.
Range
-> Using' n m
-> HidingDirective' n m
-> RenamingDirective' n m
-> Maybe KwRange
-> ImportDirective' n m
ImportDirective Range
forall a. Range' a
noRange Using' n m
forall n m. Using' n m
UseEverything [] [] Maybe KwRange
forall a. Maybe a
Nothing

-- | @isDefaultImportDir@ implies @null@, but not the other way round.
isDefaultImportDir :: ImportDirective' n m -> Bool
isDefaultImportDir :: forall n m. ImportDirective' n m -> Bool
isDefaultImportDir ImportDirective' n m
dir = ImportDirective' n m -> Bool
forall a. Null a => a -> Bool
null ImportDirective' n m
dir Bool -> Bool -> Bool
&& Maybe KwRange -> Bool
forall a. Null a => a -> Bool
null (ImportDirective' n m -> Maybe KwRange
forall n m. ImportDirective' n m -> Maybe KwRange
publicOpen ImportDirective' n m
dir)

-- | The @using@ clause of import directive.
data Using' n m
  = UseEverything              -- ^ No @using@ clause given.
  | Using [ImportedName' n m]  -- ^ @using@ the specified names.
  deriving (Using' n m -> Using' n m -> Bool
(Using' n m -> Using' n m -> Bool)
-> (Using' n m -> Using' n m -> Bool) -> Eq (Using' n m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n m. (Eq m, Eq n) => Using' n m -> Using' n m -> Bool
$c== :: forall n m. (Eq m, Eq n) => Using' n m -> Using' n m -> Bool
== :: Using' n m -> Using' n m -> Bool
$c/= :: forall n m. (Eq m, Eq n) => Using' n m -> Using' n m -> Bool
/= :: Using' n m -> Using' n m -> Bool
Eq, Int -> Using' n m -> ShowS
[Using' n m] -> ShowS
Using' n m -> String
(Int -> Using' n m -> ShowS)
-> (Using' n m -> String)
-> ([Using' n m] -> ShowS)
-> Show (Using' n m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n m. (Show m, Show n) => Int -> Using' n m -> ShowS
forall n m. (Show m, Show n) => [Using' n m] -> ShowS
forall n m. (Show m, Show n) => Using' n m -> String
$cshowsPrec :: forall n m. (Show m, Show n) => Int -> Using' n m -> ShowS
showsPrec :: Int -> Using' n m -> ShowS
$cshow :: forall n m. (Show m, Show n) => Using' n m -> String
show :: Using' n m -> String
$cshowList :: forall n m. (Show m, Show n) => [Using' n m] -> ShowS
showList :: [Using' n m] -> ShowS
Show)

instance Semigroup (Using' n m) where
  Using' n m
UseEverything <> :: Using' n m -> Using' n m -> Using' n m
<> Using' n m
u             = Using' n m
u
  Using' n m
u             <> Using' n m
UseEverything = Using' n m
u
  Using [ImportedName' n m]
xs      <> Using [ImportedName' n m]
ys      = [ImportedName' n m] -> Using' n m
forall n m. [ImportedName' n m] -> Using' n m
Using ([ImportedName' n m]
xs [ImportedName' n m] -> [ImportedName' n m] -> [ImportedName' n m]
forall a. [a] -> [a] -> [a]
++ [ImportedName' n m]
ys)

instance Monoid (Using' n m) where
  mempty :: Using' n m
mempty  = Using' n m
forall n m. Using' n m
UseEverything
  mappend :: Using' n m -> Using' n m -> Using' n m
mappend = Using' n m -> Using' n m -> Using' n m
forall a. Semigroup a => a -> a -> a
(<>)

instance Null (Using' n m) where
  null :: Using' n m -> Bool
null Using' n m
UseEverything = Bool
True
  null Using{}       = Bool
False
  empty :: Using' n m
empty = Using' n m
forall a. Monoid a => a
mempty

mapUsing :: ([ImportedName' n1 m1] -> [ImportedName' n2 m2]) -> Using' n1 m1 -> Using' n2 m2
mapUsing :: forall n1 m1 n2 m2.
([ImportedName' n1 m1] -> [ImportedName' n2 m2])
-> Using' n1 m1 -> Using' n2 m2
mapUsing [ImportedName' n1 m1] -> [ImportedName' n2 m2]
f = \case
  Using' n1 m1
UseEverything -> Using' n2 m2
forall n m. Using' n m
UseEverything
  Using [ImportedName' n1 m1]
xs      -> [ImportedName' n2 m2] -> Using' n2 m2
forall n m. [ImportedName' n m] -> Using' n m
Using ([ImportedName' n2 m2] -> Using' n2 m2)
-> [ImportedName' n2 m2] -> Using' n2 m2
forall a b. (a -> b) -> a -> b
$ [ImportedName' n1 m1] -> [ImportedName' n2 m2]
f [ImportedName' n1 m1]
xs

-- | An imported name can be a module or a defined name.
data ImportedName' n m
  = ImportedModule  m  -- ^ Imported module name of type @m@.
  | ImportedName    n  -- ^ Imported name of type @n@.
  deriving (ImportedName' n m -> ImportedName' n m -> Bool
(ImportedName' n m -> ImportedName' n m -> Bool)
-> (ImportedName' n m -> ImportedName' n m -> Bool)
-> Eq (ImportedName' n m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n m.
(Eq m, Eq n) =>
ImportedName' n m -> ImportedName' n m -> Bool
$c== :: forall n m.
(Eq m, Eq n) =>
ImportedName' n m -> ImportedName' n m -> Bool
== :: ImportedName' n m -> ImportedName' n m -> Bool
$c/= :: forall n m.
(Eq m, Eq n) =>
ImportedName' n m -> ImportedName' n m -> Bool
/= :: ImportedName' n m -> ImportedName' n m -> Bool
Eq, Eq (ImportedName' n m)
Eq (ImportedName' n m) =>
(ImportedName' n m -> ImportedName' n m -> Ordering)
-> (ImportedName' n m -> ImportedName' n m -> Bool)
-> (ImportedName' n m -> ImportedName' n m -> Bool)
-> (ImportedName' n m -> ImportedName' n m -> Bool)
-> (ImportedName' n m -> ImportedName' n m -> Bool)
-> (ImportedName' n m -> ImportedName' n m -> ImportedName' n m)
-> (ImportedName' n m -> ImportedName' n m -> ImportedName' n m)
-> Ord (ImportedName' n m)
ImportedName' n m -> ImportedName' n m -> Bool
ImportedName' n m -> ImportedName' n m -> Ordering
ImportedName' n m -> ImportedName' n m -> ImportedName' n m
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
forall n m. (Ord m, Ord n) => Eq (ImportedName' n m)
forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Bool
forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Ordering
forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> ImportedName' n m
$ccompare :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Ordering
compare :: ImportedName' n m -> ImportedName' n m -> Ordering
$c< :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Bool
< :: ImportedName' n m -> ImportedName' n m -> Bool
$c<= :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Bool
<= :: ImportedName' n m -> ImportedName' n m -> Bool
$c> :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Bool
> :: ImportedName' n m -> ImportedName' n m -> Bool
$c>= :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> Bool
>= :: ImportedName' n m -> ImportedName' n m -> Bool
$cmax :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> ImportedName' n m
max :: ImportedName' n m -> ImportedName' n m -> ImportedName' n m
$cmin :: forall n m.
(Ord m, Ord n) =>
ImportedName' n m -> ImportedName' n m -> ImportedName' n m
min :: ImportedName' n m -> ImportedName' n m -> ImportedName' n m
Ord, Int -> ImportedName' n m -> ShowS
[ImportedName' n m] -> ShowS
ImportedName' n m -> String
(Int -> ImportedName' n m -> ShowS)
-> (ImportedName' n m -> String)
-> ([ImportedName' n m] -> ShowS)
-> Show (ImportedName' n m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n m. (Show m, Show n) => Int -> ImportedName' n m -> ShowS
forall n m. (Show m, Show n) => [ImportedName' n m] -> ShowS
forall n m. (Show m, Show n) => ImportedName' n m -> String
$cshowsPrec :: forall n m. (Show m, Show n) => Int -> ImportedName' n m -> ShowS
showsPrec :: Int -> ImportedName' n m -> ShowS
$cshow :: forall n m. (Show m, Show n) => ImportedName' n m -> String
show :: ImportedName' n m -> String
$cshowList :: forall n m. (Show m, Show n) => [ImportedName' n m] -> ShowS
showList :: [ImportedName' n m] -> ShowS
Show)

fromImportedName :: ImportedName' a a -> a
fromImportedName :: forall a. ImportedName' a a -> a
fromImportedName = \case
  ImportedModule a
x -> a
x
  ImportedName   a
x -> a
x

setImportedName :: ImportedName' a a -> a -> ImportedName' a a
setImportedName :: forall a. ImportedName' a a -> a -> ImportedName' a a
setImportedName (ImportedName   a
_) a
y = a -> ImportedName' a a
forall n m. n -> ImportedName' n m
ImportedName   a
y
setImportedName (ImportedModule a
_) a
y = a -> ImportedName' a a
forall n m. m -> ImportedName' n m
ImportedModule a
y

-- | Like 'partitionEithers'.
partitionImportedNames :: [ImportedName' n m] -> ([n], [m])
partitionImportedNames :: forall n m. [ImportedName' n m] -> ([n], [m])
partitionImportedNames = ((ImportedName' n m -> ([n], [m]) -> ([n], [m]))
 -> ([n], [m]) -> [ImportedName' n m] -> ([n], [m]))
-> ([n], [m])
-> (ImportedName' n m -> ([n], [m]) -> ([n], [m]))
-> [ImportedName' n m]
-> ([n], [m])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ImportedName' n m -> ([n], [m]) -> ([n], [m]))
-> ([n], [m]) -> [ImportedName' n m] -> ([n], [m])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([], []) ((ImportedName' n m -> ([n], [m]) -> ([n], [m]))
 -> [ImportedName' n m] -> ([n], [m]))
-> (ImportedName' n m -> ([n], [m]) -> ([n], [m]))
-> [ImportedName' n m]
-> ([n], [m])
forall a b. (a -> b) -> a -> b
$ \case
  ImportedName   n
n -> ([n] -> [n]) -> ([n], [m]) -> ([n], [m])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first  (n
nn -> [n] -> [n]
forall a. a -> [a] -> [a]
:)
  ImportedModule m
m -> ([m] -> [m]) -> ([n], [m]) -> ([n], [m])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (m
mm -> [m] -> [m]
forall a. a -> [a] -> [a]
:)

-- -- Defined in Concrete.Pretty
-- instance (Pretty n, Pretty m) => Pretty (ImportedName' n m) where
--   pretty (ImportedModule x) = "module" <+> pretty x
--   pretty (ImportedName   x) = pretty x

-- instance (Show n, Show m) => Show (ImportedName' n m) where
--   show (ImportedModule x) = "module " ++ show x
--   show (ImportedName   x) = show x

data Renaming' n m = Renaming
  { forall n m. Renaming' n m -> ImportedName' n m
renFrom    :: ImportedName' n m
    -- ^ Rename from this name.
  , forall n m. Renaming' n m -> ImportedName' n m
renTo      :: ImportedName' n m
    -- ^ To this one.  Must be same kind as 'renFrom'.
  , forall n m. Renaming' n m -> Maybe Fixity
renFixity  :: Maybe Fixity
    -- ^ New fixity of 'renTo' (optional).
  , forall n m. Renaming' n m -> Range
renToRange :: Range
    -- ^ The range of the \"to\" keyword.  Retained for highlighting purposes.
  }
  deriving (Renaming' n m -> Renaming' n m -> Bool
(Renaming' n m -> Renaming' n m -> Bool)
-> (Renaming' n m -> Renaming' n m -> Bool) -> Eq (Renaming' n m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n m. (Eq m, Eq n) => Renaming' n m -> Renaming' n m -> Bool
$c== :: forall n m. (Eq m, Eq n) => Renaming' n m -> Renaming' n m -> Bool
== :: Renaming' n m -> Renaming' n m -> Bool
$c/= :: forall n m. (Eq m, Eq n) => Renaming' n m -> Renaming' n m -> Bool
/= :: Renaming' n m -> Renaming' n m -> Bool
Eq, Int -> Renaming' n m -> ShowS
[Renaming' n m] -> ShowS
Renaming' n m -> String
(Int -> Renaming' n m -> ShowS)
-> (Renaming' n m -> String)
-> ([Renaming' n m] -> ShowS)
-> Show (Renaming' n m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n m. (Show m, Show n) => Int -> Renaming' n m -> ShowS
forall n m. (Show m, Show n) => [Renaming' n m] -> ShowS
forall n m. (Show m, Show n) => Renaming' n m -> String
$cshowsPrec :: forall n m. (Show m, Show n) => Int -> Renaming' n m -> ShowS
showsPrec :: Int -> Renaming' n m -> ShowS
$cshow :: forall n m. (Show m, Show n) => Renaming' n m -> String
show :: Renaming' n m -> String
$cshowList :: forall n m. (Show m, Show n) => [Renaming' n m] -> ShowS
showList :: [Renaming' n m] -> ShowS
Show)

-- ** HasRange instances

instance HasRange (ImportDirective' a b) where
  getRange :: ImportDirective' a b -> Range
getRange = ImportDirective' a b -> Range
forall n m. ImportDirective' n m -> Range
importDirRange

instance (HasRange a, HasRange b) => HasRange (Using' a b) where
  getRange :: Using' a b -> Range
getRange (Using  [ImportedName' a b]
xs) = [ImportedName' a b] -> Range
forall a. HasRange a => a -> Range
getRange [ImportedName' a b]
xs
  getRange Using' a b
UseEverything = Range
forall a. Range' a
noRange

instance (HasRange a, HasRange b) => HasRange (Renaming' a b) where
  getRange :: Renaming' a b -> Range
getRange Renaming' a b
r = (ImportedName' a b, ImportedName' a b) -> Range
forall a. HasRange a => a -> Range
getRange (Renaming' a b -> ImportedName' a b
forall n m. Renaming' n m -> ImportedName' n m
renFrom Renaming' a b
r, Renaming' a b -> ImportedName' a b
forall n m. Renaming' n m -> ImportedName' n m
renTo Renaming' a b
r)

instance (HasRange a, HasRange b) => HasRange (ImportedName' a b) where
  getRange :: ImportedName' a b -> Range
getRange (ImportedName   a
x) = a -> Range
forall a. HasRange a => a -> Range
getRange a
x
  getRange (ImportedModule b
x) = b -> Range
forall a. HasRange a => a -> Range
getRange b
x

-- ** KillRange instances

instance (KillRange a, KillRange b) => KillRange (ImportDirective' a b) where
  killRange :: KillRangeT (ImportDirective' a b)
killRange (ImportDirective Range
_ Using' a b
u HidingDirective' a b
h RenamingDirective' a b
r Maybe KwRange
p) =
    (Using' a b
 -> HidingDirective' a b
 -> RenamingDirective' a b
 -> ImportDirective' a b)
-> Using' a b
-> HidingDirective' a b
-> RenamingDirective' a b
-> ImportDirective' a b
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN (\Using' a b
u HidingDirective' a b
h RenamingDirective' a b
r -> Range
-> Using' a b
-> HidingDirective' a b
-> RenamingDirective' a b
-> Maybe KwRange
-> ImportDirective' a b
forall n m.
Range
-> Using' n m
-> HidingDirective' n m
-> RenamingDirective' n m
-> Maybe KwRange
-> ImportDirective' n m
ImportDirective Range
forall a. Range' a
noRange Using' a b
u HidingDirective' a b
h RenamingDirective' a b
r (Maybe KwRange
p Maybe KwRange -> KwRange -> Maybe KwRange
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> KwRange
forall a. Null a => a
empty)) Using' a b
u HidingDirective' a b
h RenamingDirective' a b
r

instance (KillRange a, KillRange b) => KillRange (Using' a b) where
  killRange :: KillRangeT (Using' a b)
killRange (Using  [ImportedName' a b]
i) = ([ImportedName' a b] -> Using' a b)
-> [ImportedName' a b] -> Using' a b
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN [ImportedName' a b] -> Using' a b
forall n m. [ImportedName' n m] -> Using' n m
Using  [ImportedName' a b]
i
  killRange Using' a b
UseEverything = Using' a b
forall n m. Using' n m
UseEverything

instance (KillRange a, KillRange b) => KillRange (Renaming' a b) where
  killRange :: KillRangeT (Renaming' a b)
killRange (Renaming ImportedName' a b
i ImportedName' a b
n Maybe Fixity
mf Range
_to) = (ImportedName' a b
 -> ImportedName' a b -> Maybe Fixity -> Renaming' a b)
-> ImportedName' a b
-> ImportedName' a b
-> Maybe Fixity
-> Renaming' a b
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN (\ ImportedName' a b
i ImportedName' a b
n Maybe Fixity
mf -> ImportedName' a b
-> ImportedName' a b -> Maybe Fixity -> Range -> Renaming' a b
forall n m.
ImportedName' n m
-> ImportedName' n m -> Maybe Fixity -> Range -> Renaming' n m
Renaming ImportedName' a b
i ImportedName' a b
n Maybe Fixity
mf Range
forall a. Range' a
noRange) ImportedName' a b
i ImportedName' a b
n Maybe Fixity
mf

instance (KillRange a, KillRange b) => KillRange (ImportedName' a b) where
  killRange :: KillRangeT (ImportedName' a b)
killRange (ImportedModule b
n) = (b -> ImportedName' a b) -> b -> ImportedName' a b
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN b -> ImportedName' a b
forall n m. m -> ImportedName' n m
ImportedModule b
n
  killRange (ImportedName   a
n) = (a -> ImportedName' a b) -> a -> ImportedName' a b
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN a -> ImportedName' a b
forall n m. n -> ImportedName' n m
ImportedName   a
n

-- ** Pretty instances

instance (Pretty a, Pretty b) => Pretty (ImportDirective' a b) where
    pretty :: ImportDirective' a b -> Doc
pretty ImportDirective' a b
i =
        [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
sep [ Maybe KwRange -> Doc
forall {a} {a}. (IsString a, Null a) => Maybe a -> a
public (ImportDirective' a b -> Maybe KwRange
forall n m. ImportDirective' n m -> Maybe KwRange
publicOpen ImportDirective' a b
i)
            , Using' a b -> Doc
forall a. Pretty a => a -> Doc
pretty (Using' a b -> Doc) -> Using' a b -> Doc
forall a b. (a -> b) -> a -> b
$ ImportDirective' a b -> Using' a b
forall n m. ImportDirective' n m -> Using' n m
using ImportDirective' a b
i
            , [ImportedName' a b] -> Doc
forall {a}. Pretty a => [a] -> Doc
prettyHiding ([ImportedName' a b] -> Doc) -> [ImportedName' a b] -> Doc
forall a b. (a -> b) -> a -> b
$ ImportDirective' a b -> [ImportedName' a b]
forall n m. ImportDirective' n m -> HidingDirective' n m
hiding ImportDirective' a b
i
            , [Renaming' a b] -> Doc
forall {a}. Pretty a => [a] -> Doc
rename ([Renaming' a b] -> Doc) -> [Renaming' a b] -> Doc
forall a b. (a -> b) -> a -> b
$ ImportDirective' a b -> [Renaming' a b]
forall n m. ImportDirective' n m -> RenamingDirective' n m
impRenaming ImportDirective' a b
i
            ]
        where
            public :: Maybe a -> a
public Just{}  = a
"public"
            public Maybe a
Nothing = a
forall a. Null a => a
empty

            prettyHiding :: [a] -> Doc
prettyHiding [] = Doc
forall a. Null a => a
empty
            prettyHiding [a]
xs = Doc
"hiding" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc -> Doc
parens ([Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
";" ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a]
xs)

            rename :: [a] -> Doc
rename [] = Doc
forall a. Null a => a
empty
            rename [a]
xs = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
hsep [ Doc
"renaming"
                             , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
";" ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
pretty [a]
xs
                             ]

instance (Pretty a, Pretty b) => Pretty (Using' a b) where
    pretty :: Using' a b -> Doc
pretty Using' a b
UseEverything = Doc
forall a. Null a => a
empty
    pretty (Using [ImportedName' a b]
xs)    =
        Doc
"using" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc -> Doc
parens ([Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
";" ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (ImportedName' a b -> Doc) -> [ImportedName' a b] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ImportedName' a b -> Doc
forall a. Pretty a => a -> Doc
pretty [ImportedName' a b]
xs)

instance (Pretty a, Pretty b) => Pretty (ImportedName' a b) where
    pretty :: ImportedName' a b -> Doc
pretty (ImportedName   a
a) = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a
    pretty (ImportedModule b
b) = Doc
"module" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
b

instance (Pretty a, Pretty b) => Pretty (Renaming' a b) where
    pretty :: Renaming' a b -> Doc
pretty (Renaming ImportedName' a b
from ImportedName' a b
to Maybe Fixity
mfx Range
_r) = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
hsep
      [ ImportedName' a b -> Doc
forall a. Pretty a => a -> Doc
pretty ImportedName' a b
from
      , Doc
"to"
      , Doc -> (Fixity -> Doc) -> Maybe Fixity -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
forall a. Null a => a
empty Fixity -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe Fixity
mfx
      , case ImportedName' a b
to of
          ImportedName a
a   -> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
a
          ImportedModule b
b -> b -> Doc
forall a. Pretty a => a -> Doc
pretty b
b   -- don't print "module" here
      ]

-- ** NFData instances

-- | Ranges are not forced.

instance (NFData a, NFData b) => NFData (ImportDirective' a b) where
  rnf :: ImportDirective' a b -> ()
rnf (ImportDirective Range
_ Using' a b
a HidingDirective' a b
b RenamingDirective' a b
c Maybe KwRange
_) = Using' a b -> ()
forall a. NFData a => a -> ()
rnf Using' a b
a () -> () -> ()
forall a b. a -> b -> b
`seq` HidingDirective' a b -> ()
forall a. NFData a => a -> ()
rnf HidingDirective' a b
b () -> () -> ()
forall a b. a -> b -> b
`seq` RenamingDirective' a b -> ()
forall a. NFData a => a -> ()
rnf RenamingDirective' a b
c

instance (NFData a, NFData b) => NFData (Using' a b) where
  rnf :: Using' a b -> ()
rnf Using' a b
UseEverything = ()
  rnf (Using [ImportedName' a b]
a)     = [ImportedName' a b] -> ()
forall a. NFData a => a -> ()
rnf [ImportedName' a b]
a

-- | Ranges are not forced.

instance (NFData a, NFData b) => NFData (Renaming' a b) where
  rnf :: Renaming' a b -> ()
rnf (Renaming ImportedName' a b
a ImportedName' a b
b Maybe Fixity
c Range
_) = ImportedName' a b -> ()
forall a. NFData a => a -> ()
rnf ImportedName' a b
a () -> () -> ()
forall a b. a -> b -> b
`seq` ImportedName' a b -> ()
forall a. NFData a => a -> ()
rnf ImportedName' a b
b () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Fixity -> ()
forall a. NFData a => a -> ()
rnf Maybe Fixity
c

instance (NFData a, NFData b) => NFData (ImportedName' a b) where
  rnf :: ImportedName' a b -> ()
rnf (ImportedModule b
a) = b -> ()
forall a. NFData a => a -> ()
rnf b
a
  rnf (ImportedName a
a)   = a -> ()
forall a. NFData a => a -> ()
rnf a
a

-----------------------------------------------------------------------------
-- * Termination
-----------------------------------------------------------------------------

-- | Termination check? (Default = TerminationCheck).
data TerminationCheck
  = TerminationCheck
    -- ^ Run the termination checker.
  | NoTerminationCheck
    -- ^ Skip termination checking (unsafe).
  | NonTerminating
    -- ^ Treat as non-terminating.
  | Terminating
    -- ^ Treat as terminating (unsafe).  Same effect as 'NoTerminationCheck'.
    deriving (Int -> TerminationCheck -> ShowS
[TerminationCheck] -> ShowS
TerminationCheck -> String
(Int -> TerminationCheck -> ShowS)
-> (TerminationCheck -> String)
-> ([TerminationCheck] -> ShowS)
-> Show TerminationCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TerminationCheck -> ShowS
showsPrec :: Int -> TerminationCheck -> ShowS
$cshow :: TerminationCheck -> String
show :: TerminationCheck -> String
$cshowList :: [TerminationCheck] -> ShowS
showList :: [TerminationCheck] -> ShowS
Show, TerminationCheck -> TerminationCheck -> Bool
(TerminationCheck -> TerminationCheck -> Bool)
-> (TerminationCheck -> TerminationCheck -> Bool)
-> Eq TerminationCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TerminationCheck -> TerminationCheck -> Bool
== :: TerminationCheck -> TerminationCheck -> Bool
$c/= :: TerminationCheck -> TerminationCheck -> Bool
/= :: TerminationCheck -> TerminationCheck -> Bool
Eq, (forall x. TerminationCheck -> Rep TerminationCheck x)
-> (forall x. Rep TerminationCheck x -> TerminationCheck)
-> Generic TerminationCheck
forall x. Rep TerminationCheck x -> TerminationCheck
forall x. TerminationCheck -> Rep TerminationCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TerminationCheck -> Rep TerminationCheck x
from :: forall x. TerminationCheck -> Rep TerminationCheck x
$cto :: forall x. Rep TerminationCheck x -> TerminationCheck
to :: forall x. Rep TerminationCheck x -> TerminationCheck
Generic)

instance NFData TerminationCheck

-----------------------------------------------------------------------------
-- * Positivity
-----------------------------------------------------------------------------

-- | Positivity check? (Default = True).
data PositivityCheck = YesPositivityCheck | NoPositivityCheck
  deriving (PositivityCheck -> PositivityCheck -> Bool
(PositivityCheck -> PositivityCheck -> Bool)
-> (PositivityCheck -> PositivityCheck -> Bool)
-> Eq PositivityCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PositivityCheck -> PositivityCheck -> Bool
== :: PositivityCheck -> PositivityCheck -> Bool
$c/= :: PositivityCheck -> PositivityCheck -> Bool
/= :: PositivityCheck -> PositivityCheck -> Bool
Eq, Eq PositivityCheck
Eq PositivityCheck =>
(PositivityCheck -> PositivityCheck -> Ordering)
-> (PositivityCheck -> PositivityCheck -> Bool)
-> (PositivityCheck -> PositivityCheck -> Bool)
-> (PositivityCheck -> PositivityCheck -> Bool)
-> (PositivityCheck -> PositivityCheck -> Bool)
-> (PositivityCheck -> PositivityCheck -> PositivityCheck)
-> (PositivityCheck -> PositivityCheck -> PositivityCheck)
-> Ord PositivityCheck
PositivityCheck -> PositivityCheck -> Bool
PositivityCheck -> PositivityCheck -> Ordering
PositivityCheck -> PositivityCheck -> PositivityCheck
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
$ccompare :: PositivityCheck -> PositivityCheck -> Ordering
compare :: PositivityCheck -> PositivityCheck -> Ordering
$c< :: PositivityCheck -> PositivityCheck -> Bool
< :: PositivityCheck -> PositivityCheck -> Bool
$c<= :: PositivityCheck -> PositivityCheck -> Bool
<= :: PositivityCheck -> PositivityCheck -> Bool
$c> :: PositivityCheck -> PositivityCheck -> Bool
> :: PositivityCheck -> PositivityCheck -> Bool
$c>= :: PositivityCheck -> PositivityCheck -> Bool
>= :: PositivityCheck -> PositivityCheck -> Bool
$cmax :: PositivityCheck -> PositivityCheck -> PositivityCheck
max :: PositivityCheck -> PositivityCheck -> PositivityCheck
$cmin :: PositivityCheck -> PositivityCheck -> PositivityCheck
min :: PositivityCheck -> PositivityCheck -> PositivityCheck
Ord, Int -> PositivityCheck -> ShowS
[PositivityCheck] -> ShowS
PositivityCheck -> String
(Int -> PositivityCheck -> ShowS)
-> (PositivityCheck -> String)
-> ([PositivityCheck] -> ShowS)
-> Show PositivityCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PositivityCheck -> ShowS
showsPrec :: Int -> PositivityCheck -> ShowS
$cshow :: PositivityCheck -> String
show :: PositivityCheck -> String
$cshowList :: [PositivityCheck] -> ShowS
showList :: [PositivityCheck] -> ShowS
Show, PositivityCheck
PositivityCheck -> PositivityCheck -> Bounded PositivityCheck
forall a. a -> a -> Bounded a
$cminBound :: PositivityCheck
minBound :: PositivityCheck
$cmaxBound :: PositivityCheck
maxBound :: PositivityCheck
Bounded, Int -> PositivityCheck
PositivityCheck -> Int
PositivityCheck -> [PositivityCheck]
PositivityCheck -> PositivityCheck
PositivityCheck -> PositivityCheck -> [PositivityCheck]
PositivityCheck
-> PositivityCheck -> PositivityCheck -> [PositivityCheck]
(PositivityCheck -> PositivityCheck)
-> (PositivityCheck -> PositivityCheck)
-> (Int -> PositivityCheck)
-> (PositivityCheck -> Int)
-> (PositivityCheck -> [PositivityCheck])
-> (PositivityCheck -> PositivityCheck -> [PositivityCheck])
-> (PositivityCheck -> PositivityCheck -> [PositivityCheck])
-> (PositivityCheck
    -> PositivityCheck -> PositivityCheck -> [PositivityCheck])
-> Enum PositivityCheck
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PositivityCheck -> PositivityCheck
succ :: PositivityCheck -> PositivityCheck
$cpred :: PositivityCheck -> PositivityCheck
pred :: PositivityCheck -> PositivityCheck
$ctoEnum :: Int -> PositivityCheck
toEnum :: Int -> PositivityCheck
$cfromEnum :: PositivityCheck -> Int
fromEnum :: PositivityCheck -> Int
$cenumFrom :: PositivityCheck -> [PositivityCheck]
enumFrom :: PositivityCheck -> [PositivityCheck]
$cenumFromThen :: PositivityCheck -> PositivityCheck -> [PositivityCheck]
enumFromThen :: PositivityCheck -> PositivityCheck -> [PositivityCheck]
$cenumFromTo :: PositivityCheck -> PositivityCheck -> [PositivityCheck]
enumFromTo :: PositivityCheck -> PositivityCheck -> [PositivityCheck]
$cenumFromThenTo :: PositivityCheck
-> PositivityCheck -> PositivityCheck -> [PositivityCheck]
enumFromThenTo :: PositivityCheck
-> PositivityCheck -> PositivityCheck -> [PositivityCheck]
Enum, (forall x. PositivityCheck -> Rep PositivityCheck x)
-> (forall x. Rep PositivityCheck x -> PositivityCheck)
-> Generic PositivityCheck
forall x. Rep PositivityCheck x -> PositivityCheck
forall x. PositivityCheck -> Rep PositivityCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PositivityCheck -> Rep PositivityCheck x
from :: forall x. PositivityCheck -> Rep PositivityCheck x
$cto :: forall x. Rep PositivityCheck x -> PositivityCheck
to :: forall x. Rep PositivityCheck x -> PositivityCheck
Generic)

instance KillRange PositivityCheck where
  killRange :: PositivityCheck -> PositivityCheck
killRange = PositivityCheck -> PositivityCheck
forall a. a -> a
id

-- Semigroup and Monoid via conjunction
instance Semigroup PositivityCheck where
  PositivityCheck
NoPositivityCheck <> :: PositivityCheck -> PositivityCheck -> PositivityCheck
<> PositivityCheck
_ = PositivityCheck
NoPositivityCheck
  PositivityCheck
_ <> PositivityCheck
NoPositivityCheck = PositivityCheck
NoPositivityCheck
  PositivityCheck
_ <> PositivityCheck
_ = PositivityCheck
YesPositivityCheck

instance Null PositivityCheck where
  empty :: PositivityCheck
empty = PositivityCheck
YesPositivityCheck

instance Monoid PositivityCheck where
  mempty :: PositivityCheck
mempty  = PositivityCheck
forall a. Null a => a
empty

instance NFData PositivityCheck

-----------------------------------------------------------------------------
-- * Universe checking
-----------------------------------------------------------------------------

-- | Universe check? (Default is yes).
data UniverseCheck = YesUniverseCheck | NoUniverseCheck
  deriving (UniverseCheck -> UniverseCheck -> Bool
(UniverseCheck -> UniverseCheck -> Bool)
-> (UniverseCheck -> UniverseCheck -> Bool) -> Eq UniverseCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UniverseCheck -> UniverseCheck -> Bool
== :: UniverseCheck -> UniverseCheck -> Bool
$c/= :: UniverseCheck -> UniverseCheck -> Bool
/= :: UniverseCheck -> UniverseCheck -> Bool
Eq, Eq UniverseCheck
Eq UniverseCheck =>
(UniverseCheck -> UniverseCheck -> Ordering)
-> (UniverseCheck -> UniverseCheck -> Bool)
-> (UniverseCheck -> UniverseCheck -> Bool)
-> (UniverseCheck -> UniverseCheck -> Bool)
-> (UniverseCheck -> UniverseCheck -> Bool)
-> (UniverseCheck -> UniverseCheck -> UniverseCheck)
-> (UniverseCheck -> UniverseCheck -> UniverseCheck)
-> Ord UniverseCheck
UniverseCheck -> UniverseCheck -> Bool
UniverseCheck -> UniverseCheck -> Ordering
UniverseCheck -> UniverseCheck -> UniverseCheck
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
$ccompare :: UniverseCheck -> UniverseCheck -> Ordering
compare :: UniverseCheck -> UniverseCheck -> Ordering
$c< :: UniverseCheck -> UniverseCheck -> Bool
< :: UniverseCheck -> UniverseCheck -> Bool
$c<= :: UniverseCheck -> UniverseCheck -> Bool
<= :: UniverseCheck -> UniverseCheck -> Bool
$c> :: UniverseCheck -> UniverseCheck -> Bool
> :: UniverseCheck -> UniverseCheck -> Bool
$c>= :: UniverseCheck -> UniverseCheck -> Bool
>= :: UniverseCheck -> UniverseCheck -> Bool
$cmax :: UniverseCheck -> UniverseCheck -> UniverseCheck
max :: UniverseCheck -> UniverseCheck -> UniverseCheck
$cmin :: UniverseCheck -> UniverseCheck -> UniverseCheck
min :: UniverseCheck -> UniverseCheck -> UniverseCheck
Ord, Int -> UniverseCheck -> ShowS
[UniverseCheck] -> ShowS
UniverseCheck -> String
(Int -> UniverseCheck -> ShowS)
-> (UniverseCheck -> String)
-> ([UniverseCheck] -> ShowS)
-> Show UniverseCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UniverseCheck -> ShowS
showsPrec :: Int -> UniverseCheck -> ShowS
$cshow :: UniverseCheck -> String
show :: UniverseCheck -> String
$cshowList :: [UniverseCheck] -> ShowS
showList :: [UniverseCheck] -> ShowS
Show, UniverseCheck
UniverseCheck -> UniverseCheck -> Bounded UniverseCheck
forall a. a -> a -> Bounded a
$cminBound :: UniverseCheck
minBound :: UniverseCheck
$cmaxBound :: UniverseCheck
maxBound :: UniverseCheck
Bounded, Int -> UniverseCheck
UniverseCheck -> Int
UniverseCheck -> [UniverseCheck]
UniverseCheck -> UniverseCheck
UniverseCheck -> UniverseCheck -> [UniverseCheck]
UniverseCheck -> UniverseCheck -> UniverseCheck -> [UniverseCheck]
(UniverseCheck -> UniverseCheck)
-> (UniverseCheck -> UniverseCheck)
-> (Int -> UniverseCheck)
-> (UniverseCheck -> Int)
-> (UniverseCheck -> [UniverseCheck])
-> (UniverseCheck -> UniverseCheck -> [UniverseCheck])
-> (UniverseCheck -> UniverseCheck -> [UniverseCheck])
-> (UniverseCheck
    -> UniverseCheck -> UniverseCheck -> [UniverseCheck])
-> Enum UniverseCheck
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UniverseCheck -> UniverseCheck
succ :: UniverseCheck -> UniverseCheck
$cpred :: UniverseCheck -> UniverseCheck
pred :: UniverseCheck -> UniverseCheck
$ctoEnum :: Int -> UniverseCheck
toEnum :: Int -> UniverseCheck
$cfromEnum :: UniverseCheck -> Int
fromEnum :: UniverseCheck -> Int
$cenumFrom :: UniverseCheck -> [UniverseCheck]
enumFrom :: UniverseCheck -> [UniverseCheck]
$cenumFromThen :: UniverseCheck -> UniverseCheck -> [UniverseCheck]
enumFromThen :: UniverseCheck -> UniverseCheck -> [UniverseCheck]
$cenumFromTo :: UniverseCheck -> UniverseCheck -> [UniverseCheck]
enumFromTo :: UniverseCheck -> UniverseCheck -> [UniverseCheck]
$cenumFromThenTo :: UniverseCheck -> UniverseCheck -> UniverseCheck -> [UniverseCheck]
enumFromThenTo :: UniverseCheck -> UniverseCheck -> UniverseCheck -> [UniverseCheck]
Enum, (forall x. UniverseCheck -> Rep UniverseCheck x)
-> (forall x. Rep UniverseCheck x -> UniverseCheck)
-> Generic UniverseCheck
forall x. Rep UniverseCheck x -> UniverseCheck
forall x. UniverseCheck -> Rep UniverseCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UniverseCheck -> Rep UniverseCheck x
from :: forall x. UniverseCheck -> Rep UniverseCheck x
$cto :: forall x. Rep UniverseCheck x -> UniverseCheck
to :: forall x. Rep UniverseCheck x -> UniverseCheck
Generic)

instance KillRange UniverseCheck where
  killRange :: UniverseCheck -> UniverseCheck
killRange = UniverseCheck -> UniverseCheck
forall a. a -> a
id

instance NFData UniverseCheck

instance Null UniverseCheck where
  empty :: UniverseCheck
empty = UniverseCheck
YesUniverseCheck

instance Semigroup UniverseCheck where
  UniverseCheck
NoUniverseCheck  <> :: UniverseCheck -> UniverseCheck -> UniverseCheck
<> UniverseCheck
_  = UniverseCheck
NoUniverseCheck
  UniverseCheck
YesUniverseCheck <> UniverseCheck
uc = UniverseCheck
uc

instance Monoid UniverseCheck where
  mempty :: UniverseCheck
mempty = UniverseCheck
forall a. Null a => a
empty

-----------------------------------------------------------------------------
-- * Coverage
-----------------------------------------------------------------------------

-- | 'Range' of the CATCHALL pragma for a clause, if any.
--   'Nothing' means no such pragma.
data Catchall = YesCatchall Range | NoCatchall
  deriving (Catchall -> Catchall -> Bool
(Catchall -> Catchall -> Bool)
-> (Catchall -> Catchall -> Bool) -> Eq Catchall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Catchall -> Catchall -> Bool
== :: Catchall -> Catchall -> Bool
$c/= :: Catchall -> Catchall -> Bool
/= :: Catchall -> Catchall -> Bool
Eq, Int -> Catchall -> ShowS
[Catchall] -> ShowS
Catchall -> String
(Int -> Catchall -> ShowS)
-> (Catchall -> String) -> ([Catchall] -> ShowS) -> Show Catchall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Catchall -> ShowS
showsPrec :: Int -> Catchall -> ShowS
$cshow :: Catchall -> String
show :: Catchall -> String
$cshowList :: [Catchall] -> ShowS
showList :: [Catchall] -> ShowS
Show, (forall x. Catchall -> Rep Catchall x)
-> (forall x. Rep Catchall x -> Catchall) -> Generic Catchall
forall x. Rep Catchall x -> Catchall
forall x. Catchall -> Rep Catchall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Catchall -> Rep Catchall x
from :: forall x. Catchall -> Rep Catchall x
$cto :: forall x. Rep Catchall x -> Catchall
to :: forall x. Rep Catchall x -> Catchall
Generic)

-- | Composition is left-biased, taking the left 'Range' if both have one.
instance Semigroup Catchall where
  Catchall
NoCatchall         <> :: Catchall -> Catchall -> Catchall
<> Catchall
c                   = Catchall
c
  Catchall
c                  <> Catchall
NoCatchall          = Catchall
c
  c1 :: Catchall
c1@(YesCatchall Range
r) <> c2 :: Catchall
c2@(YesCatchall Range
_r) = if Range -> Bool
forall a. Null a => a -> Bool
null Range
r then Catchall
c2 else Catchall
c1

instance Monoid Catchall where
  mempty :: Catchall
mempty = Catchall
forall a. Null a => a
empty

instance Null Catchall where
  empty :: Catchall
empty = Catchall
NoCatchall

instance KillRange Catchall where
  killRange :: Catchall -> Catchall
killRange = \case
    YesCatchall Range
_ -> Range -> Catchall
YesCatchall Range
forall a. Range' a
noRange
    Catchall
NoCatchall    -> Catchall
NoCatchall

instance NFData Catchall where
  rnf :: Catchall -> ()
rnf = \case
    YesCatchall Range
_ -> ()
    Catchall
NoCatchall    -> ()

-- | Coverage check? (Default is yes).
data CoverageCheck = YesCoverageCheck | NoCoverageCheck
  deriving (CoverageCheck -> CoverageCheck -> Bool
(CoverageCheck -> CoverageCheck -> Bool)
-> (CoverageCheck -> CoverageCheck -> Bool) -> Eq CoverageCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CoverageCheck -> CoverageCheck -> Bool
== :: CoverageCheck -> CoverageCheck -> Bool
$c/= :: CoverageCheck -> CoverageCheck -> Bool
/= :: CoverageCheck -> CoverageCheck -> Bool
Eq, Eq CoverageCheck
Eq CoverageCheck =>
(CoverageCheck -> CoverageCheck -> Ordering)
-> (CoverageCheck -> CoverageCheck -> Bool)
-> (CoverageCheck -> CoverageCheck -> Bool)
-> (CoverageCheck -> CoverageCheck -> Bool)
-> (CoverageCheck -> CoverageCheck -> Bool)
-> (CoverageCheck -> CoverageCheck -> CoverageCheck)
-> (CoverageCheck -> CoverageCheck -> CoverageCheck)
-> Ord CoverageCheck
CoverageCheck -> CoverageCheck -> Bool
CoverageCheck -> CoverageCheck -> Ordering
CoverageCheck -> CoverageCheck -> CoverageCheck
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
$ccompare :: CoverageCheck -> CoverageCheck -> Ordering
compare :: CoverageCheck -> CoverageCheck -> Ordering
$c< :: CoverageCheck -> CoverageCheck -> Bool
< :: CoverageCheck -> CoverageCheck -> Bool
$c<= :: CoverageCheck -> CoverageCheck -> Bool
<= :: CoverageCheck -> CoverageCheck -> Bool
$c> :: CoverageCheck -> CoverageCheck -> Bool
> :: CoverageCheck -> CoverageCheck -> Bool
$c>= :: CoverageCheck -> CoverageCheck -> Bool
>= :: CoverageCheck -> CoverageCheck -> Bool
$cmax :: CoverageCheck -> CoverageCheck -> CoverageCheck
max :: CoverageCheck -> CoverageCheck -> CoverageCheck
$cmin :: CoverageCheck -> CoverageCheck -> CoverageCheck
min :: CoverageCheck -> CoverageCheck -> CoverageCheck
Ord, Int -> CoverageCheck -> ShowS
[CoverageCheck] -> ShowS
CoverageCheck -> String
(Int -> CoverageCheck -> ShowS)
-> (CoverageCheck -> String)
-> ([CoverageCheck] -> ShowS)
-> Show CoverageCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CoverageCheck -> ShowS
showsPrec :: Int -> CoverageCheck -> ShowS
$cshow :: CoverageCheck -> String
show :: CoverageCheck -> String
$cshowList :: [CoverageCheck] -> ShowS
showList :: [CoverageCheck] -> ShowS
Show, CoverageCheck
CoverageCheck -> CoverageCheck -> Bounded CoverageCheck
forall a. a -> a -> Bounded a
$cminBound :: CoverageCheck
minBound :: CoverageCheck
$cmaxBound :: CoverageCheck
maxBound :: CoverageCheck
Bounded, Int -> CoverageCheck
CoverageCheck -> Int
CoverageCheck -> [CoverageCheck]
CoverageCheck -> CoverageCheck
CoverageCheck -> CoverageCheck -> [CoverageCheck]
CoverageCheck -> CoverageCheck -> CoverageCheck -> [CoverageCheck]
(CoverageCheck -> CoverageCheck)
-> (CoverageCheck -> CoverageCheck)
-> (Int -> CoverageCheck)
-> (CoverageCheck -> Int)
-> (CoverageCheck -> [CoverageCheck])
-> (CoverageCheck -> CoverageCheck -> [CoverageCheck])
-> (CoverageCheck -> CoverageCheck -> [CoverageCheck])
-> (CoverageCheck
    -> CoverageCheck -> CoverageCheck -> [CoverageCheck])
-> Enum CoverageCheck
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CoverageCheck -> CoverageCheck
succ :: CoverageCheck -> CoverageCheck
$cpred :: CoverageCheck -> CoverageCheck
pred :: CoverageCheck -> CoverageCheck
$ctoEnum :: Int -> CoverageCheck
toEnum :: Int -> CoverageCheck
$cfromEnum :: CoverageCheck -> Int
fromEnum :: CoverageCheck -> Int
$cenumFrom :: CoverageCheck -> [CoverageCheck]
enumFrom :: CoverageCheck -> [CoverageCheck]
$cenumFromThen :: CoverageCheck -> CoverageCheck -> [CoverageCheck]
enumFromThen :: CoverageCheck -> CoverageCheck -> [CoverageCheck]
$cenumFromTo :: CoverageCheck -> CoverageCheck -> [CoverageCheck]
enumFromTo :: CoverageCheck -> CoverageCheck -> [CoverageCheck]
$cenumFromThenTo :: CoverageCheck -> CoverageCheck -> CoverageCheck -> [CoverageCheck]
enumFromThenTo :: CoverageCheck -> CoverageCheck -> CoverageCheck -> [CoverageCheck]
Enum, (forall x. CoverageCheck -> Rep CoverageCheck x)
-> (forall x. Rep CoverageCheck x -> CoverageCheck)
-> Generic CoverageCheck
forall x. Rep CoverageCheck x -> CoverageCheck
forall x. CoverageCheck -> Rep CoverageCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CoverageCheck -> Rep CoverageCheck x
from :: forall x. CoverageCheck -> Rep CoverageCheck x
$cto :: forall x. Rep CoverageCheck x -> CoverageCheck
to :: forall x. Rep CoverageCheck x -> CoverageCheck
Generic)

instance KillRange CoverageCheck where
  killRange :: CoverageCheck -> CoverageCheck
killRange = CoverageCheck -> CoverageCheck
forall a. a -> a
id

-- Semigroup and Monoid via conjunction
instance Semigroup CoverageCheck where
  CoverageCheck
NoCoverageCheck <> :: CoverageCheck -> CoverageCheck -> CoverageCheck
<> CoverageCheck
_ = CoverageCheck
NoCoverageCheck
  CoverageCheck
_ <> CoverageCheck
NoCoverageCheck = CoverageCheck
NoCoverageCheck
  CoverageCheck
_ <> CoverageCheck
_ = CoverageCheck
YesCoverageCheck

instance Monoid CoverageCheck where
  mempty :: CoverageCheck
mempty  = CoverageCheck
YesCoverageCheck
  mappend :: CoverageCheck -> CoverageCheck -> CoverageCheck
mappend = CoverageCheck -> CoverageCheck -> CoverageCheck
forall a. Semigroup a => a -> a -> a
(<>)

instance NFData CoverageCheck

-----------------------------------------------------------------------------
-- * Rewrite Directives on the LHS
-----------------------------------------------------------------------------

-- | @RewriteEqn' qn p e@ represents the @rewrite@ and irrefutable @with@
--   clauses of the LHS.
--   @qn@ stands for the QName of the auxiliary function generated to implement the feature
--   @nm@ is the type of names for pattern variables
--   @p@  is the type of patterns
--   @e@  is the type of expressions

data RewriteEqn' qn nm p e
  = Rewrite (List1 (qn, e))             -- ^ @rewrite e@
  | Invert qn (List1 (Named nm (p, e))) -- ^ @with p <- e in eq@
  | LeftLet (List1 (p, e))              -- ^ @using p <- e@
  deriving (RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool
(RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool)
-> (RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool)
-> Eq (RewriteEqn' qn nm p e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall qn nm p e.
(Eq e, Eq qn, Eq nm, Eq p) =>
RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool
$c== :: forall qn nm p e.
(Eq e, Eq qn, Eq nm, Eq p) =>
RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool
== :: RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool
$c/= :: forall qn nm p e.
(Eq e, Eq qn, Eq nm, Eq p) =>
RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool
/= :: RewriteEqn' qn nm p e -> RewriteEqn' qn nm p e -> Bool
Eq, Int -> RewriteEqn' qn nm p e -> ShowS
[RewriteEqn' qn nm p e] -> ShowS
RewriteEqn' qn nm p e -> String
(Int -> RewriteEqn' qn nm p e -> ShowS)
-> (RewriteEqn' qn nm p e -> String)
-> ([RewriteEqn' qn nm p e] -> ShowS)
-> Show (RewriteEqn' qn nm p e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall qn nm p e.
(Show e, Show qn, Show nm, Show p) =>
Int -> RewriteEqn' qn nm p e -> ShowS
forall qn nm p e.
(Show e, Show qn, Show nm, Show p) =>
[RewriteEqn' qn nm p e] -> ShowS
forall qn nm p e.
(Show e, Show qn, Show nm, Show p) =>
RewriteEqn' qn nm p e -> String
$cshowsPrec :: forall qn nm p e.
(Show e, Show qn, Show nm, Show p) =>
Int -> RewriteEqn' qn nm p e -> ShowS
showsPrec :: Int -> RewriteEqn' qn nm p e -> ShowS
$cshow :: forall qn nm p e.
(Show e, Show qn, Show nm, Show p) =>
RewriteEqn' qn nm p e -> String
show :: RewriteEqn' qn nm p e -> String
$cshowList :: forall qn nm p e.
(Show e, Show qn, Show nm, Show p) =>
[RewriteEqn' qn nm p e] -> ShowS
showList :: [RewriteEqn' qn nm p e] -> ShowS
Show, (forall a b.
 (a -> b) -> RewriteEqn' qn nm p a -> RewriteEqn' qn nm p b)
-> (forall a b.
    a -> RewriteEqn' qn nm p b -> RewriteEqn' qn nm p a)
-> Functor (RewriteEqn' qn nm p)
forall a b. a -> RewriteEqn' qn nm p b -> RewriteEqn' qn nm p a
forall a b.
(a -> b) -> RewriteEqn' qn nm p a -> RewriteEqn' qn nm p b
forall qn nm p a b.
a -> RewriteEqn' qn nm p b -> RewriteEqn' qn nm p a
forall qn nm p a b.
(a -> b) -> RewriteEqn' qn nm p a -> RewriteEqn' qn nm p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall qn nm p a b.
(a -> b) -> RewriteEqn' qn nm p a -> RewriteEqn' qn nm p b
fmap :: forall a b.
(a -> b) -> RewriteEqn' qn nm p a -> RewriteEqn' qn nm p b
$c<$ :: forall qn nm p a b.
a -> RewriteEqn' qn nm p b -> RewriteEqn' qn nm p a
<$ :: forall a b. a -> RewriteEqn' qn nm p b -> RewriteEqn' qn nm p a
Functor, (forall m. Monoid m => RewriteEqn' qn nm p m -> m)
-> (forall m a. Monoid m => (a -> m) -> RewriteEqn' qn nm p a -> m)
-> (forall m a. Monoid m => (a -> m) -> RewriteEqn' qn nm p a -> m)
-> (forall a b. (a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b)
-> (forall a b. (a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b)
-> (forall b a. (b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b)
-> (forall b a. (b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b)
-> (forall a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a)
-> (forall a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a)
-> (forall a. RewriteEqn' qn nm p a -> [a])
-> (forall a. RewriteEqn' qn nm p a -> Bool)
-> (forall a. RewriteEqn' qn nm p a -> Int)
-> (forall a. Eq a => a -> RewriteEqn' qn nm p a -> Bool)
-> (forall a. Ord a => RewriteEqn' qn nm p a -> a)
-> (forall a. Ord a => RewriteEqn' qn nm p a -> a)
-> (forall a. Num a => RewriteEqn' qn nm p a -> a)
-> (forall a. Num a => RewriteEqn' qn nm p a -> a)
-> Foldable (RewriteEqn' qn nm p)
forall a. Eq a => a -> RewriteEqn' qn nm p a -> Bool
forall a. Num a => RewriteEqn' qn nm p a -> a
forall a. Ord a => RewriteEqn' qn nm p a -> a
forall m. Monoid m => RewriteEqn' qn nm p m -> m
forall a. RewriteEqn' qn nm p a -> Bool
forall a. RewriteEqn' qn nm p a -> Int
forall a. RewriteEqn' qn nm p a -> [a]
forall a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a
forall m a. Monoid m => (a -> m) -> RewriteEqn' qn nm p a -> m
forall b a. (b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b
forall a b. (a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b
forall qn nm p a. Eq a => a -> RewriteEqn' qn nm p a -> Bool
forall qn nm p a. Num a => RewriteEqn' qn nm p a -> a
forall qn nm p a. Ord a => RewriteEqn' qn nm p a -> a
forall qn nm p m. Monoid m => RewriteEqn' qn nm p m -> m
forall qn nm p a. RewriteEqn' qn nm p a -> Bool
forall qn nm p a. RewriteEqn' qn nm p a -> Int
forall qn nm p a. RewriteEqn' qn nm p a -> [a]
forall qn nm p a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a
forall qn nm p m a.
Monoid m =>
(a -> m) -> RewriteEqn' qn nm p a -> m
forall qn nm p b a.
(b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b
forall qn nm p a b.
(a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall qn nm p m. Monoid m => RewriteEqn' qn nm p m -> m
fold :: forall m. Monoid m => RewriteEqn' qn nm p m -> m
$cfoldMap :: forall qn nm p m a.
Monoid m =>
(a -> m) -> RewriteEqn' qn nm p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RewriteEqn' qn nm p a -> m
$cfoldMap' :: forall qn nm p m a.
Monoid m =>
(a -> m) -> RewriteEqn' qn nm p a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RewriteEqn' qn nm p a -> m
$cfoldr :: forall qn nm p a b.
(a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b
$cfoldr' :: forall qn nm p a b.
(a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RewriteEqn' qn nm p a -> b
$cfoldl :: forall qn nm p b a.
(b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b
$cfoldl' :: forall qn nm p b a.
(b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RewriteEqn' qn nm p a -> b
$cfoldr1 :: forall qn nm p a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a
foldr1 :: forall a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a
$cfoldl1 :: forall qn nm p a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a
foldl1 :: forall a. (a -> a -> a) -> RewriteEqn' qn nm p a -> a
$ctoList :: forall qn nm p a. RewriteEqn' qn nm p a -> [a]
toList :: forall a. RewriteEqn' qn nm p a -> [a]
$cnull :: forall qn nm p a. RewriteEqn' qn nm p a -> Bool
null :: forall a. RewriteEqn' qn nm p a -> Bool
$clength :: forall qn nm p a. RewriteEqn' qn nm p a -> Int
length :: forall a. RewriteEqn' qn nm p a -> Int
$celem :: forall qn nm p a. Eq a => a -> RewriteEqn' qn nm p a -> Bool
elem :: forall a. Eq a => a -> RewriteEqn' qn nm p a -> Bool
$cmaximum :: forall qn nm p a. Ord a => RewriteEqn' qn nm p a -> a
maximum :: forall a. Ord a => RewriteEqn' qn nm p a -> a
$cminimum :: forall qn nm p a. Ord a => RewriteEqn' qn nm p a -> a
minimum :: forall a. Ord a => RewriteEqn' qn nm p a -> a
$csum :: forall qn nm p a. Num a => RewriteEqn' qn nm p a -> a
sum :: forall a. Num a => RewriteEqn' qn nm p a -> a
$cproduct :: forall qn nm p a. Num a => RewriteEqn' qn nm p a -> a
product :: forall a. Num a => RewriteEqn' qn nm p a -> a
Foldable, Functor (RewriteEqn' qn nm p)
Foldable (RewriteEqn' qn nm p)
(Functor (RewriteEqn' qn nm p), Foldable (RewriteEqn' qn nm p)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> RewriteEqn' qn nm p a -> f (RewriteEqn' qn nm p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RewriteEqn' qn nm p (f a) -> f (RewriteEqn' qn nm p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RewriteEqn' qn nm p a -> m (RewriteEqn' qn nm p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RewriteEqn' qn nm p (m a) -> m (RewriteEqn' qn nm p a))
-> Traversable (RewriteEqn' qn nm p)
forall qn nm p. Functor (RewriteEqn' qn nm p)
forall qn nm p. Foldable (RewriteEqn' qn nm p)
forall qn nm p (m :: * -> *) a.
Monad m =>
RewriteEqn' qn nm p (m a) -> m (RewriteEqn' qn nm p a)
forall qn nm p (f :: * -> *) a.
Applicative f =>
RewriteEqn' qn nm p (f a) -> f (RewriteEqn' qn nm p a)
forall qn nm p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RewriteEqn' qn nm p a -> m (RewriteEqn' qn nm p b)
forall qn nm p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RewriteEqn' qn nm p a -> f (RewriteEqn' qn nm p b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
RewriteEqn' qn nm p (m a) -> m (RewriteEqn' qn nm p a)
forall (f :: * -> *) a.
Applicative f =>
RewriteEqn' qn nm p (f a) -> f (RewriteEqn' qn nm p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RewriteEqn' qn nm p a -> m (RewriteEqn' qn nm p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RewriteEqn' qn nm p a -> f (RewriteEqn' qn nm p b)
$ctraverse :: forall qn nm p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RewriteEqn' qn nm p a -> f (RewriteEqn' qn nm p b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RewriteEqn' qn nm p a -> f (RewriteEqn' qn nm p b)
$csequenceA :: forall qn nm p (f :: * -> *) a.
Applicative f =>
RewriteEqn' qn nm p (f a) -> f (RewriteEqn' qn nm p a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RewriteEqn' qn nm p (f a) -> f (RewriteEqn' qn nm p a)
$cmapM :: forall qn nm p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RewriteEqn' qn nm p a -> m (RewriteEqn' qn nm p b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RewriteEqn' qn nm p a -> m (RewriteEqn' qn nm p b)
$csequence :: forall qn nm p (m :: * -> *) a.
Monad m =>
RewriteEqn' qn nm p (m a) -> m (RewriteEqn' qn nm p a)
sequence :: forall (m :: * -> *) a.
Monad m =>
RewriteEqn' qn nm p (m a) -> m (RewriteEqn' qn nm p a)
Traversable)

instance (NFData qn, NFData nm, NFData p, NFData e) => NFData (RewriteEqn' qn nm p e) where
  rnf :: RewriteEqn' qn nm p e -> ()
rnf = \case
    Rewrite List1 (qn, e)
es    -> List1 (qn, e) -> ()
forall a. NFData a => a -> ()
rnf List1 (qn, e)
es
    Invert qn
qn List1 (Named nm (p, e))
pes -> (qn, List1 (Named nm (p, e))) -> ()
forall a. NFData a => a -> ()
rnf (qn
qn, List1 (Named nm (p, e))
pes)
    LeftLet List1 (p, e)
pes   -> List1 (p, e) -> ()
forall a. NFData a => a -> ()
rnf List1 (p, e)
pes

instance (Pretty nm, Pretty p, Pretty e) => Pretty (RewriteEqn' qn nm p e) where
  pretty :: RewriteEqn' qn nm p e -> Doc
pretty = \case
    Rewrite List1 (qn, e)
es   -> Doc -> [Doc] -> Doc
prefixedThings (String -> Doc
forall a. String -> Doc a
text String
"rewrite") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ NonEmpty Doc -> [Item (NonEmpty Doc)]
forall l. IsList l => l -> [Item l]
List1.toList (e -> Doc
forall a. Pretty a => a -> Doc
pretty (e -> Doc) -> ((qn, e) -> e) -> (qn, e) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (qn, e) -> e
forall a b. (a, b) -> b
snd ((qn, e) -> Doc) -> List1 (qn, e) -> NonEmpty Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List1 (qn, e)
es)
    LeftLet List1 (p, e)
pes  -> Doc -> [Doc] -> Doc
prefixedThings (String -> Doc
forall a. String -> Doc a
text String
"using") [p -> Doc
forall a. Pretty a => a -> Doc
pretty p
p Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc
"<-" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> e -> Doc
forall a. Pretty a => a -> Doc
pretty e
e | (p
p, e
e) <- List1 (p, e) -> [Item (List1 (p, e))]
forall l. IsList l => l -> [Item l]
List1.toList List1 (p, e)
pes]
    Invert qn
_ List1 (Named nm (p, e))
pes -> Doc -> [Doc] -> Doc
prefixedThings (String -> Doc
forall a. String -> Doc a
text String
"invert") ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ NonEmpty Doc -> [Item (NonEmpty Doc)]
forall l. IsList l => l -> [Item l]
List1.toList (Named nm (p, e) -> Doc
forall {a} {a} {a}.
(Pretty a, Pretty a, Pretty a) =>
Named a (a, a) -> Doc
namedWith (Named nm (p, e) -> Doc) -> List1 (Named nm (p, e)) -> NonEmpty Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List1 (Named nm (p, e))
pes) where

      namedWith :: Named a (a, a) -> Doc
namedWith (Named Maybe a
nm (a
p, a
e)) =
        let patexp :: Doc
patexp = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
p Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc
"<-" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
e in
        case Maybe a
nm of
          Maybe a
Nothing -> Doc
patexp
          Just a
nm -> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
nm Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc
":" Doc -> Doc -> Doc
forall a. Doc a -> Doc a -> Doc a
<+> Doc
patexp

instance (HasRange qn, HasRange p, HasRange e) => HasRange (RewriteEqn' qn nm p e) where
  getRange :: RewriteEqn' qn nm p e -> Range
getRange = \case
    Rewrite List1 (qn, e)
es    -> List1 (qn, e) -> Range
forall a. HasRange a => a -> Range
getRange List1 (qn, e)
es
    Invert qn
qn List1 (Named nm (p, e))
pes -> (qn, List1 (Named nm (p, e))) -> Range
forall a. HasRange a => a -> Range
getRange (qn
qn, List1 (Named nm (p, e))
pes)
    LeftLet List1 (p, e)
pes   -> List1 (p, e) -> Range
forall a. HasRange a => a -> Range
getRange List1 (p, e)
pes

instance (KillRange qn, KillRange nm, KillRange e, KillRange p) => KillRange (RewriteEqn' qn nm p e) where
  killRange :: KillRangeT (RewriteEqn' qn nm p e)
killRange = \case
    Rewrite List1 (qn, e)
es    -> (List1 (qn, e) -> RewriteEqn' qn nm p e)
-> List1 (qn, e) -> RewriteEqn' qn nm p e
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN List1 (qn, e) -> RewriteEqn' qn nm p e
forall qn nm p e. List1 (qn, e) -> RewriteEqn' qn nm p e
Rewrite List1 (qn, e)
es
    Invert qn
qn List1 (Named nm (p, e))
pes -> (qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e)
-> qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e
forall qn nm p e.
qn -> List1 (Named nm (p, e)) -> RewriteEqn' qn nm p e
Invert qn
qn List1 (Named nm (p, e))
pes
    LeftLet List1 (p, e)
pes   -> (List1 (p, e) -> RewriteEqn' qn nm p e)
-> List1 (p, e) -> RewriteEqn' qn nm p e
forall t (b :: Bool).
(KILLRANGE t b, IsBase t ~ b, All KillRange (Domains t)) =>
t -> t
killRangeN List1 (p, e) -> RewriteEqn' qn nm p e
forall qn nm p e. List1 (p, e) -> RewriteEqn' qn nm p e
LeftLet List1 (p, e)
pes

-----------------------------------------------------------------------------
-- * Information on expanded ellipsis (@...@)
-----------------------------------------------------------------------------

-- ^ When the ellipsis in a clause is expanded, we remember that we
--   did so. We also store the number of with-arguments that are
--   included in the expanded ellipsis.
data ExpandedEllipsis
  = ExpandedEllipsis
  { ExpandedEllipsis -> Range
ellipsisRange :: Range
  , ExpandedEllipsis -> Int
ellipsisWithArgs :: Int
  }
  | NoEllipsis
  deriving (Int -> ExpandedEllipsis -> ShowS
[ExpandedEllipsis] -> ShowS
ExpandedEllipsis -> String
(Int -> ExpandedEllipsis -> ShowS)
-> (ExpandedEllipsis -> String)
-> ([ExpandedEllipsis] -> ShowS)
-> Show ExpandedEllipsis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpandedEllipsis -> ShowS
showsPrec :: Int -> ExpandedEllipsis -> ShowS
$cshow :: ExpandedEllipsis -> String
show :: ExpandedEllipsis -> String
$cshowList :: [ExpandedEllipsis] -> ShowS
showList :: [ExpandedEllipsis] -> ShowS
Show, ExpandedEllipsis -> ExpandedEllipsis -> Bool
(ExpandedEllipsis -> ExpandedEllipsis -> Bool)
-> (ExpandedEllipsis -> ExpandedEllipsis -> Bool)
-> Eq ExpandedEllipsis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpandedEllipsis -> ExpandedEllipsis -> Bool
== :: ExpandedEllipsis -> ExpandedEllipsis -> Bool
$c/= :: ExpandedEllipsis -> ExpandedEllipsis -> Bool
/= :: ExpandedEllipsis -> ExpandedEllipsis -> Bool
Eq)

instance Null ExpandedEllipsis where
  empty :: ExpandedEllipsis
empty = ExpandedEllipsis
NoEllipsis

instance Semigroup ExpandedEllipsis where
  ExpandedEllipsis
NoEllipsis <> :: ExpandedEllipsis -> ExpandedEllipsis -> ExpandedEllipsis
<> ExpandedEllipsis
e          = ExpandedEllipsis
e
  ExpandedEllipsis
e          <> ExpandedEllipsis
NoEllipsis = ExpandedEllipsis
e
  (ExpandedEllipsis Range
r1 Int
k1) <> (ExpandedEllipsis Range
r2 Int
k2) = Range -> Int -> ExpandedEllipsis
ExpandedEllipsis (Range
r1 Range -> Range -> Range
forall a. Semigroup a => a -> a -> a
<> Range
r2) (Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k2)

instance Monoid ExpandedEllipsis where
  mempty :: ExpandedEllipsis
mempty  = ExpandedEllipsis
NoEllipsis
  mappend :: ExpandedEllipsis -> ExpandedEllipsis -> ExpandedEllipsis
mappend = ExpandedEllipsis -> ExpandedEllipsis -> ExpandedEllipsis
forall a. Semigroup a => a -> a -> a
(<>)

instance KillRange ExpandedEllipsis where
  killRange :: ExpandedEllipsis -> ExpandedEllipsis
killRange (ExpandedEllipsis Range
_ Int
k) = Range -> Int -> ExpandedEllipsis
ExpandedEllipsis Range
forall a. Range' a
noRange Int
k
  killRange ExpandedEllipsis
NoEllipsis             = ExpandedEllipsis
NoEllipsis

instance NFData ExpandedEllipsis where
  rnf :: ExpandedEllipsis -> ()
rnf (ExpandedEllipsis Range
_ Int
a) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
a
  rnf ExpandedEllipsis
NoEllipsis             = ()

-- | Notation as provided by the @syntax@ declaration.
type Notation = [NotationPart]

noNotation :: Notation
noNotation :: Notation
noNotation = []

-- | Positions of variables in syntax declarations.

data BoundVariablePosition = BoundVariablePosition
  { BoundVariablePosition -> Int
holeNumber :: !Int
    -- ^ The position (in the left-hand side of the syntax
    -- declaration) of the hole in which the variable is bound,
    -- counting from zero (and excluding parts that are not holes).
    -- For instance, for @syntax Σ A (λ x → B) = B , A , x@ the number
    -- for @x@ is @1@, corresponding to @B@ (@0@ would correspond to
    -- @A@).
  , BoundVariablePosition -> Int
varNumber :: !Int
    -- ^ The position in the list of variables for this particular
    -- variable, counting from zero, and including wildcards. For
    -- instance, for @syntax F (λ x _ y → A) = y ! A ! x@ the number
    -- for @x@ is @0@, the number for @_@ is @1@, and the number for
    -- @y@ is @2@.
  }
  deriving (BoundVariablePosition -> BoundVariablePosition -> Bool
(BoundVariablePosition -> BoundVariablePosition -> Bool)
-> (BoundVariablePosition -> BoundVariablePosition -> Bool)
-> Eq BoundVariablePosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundVariablePosition -> BoundVariablePosition -> Bool
== :: BoundVariablePosition -> BoundVariablePosition -> Bool
$c/= :: BoundVariablePosition -> BoundVariablePosition -> Bool
/= :: BoundVariablePosition -> BoundVariablePosition -> Bool
Eq, Eq BoundVariablePosition
Eq BoundVariablePosition =>
(BoundVariablePosition -> BoundVariablePosition -> Ordering)
-> (BoundVariablePosition -> BoundVariablePosition -> Bool)
-> (BoundVariablePosition -> BoundVariablePosition -> Bool)
-> (BoundVariablePosition -> BoundVariablePosition -> Bool)
-> (BoundVariablePosition -> BoundVariablePosition -> Bool)
-> (BoundVariablePosition
    -> BoundVariablePosition -> BoundVariablePosition)
-> (BoundVariablePosition
    -> BoundVariablePosition -> BoundVariablePosition)
-> Ord BoundVariablePosition
BoundVariablePosition -> BoundVariablePosition -> Bool
BoundVariablePosition -> BoundVariablePosition -> Ordering
BoundVariablePosition
-> BoundVariablePosition -> BoundVariablePosition
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
$ccompare :: BoundVariablePosition -> BoundVariablePosition -> Ordering
compare :: BoundVariablePosition -> BoundVariablePosition -> Ordering
$c< :: BoundVariablePosition -> BoundVariablePosition -> Bool
< :: BoundVariablePosition -> BoundVariablePosition -> Bool
$c<= :: BoundVariablePosition -> BoundVariablePosition -> Bool
<= :: BoundVariablePosition -> BoundVariablePosition -> Bool
$c> :: BoundVariablePosition -> BoundVariablePosition -> Bool
> :: BoundVariablePosition -> BoundVariablePosition -> Bool
$c>= :: BoundVariablePosition -> BoundVariablePosition -> Bool
>= :: BoundVariablePosition -> BoundVariablePosition -> Bool
$cmax :: BoundVariablePosition
-> BoundVariablePosition -> BoundVariablePosition
max :: BoundVariablePosition
-> BoundVariablePosition -> BoundVariablePosition
$cmin :: BoundVariablePosition
-> BoundVariablePosition -> BoundVariablePosition
min :: BoundVariablePosition
-> BoundVariablePosition -> BoundVariablePosition
Ord, Int -> BoundVariablePosition -> ShowS
[BoundVariablePosition] -> ShowS
BoundVariablePosition -> String
(Int -> BoundVariablePosition -> ShowS)
-> (BoundVariablePosition -> String)
-> ([BoundVariablePosition] -> ShowS)
-> Show BoundVariablePosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundVariablePosition -> ShowS
showsPrec :: Int -> BoundVariablePosition -> ShowS
$cshow :: BoundVariablePosition -> String
show :: BoundVariablePosition -> String
$cshowList :: [BoundVariablePosition] -> ShowS
showList :: [BoundVariablePosition] -> ShowS
Show)

-- | Notation parts.

data NotationPart
  = IdPart RString
    -- ^ An identifier part. For instance, for @_+_@ the only
    -- identifier part is @+@.
  | HolePart Range (NamedArg (Ranged Int))
    -- ^ A hole: a place where argument expressions can be written.
    -- For instance, for @_+_@ the two underscores are holes, and for
    -- @syntax Σ A (λ x → B) = B , A , x@ the variables @A@ and @B@
    -- are holes. The number is the position of the hole, counting
    -- from zero. For instance, the number for @A@ is @0@, and the
    -- number for @B@ is @1@.
  | VarPart Range (Ranged BoundVariablePosition)
    -- ^ A bound variable.
    --
    -- The first range is the range of the variable in the right-hand
    -- side of the syntax declaration, and the second range is the
    -- range of the variable in the left-hand side.
  | WildPart (Ranged BoundVariablePosition)
    -- ^ A wildcard (an underscore in binding position).
  deriving Int -> NotationPart -> ShowS
Notation -> ShowS
NotationPart -> String
(Int -> NotationPart -> ShowS)
-> (NotationPart -> String)
-> (Notation -> ShowS)
-> Show NotationPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotationPart -> ShowS
showsPrec :: Int -> NotationPart -> ShowS
$cshow :: NotationPart -> String
show :: NotationPart -> String
$cshowList :: Notation -> ShowS
showList :: Notation -> ShowS
Show

instance Eq NotationPart where
  VarPart Range
_ Ranged BoundVariablePosition
i  == :: NotationPart -> NotationPart -> Bool
== VarPart Range
_ Ranged BoundVariablePosition
j  = Ranged BoundVariablePosition
i Ranged BoundVariablePosition
-> Ranged BoundVariablePosition -> Bool
forall a. Eq a => a -> a -> Bool
== Ranged BoundVariablePosition
j
  HolePart Range
_ NamedArg (Ranged Int)
x == HolePart Range
_ NamedArg (Ranged Int)
y = NamedArg (Ranged Int)
x NamedArg (Ranged Int) -> NamedArg (Ranged Int) -> Bool
forall a. Eq a => a -> a -> Bool
== NamedArg (Ranged Int)
y
  WildPart Ranged BoundVariablePosition
i   == WildPart Ranged BoundVariablePosition
j   = Ranged BoundVariablePosition
i Ranged BoundVariablePosition
-> Ranged BoundVariablePosition -> Bool
forall a. Eq a => a -> a -> Bool
== Ranged BoundVariablePosition
j
  IdPart Ranged ArgName
x     == IdPart Ranged ArgName
y     = Ranged ArgName
x Ranged ArgName -> Ranged ArgName -> Bool
forall a. Eq a => a -> a -> Bool
== Ranged ArgName
y
  NotationPart
_            == NotationPart
_            = Bool
False

instance Ord NotationPart where
  VarPart Range
_ Ranged BoundVariablePosition
i  compare :: NotationPart -> NotationPart -> Ordering
`compare` VarPart Range
_ Ranged BoundVariablePosition
j  = Ranged BoundVariablePosition
i Ranged BoundVariablePosition
-> Ranged BoundVariablePosition -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Ranged BoundVariablePosition
j
  HolePart Range
_ NamedArg (Ranged Int)
x `compare` HolePart Range
_ NamedArg (Ranged Int)
y = NamedArg (Ranged Int)
x NamedArg (Ranged Int) -> NamedArg (Ranged Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` NamedArg (Ranged Int)
y
  WildPart Ranged BoundVariablePosition
i   `compare` WildPart Ranged BoundVariablePosition
j   = Ranged BoundVariablePosition
i Ranged BoundVariablePosition
-> Ranged BoundVariablePosition -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Ranged BoundVariablePosition
j
  IdPart Ranged ArgName
x     `compare` IdPart Ranged ArgName
y     = Ranged ArgName
x Ranged ArgName -> Ranged ArgName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Ranged ArgName
y
  VarPart{}    `compare` NotationPart
_            = Ordering
LT
  NotationPart
_            `compare` VarPart{}    = Ordering
GT
  HolePart{}   `compare` NotationPart
_            = Ordering
LT
  NotationPart
_            `compare` HolePart{}   = Ordering
GT
  WildPart{}   `compare` NotationPart
_            = Ordering
LT
  NotationPart
_            `compare` WildPart{}   = Ordering
GT

instance HasRange NotationPart where
  getRange :: NotationPart -> Range
getRange = \case
    IdPart Ranged ArgName
x     -> Ranged ArgName -> Range
forall a. HasRange a => a -> Range
getRange Ranged ArgName
x
    VarPart Range
r Ranged BoundVariablePosition
_  -> Range
r
    WildPart Ranged BoundVariablePosition
i   -> Ranged BoundVariablePosition -> Range
forall a. HasRange a => a -> Range
getRange Ranged BoundVariablePosition
i
    HolePart Range
r NamedArg (Ranged Int)
_ -> Range
r

instance SetRange NotationPart where
  setRange :: Range -> NotationPart -> NotationPart
setRange Range
r = \case
    IdPart Ranged ArgName
x     -> Ranged ArgName -> NotationPart
IdPart Ranged ArgName
x
    VarPart Range
_ Ranged BoundVariablePosition
i  -> Range -> Ranged BoundVariablePosition -> NotationPart
VarPart Range
r Ranged BoundVariablePosition
i
    WildPart Ranged BoundVariablePosition
i   -> Ranged BoundVariablePosition -> NotationPart
WildPart Ranged BoundVariablePosition
i
    HolePart Range
_ NamedArg (Ranged Int)
i -> Range -> NamedArg (Ranged Int) -> NotationPart
HolePart Range
r NamedArg (Ranged Int)
i

instance KillRange NotationPart where
  killRange :: NotationPart -> NotationPart
killRange = \case
    IdPart Ranged ArgName
x     -> Ranged ArgName -> NotationPart
IdPart (Ranged ArgName -> NotationPart) -> Ranged ArgName -> NotationPart
forall a b. (a -> b) -> a -> b
$ KillRangeT (Ranged ArgName)
forall a. KillRange a => KillRangeT a
killRange Ranged ArgName
x
    VarPart Range
_ Ranged BoundVariablePosition
i  -> Range -> Ranged BoundVariablePosition -> NotationPart
VarPart Range
forall a. Range' a
noRange (Ranged BoundVariablePosition -> NotationPart)
-> Ranged BoundVariablePosition -> NotationPart
forall a b. (a -> b) -> a -> b
$ KillRangeT (Ranged BoundVariablePosition)
forall a. KillRange a => KillRangeT a
killRange Ranged BoundVariablePosition
i
    WildPart Ranged BoundVariablePosition
i   -> Ranged BoundVariablePosition -> NotationPart
WildPart (Ranged BoundVariablePosition -> NotationPart)
-> Ranged BoundVariablePosition -> NotationPart
forall a b. (a -> b) -> a -> b
$ KillRangeT (Ranged BoundVariablePosition)
forall a. KillRange a => KillRangeT a
killRange Ranged BoundVariablePosition
i
    HolePart Range
_ NamedArg (Ranged Int)
x -> Range -> NamedArg (Ranged Int) -> NotationPart
HolePart Range
forall a. Range' a
noRange (NamedArg (Ranged Int) -> NotationPart)
-> NamedArg (Ranged Int) -> NotationPart
forall a b. (a -> b) -> a -> b
$ KillRangeT (NamedArg (Ranged Int))
forall a. KillRange a => KillRangeT a
killRange NamedArg (Ranged Int)
x

instance NFData BoundVariablePosition where
  rnf :: BoundVariablePosition -> ()
rnf = (BoundVariablePosition -> () -> ()
forall a b. a -> b -> b
`seq` ())

instance NFData NotationPart where
  rnf :: NotationPart -> ()
rnf (VarPart Range
_ Ranged BoundVariablePosition
a)  = Ranged BoundVariablePosition -> ()
forall a. NFData a => a -> ()
rnf Ranged BoundVariablePosition
a
  rnf (HolePart Range
_ NamedArg (Ranged Int)
a) = NamedArg (Ranged Int) -> ()
forall a. NFData a => a -> ()
rnf NamedArg (Ranged Int)
a
  rnf (WildPart Ranged BoundVariablePosition
a)   = Ranged BoundVariablePosition -> ()
forall a. NFData a => a -> ()
rnf Ranged BoundVariablePosition
a
  rnf (IdPart Ranged ArgName
a)     = Ranged ArgName -> ()
forall a. NFData a => a -> ()
rnf Ranged ArgName
a

instance Pretty NotationPart where
    pretty :: NotationPart -> Doc
pretty (IdPart Ranged ArgName
x) = ArgName -> Doc
forall a. Pretty a => a -> Doc
pretty (ArgName -> Doc) -> ArgName -> Doc
forall a b. (a -> b) -> a -> b
$ Ranged ArgName -> ArgName
forall a. Ranged a -> a
rangedThing Ranged ArgName
x
    pretty HolePart{} = Doc
forall a. Underscore a => a
underscore
    pretty VarPart{}  = Doc
forall a. Underscore a => a
underscore
    pretty WildPart{} = Doc
forall a. Underscore a => a
underscore

    prettyList :: Notation -> Doc
prettyList = [Doc] -> Doc
forall (t :: * -> *). Foldable t => t Doc -> Doc
hcat ([Doc] -> Doc) -> (Notation -> [Doc]) -> Notation -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NotationPart -> Doc) -> Notation -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map NotationPart -> Doc
forall a. Pretty a => a -> Doc
pretty