{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Inferno.Types.Syntax
  ( Ident (..),
    ExtIdent (..),
    ImplExpl (..),
    Import (..),
    ModuleName (..),
    InfixFixity (..),
    Fixity (..),
    Comment (..),
    IStr (..),
    OpsTable,
    SomeIStr (..),
    toEitherList,
    fromEitherList,
    Lit (..),
    Pat (..),
    PatF (..),
    TV (..),
    BaseType (..),
    InfernoType (..),
    Expr
      ( ..,
        Var_,
        OpVar_,
        TypeRep_,
        Enum_,
        App_,
        Lam_,
        Let_,
        Lit_,
        InterpolatedString_,
        If_,
        Op_,
        PreOp_,
        Tuple_,
        One_,
        Empty_,
        Assert_,
        Case_,
        Array_,
        ArrayComp_,
        Bracketed_,
        RenameModule_,
        OpenModule_
      ),
    BlockUtils (..),
    ElementPosition (..),
    TList (..),
    SigVar (..),
    SourcePos (..),
    Scoped (..),
    Dependencies (..),
    arbitraryName,
    collectArrs,
    extractArgsAndPrettyPrint,
    tListToList,
    tListFromList,
    sigVarToIdent,
    sigVarToExpr,
    patternToExpr,
    incSourceCol,
    fromScoped,
    rws,
    punctuate',
    hideInternalIdents,
    substInternalIdents,
    getIdentifierPositions,
  )
where

import Control.Applicative (liftA, liftA2, liftA3)
import Control.DeepSeq (NFData (..))
import Control.Monad (replicateM)
import Data.Aeson (FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (FromJSONKeyTextParser), ToJSON (..), ToJSONKey (..))
import Data.Aeson.Types (toJSONKeyText)
import Data.Bifunctor.TH (deriveBifunctor)
import Data.Data (Constr, Data (..), Typeable, gcast1, mkConstr, mkDataType)
import qualified Data.Data as Data
import Data.Functor.Foldable (ana, cata, project)
import Data.Functor.Foldable.TH (makeBaseFunctor)
import Data.Hashable (Hashable (hashWithSalt))
import Data.Int (Int64)
import qualified Data.IntMap as IntMap
import Data.List.NonEmpty (NonEmpty ((:|)), toList)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Serialize (Serialize)
import qualified Data.Serialize as Serialize
import qualified Data.Set as Set
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Word (Word64)
import GHC.Generics (Generic)
import Inferno.Utils.Prettyprinter (renderPretty)
import Numeric (showHex)
import Prettyprinter
  ( Doc,
    Pretty (pretty),
    align,
    concatWith,
    enclose,
    flatAlt,
    group,
    hardline,
    indent,
    lbracket,
    line,
    line',
    lparen,
    nest,
    rbracket,
    rparen,
    sep,
    vsep,
    (<+>),
  )
import qualified Prettyprinter.Internal as Pretty
import Test.QuickCheck (Arbitrary (..), Gen, elements, listOf, oneof, recursivelyShrink, shrinkNothing, sized, suchThat)
import Test.QuickCheck.Arbitrary.ADT (ToADTArbitrary)
import Test.QuickCheck.Instances.Text ()
import Text.Megaparsec (Pos, SourcePos (..), mkPos, unPos)
import Text.Read (readMaybe)

newtype TV = TV {TV -> Int
unTV :: Int}
  deriving stock (TV -> TV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TV -> TV -> Bool
$c/= :: TV -> TV -> Bool
== :: TV -> TV -> Bool
$c== :: TV -> TV -> Bool
Eq, Eq TV
TV -> TV -> Bool
TV -> TV -> Ordering
TV -> TV -> TV
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TV -> TV -> TV
$cmin :: TV -> TV -> TV
max :: TV -> TV -> TV
$cmax :: TV -> TV -> TV
>= :: TV -> TV -> Bool
$c>= :: TV -> TV -> Bool
> :: TV -> TV -> Bool
$c> :: TV -> TV -> Bool
<= :: TV -> TV -> Bool
$c<= :: TV -> TV -> Bool
< :: TV -> TV -> Bool
$c< :: TV -> TV -> Bool
compare :: TV -> TV -> Ordering
$ccompare :: TV -> TV -> Ordering
Ord, Int -> TV -> ShowS
[TV] -> ShowS
TV -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TV] -> ShowS
$cshowList :: [TV] -> ShowS
show :: TV -> FilePath
$cshow :: TV -> FilePath
showsPrec :: Int -> TV -> ShowS
$cshowsPrec :: Int -> TV -> ShowS
Show, Typeable TV
TV -> DataType
TV -> Constr
(forall b. Data b => b -> b) -> TV -> TV
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TV -> u
forall u. (forall d. Data d => d -> u) -> TV -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TV -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TV -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TV -> m TV
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TV -> m TV
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TV
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TV -> c TV
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TV)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TV)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TV -> m TV
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TV -> m TV
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TV -> m TV
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TV -> m TV
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TV -> m TV
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TV -> m TV
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TV -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TV -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TV -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TV -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TV -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TV -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TV -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TV -> r
gmapT :: (forall b. Data b => b -> b) -> TV -> TV
$cgmapT :: (forall b. Data b => b -> b) -> TV -> TV
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TV)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TV)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TV)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TV)
dataTypeOf :: TV -> DataType
$cdataTypeOf :: TV -> DataType
toConstr :: TV -> Constr
$ctoConstr :: TV -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TV
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TV
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TV -> c TV
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TV -> c TV
Data, forall x. Rep TV x -> TV
forall x. TV -> Rep TV x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TV x -> TV
$cfrom :: forall x. TV -> Rep TV x
Generic)
  deriving newtype ([TV] -> Encoding
[TV] -> Value
TV -> Encoding
TV -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TV] -> Encoding
$ctoEncodingList :: [TV] -> Encoding
toJSONList :: [TV] -> Value
$ctoJSONList :: [TV] -> Value
toEncoding :: TV -> Encoding
$ctoEncoding :: TV -> Encoding
toJSON :: TV -> Value
$ctoJSON :: TV -> Value
ToJSON, Value -> Parser [TV]
Value -> Parser TV
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TV]
$cparseJSONList :: Value -> Parser [TV]
parseJSON :: Value -> Parser TV
$cparseJSON :: Value -> Parser TV
FromJSON, ToJSONKeyFunction [TV]
ToJSONKeyFunction TV
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [TV]
$ctoJSONKeyList :: ToJSONKeyFunction [TV]
toJSONKey :: ToJSONKeyFunction TV
$ctoJSONKey :: ToJSONKeyFunction TV
ToJSONKey, FromJSONKeyFunction [TV]
FromJSONKeyFunction TV
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [TV]
$cfromJSONKeyList :: FromJSONKeyFunction [TV]
fromJSONKey :: FromJSONKeyFunction TV
$cfromJSONKey :: FromJSONKeyFunction TV
FromJSONKey, TV -> ()
forall a. (a -> ()) -> NFData a
rnf :: TV -> ()
$crnf :: TV -> ()
NFData, Eq TV
Int -> TV -> Int
TV -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TV -> Int
$chash :: TV -> Int
hashWithSalt :: Int -> TV -> Int
$chashWithSalt :: Int -> TV -> Int
Hashable, Gen TV
TV -> [TV]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: TV -> [TV]
$cshrink :: TV -> [TV]
arbitrary :: Gen TV
$carbitrary :: Gen TV
Arbitrary, Get TV
Putter TV
forall t. Putter t -> Get t -> Serialize t
get :: Get TV
$cget :: Get TV
put :: Putter TV
$cput :: Putter TV
Serialize)
  deriving anyclass (Proxy TV -> Gen (ADTArbitrarySingleton TV)
Proxy TV -> Gen (ADTArbitrary TV)
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy TV -> Gen (ADTArbitrary TV)
$ctoADTArbitrary :: Proxy TV -> Gen (ADTArbitrary TV)
toADTArbitrarySingleton :: Proxy TV -> Gen (ADTArbitrarySingleton TV)
$ctoADTArbitrarySingleton :: Proxy TV -> Gen (ADTArbitrarySingleton TV)
ToADTArbitrary)

data BaseType
  = TInt
  | TDouble
  | TWord16
  | TWord32
  | TWord64
  | TText
  | TTime
  | TTimeDiff
  | TResolution
  | TEnum Text (Set.Set Ident)
  deriving (Int -> BaseType -> ShowS
[BaseType] -> ShowS
BaseType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BaseType] -> ShowS
$cshowList :: [BaseType] -> ShowS
show :: BaseType -> FilePath
$cshow :: BaseType -> FilePath
showsPrec :: Int -> BaseType -> ShowS
$cshowsPrec :: Int -> BaseType -> ShowS
Show, BaseType -> BaseType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseType -> BaseType -> Bool
$c/= :: BaseType -> BaseType -> Bool
== :: BaseType -> BaseType -> Bool
$c== :: BaseType -> BaseType -> Bool
Eq, Eq BaseType
BaseType -> BaseType -> Bool
BaseType -> BaseType -> Ordering
BaseType -> BaseType -> BaseType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BaseType -> BaseType -> BaseType
$cmin :: BaseType -> BaseType -> BaseType
max :: BaseType -> BaseType -> BaseType
$cmax :: BaseType -> BaseType -> BaseType
>= :: BaseType -> BaseType -> Bool
$c>= :: BaseType -> BaseType -> Bool
> :: BaseType -> BaseType -> Bool
$c> :: BaseType -> BaseType -> Bool
<= :: BaseType -> BaseType -> Bool
$c<= :: BaseType -> BaseType -> Bool
< :: BaseType -> BaseType -> Bool
$c< :: BaseType -> BaseType -> Bool
compare :: BaseType -> BaseType -> Ordering
$ccompare :: BaseType -> BaseType -> Ordering
Ord, Typeable BaseType
BaseType -> DataType
BaseType -> Constr
(forall b. Data b => b -> b) -> BaseType -> BaseType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> BaseType -> u
forall u. (forall d. Data d => d -> u) -> BaseType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseType -> c BaseType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> BaseType -> m BaseType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BaseType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> BaseType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> BaseType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BaseType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BaseType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BaseType -> r
gmapT :: (forall b. Data b => b -> b) -> BaseType -> BaseType
$cgmapT :: (forall b. Data b => b -> b) -> BaseType -> BaseType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BaseType)
dataTypeOf :: BaseType -> DataType
$cdataTypeOf :: BaseType -> DataType
toConstr :: BaseType -> Constr
$ctoConstr :: BaseType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BaseType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseType -> c BaseType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BaseType -> c BaseType
Data, forall x. Rep BaseType x -> BaseType
forall x. BaseType -> Rep BaseType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BaseType x -> BaseType
$cfrom :: forall x. BaseType -> Rep BaseType x
Generic, [BaseType] -> Encoding
[BaseType] -> Value
BaseType -> Encoding
BaseType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BaseType] -> Encoding
$ctoEncodingList :: [BaseType] -> Encoding
toJSONList :: [BaseType] -> Value
$ctoJSONList :: [BaseType] -> Value
toEncoding :: BaseType -> Encoding
$ctoEncoding :: BaseType -> Encoding
toJSON :: BaseType -> Value
$ctoJSON :: BaseType -> Value
ToJSON, Value -> Parser [BaseType]
Value -> Parser BaseType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BaseType]
$cparseJSONList :: Value -> Parser [BaseType]
parseJSON :: Value -> Parser BaseType
$cparseJSON :: Value -> Parser BaseType
FromJSON, BaseType -> ()
forall a. (a -> ()) -> NFData a
rnf :: BaseType -> ()
$crnf :: BaseType -> ()
NFData, Proxy BaseType -> Gen (ADTArbitrarySingleton BaseType)
Proxy BaseType -> Gen (ADTArbitrary BaseType)
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy BaseType -> Gen (ADTArbitrary BaseType)
$ctoADTArbitrary :: Proxy BaseType -> Gen (ADTArbitrary BaseType)
toADTArbitrarySingleton :: Proxy BaseType -> Gen (ADTArbitrarySingleton BaseType)
$ctoADTArbitrarySingleton :: Proxy BaseType -> Gen (ADTArbitrarySingleton BaseType)
ToADTArbitrary)

instance Arbitrary BaseType where
  shrink :: BaseType -> [BaseType]
shrink = forall a. a -> [a]
shrinkNothing
  arbitrary :: Gen BaseType
arbitrary =
    forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$
      (Text -> Set Ident -> BaseType
TEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
arbitrary))
        forall a. a -> [a] -> [a]
: ( forall a b. (a -> b) -> [a] -> [b]
map
              forall (f :: * -> *) a. Applicative f => a -> f a
pure
              [ BaseType
TInt,
                BaseType
TDouble,
                BaseType
TWord16,
                BaseType
TWord32,
                BaseType
TWord64,
                BaseType
TText,
                BaseType
TTime,
                BaseType
TTimeDiff,
                BaseType
TResolution
              ]
          )

instance Serialize BaseType where
  get :: Get BaseType
get =
    Get Int8
Serialize.getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TInt
      Int8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TDouble
      Int8
2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TWord16
      Int8
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TWord32
      Int8
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TWord64
      Int8
5 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TText
      Int8
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TTime
      Int8
7 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TTimeDiff
      Int8
8 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure BaseType
TResolution
      Int8
_ -> do
        ByteString
nm <- forall t. Serialize t => Get t
Serialize.get
        [ByteString]
ids <- forall t. Serialize t => Get t
Serialize.get
        pure $ Text -> Set Ident -> BaseType
TEnum (ByteString -> Text
Text.decodeUtf8 ByteString
nm) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Ident
Ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8) [ByteString]
ids

  put :: Putter BaseType
put = \case
    BaseType
TInt -> Putter Int8
Serialize.putInt8 Int8
0
    BaseType
TDouble -> Putter Int8
Serialize.putInt8 Int8
1
    BaseType
TWord16 -> Putter Int8
Serialize.putInt8 Int8
2
    BaseType
TWord32 -> Putter Int8
Serialize.putInt8 Int8
3
    BaseType
TWord64 -> Putter Int8
Serialize.putInt8 Int8
4
    BaseType
TText -> Putter Int8
Serialize.putInt8 Int8
5
    BaseType
TTime -> Putter Int8
Serialize.putInt8 Int8
6
    BaseType
TTimeDiff -> Putter Int8
Serialize.putInt8 Int8
7
    BaseType
TResolution -> Putter Int8
Serialize.putInt8 Int8
8
    TEnum Text
nm Set Ident
ids -> do
      Putter Int8
Serialize.putInt8 Int8
9
      forall t. Serialize t => Putter t
Serialize.put forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
nm
      forall t. Serialize t => Putter t
Serialize.put forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
unIdent) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set Ident
ids

instance Hashable BaseType where
  hashWithSalt :: Int -> BaseType -> Int
hashWithSalt Int
s BaseType
TInt = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
1 :: Int)
  hashWithSalt Int
s BaseType
TDouble = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
2 :: Int)
  hashWithSalt Int
s BaseType
TWord16 = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
3 :: Int)
  hashWithSalt Int
s BaseType
TWord32 = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
4 :: Int)
  hashWithSalt Int
s BaseType
TWord64 = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
5 :: Int)
  hashWithSalt Int
s BaseType
TText = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
6 :: Int)
  hashWithSalt Int
s BaseType
TTime = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
7 :: Int)
  hashWithSalt Int
s BaseType
TTimeDiff = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
8 :: Int)
  hashWithSalt Int
s BaseType
TResolution = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
9 :: Int)
  hashWithSalt Int
s (TEnum Text
nm Set Ident
cs) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int
10 :: Int, Text
nm, forall a. Set a -> [a]
Set.toList Set Ident
cs)

data InfernoType
  = TVar TV
  | TBase BaseType
  | TArr InfernoType InfernoType
  | TArray InfernoType
  | TSeries InfernoType
  | TOptional InfernoType
  | TTuple (TList InfernoType)
  | TRep InfernoType
  deriving (Int -> InfernoType -> ShowS
[InfernoType] -> ShowS
InfernoType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InfernoType] -> ShowS
$cshowList :: [InfernoType] -> ShowS
show :: InfernoType -> FilePath
$cshow :: InfernoType -> FilePath
showsPrec :: Int -> InfernoType -> ShowS
$cshowsPrec :: Int -> InfernoType -> ShowS
Show, InfernoType -> InfernoType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfernoType -> InfernoType -> Bool
$c/= :: InfernoType -> InfernoType -> Bool
== :: InfernoType -> InfernoType -> Bool
$c== :: InfernoType -> InfernoType -> Bool
Eq, Eq InfernoType
InfernoType -> InfernoType -> Bool
InfernoType -> InfernoType -> Ordering
InfernoType -> InfernoType -> InfernoType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InfernoType -> InfernoType -> InfernoType
$cmin :: InfernoType -> InfernoType -> InfernoType
max :: InfernoType -> InfernoType -> InfernoType
$cmax :: InfernoType -> InfernoType -> InfernoType
>= :: InfernoType -> InfernoType -> Bool
$c>= :: InfernoType -> InfernoType -> Bool
> :: InfernoType -> InfernoType -> Bool
$c> :: InfernoType -> InfernoType -> Bool
<= :: InfernoType -> InfernoType -> Bool
$c<= :: InfernoType -> InfernoType -> Bool
< :: InfernoType -> InfernoType -> Bool
$c< :: InfernoType -> InfernoType -> Bool
compare :: InfernoType -> InfernoType -> Ordering
$ccompare :: InfernoType -> InfernoType -> Ordering
Ord, Typeable InfernoType
InfernoType -> DataType
InfernoType -> Constr
(forall b. Data b => b -> b) -> InfernoType -> InfernoType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InfernoType -> u
forall u. (forall d. Data d => d -> u) -> InfernoType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InfernoType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InfernoType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InfernoType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InfernoType -> c InfernoType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InfernoType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InfernoType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InfernoType -> m InfernoType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InfernoType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InfernoType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InfernoType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InfernoType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InfernoType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InfernoType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InfernoType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InfernoType -> r
gmapT :: (forall b. Data b => b -> b) -> InfernoType -> InfernoType
$cgmapT :: (forall b. Data b => b -> b) -> InfernoType -> InfernoType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InfernoType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InfernoType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InfernoType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InfernoType)
dataTypeOf :: InfernoType -> DataType
$cdataTypeOf :: InfernoType -> DataType
toConstr :: InfernoType -> Constr
$ctoConstr :: InfernoType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InfernoType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InfernoType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InfernoType -> c InfernoType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InfernoType -> c InfernoType
Data, forall x. Rep InfernoType x -> InfernoType
forall x. InfernoType -> Rep InfernoType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InfernoType x -> InfernoType
$cfrom :: forall x. InfernoType -> Rep InfernoType x
Generic, [InfernoType] -> Encoding
[InfernoType] -> Value
InfernoType -> Encoding
InfernoType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InfernoType] -> Encoding
$ctoEncodingList :: [InfernoType] -> Encoding
toJSONList :: [InfernoType] -> Value
$ctoJSONList :: [InfernoType] -> Value
toEncoding :: InfernoType -> Encoding
$ctoEncoding :: InfernoType -> Encoding
toJSON :: InfernoType -> Value
$ctoJSON :: InfernoType -> Value
ToJSON, Value -> Parser [InfernoType]
Value -> Parser InfernoType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InfernoType]
$cparseJSONList :: Value -> Parser [InfernoType]
parseJSON :: Value -> Parser InfernoType
$cparseJSON :: Value -> Parser InfernoType
FromJSON, InfernoType -> ()
forall a. (a -> ()) -> NFData a
rnf :: InfernoType -> ()
$crnf :: InfernoType -> ()
NFData, Eq InfernoType
Int -> InfernoType -> Int
InfernoType -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InfernoType -> Int
$chash :: InfernoType -> Int
hashWithSalt :: Int -> InfernoType -> Int
$chashWithSalt :: Int -> InfernoType -> Int
Hashable, Proxy InfernoType -> Gen (ADTArbitrarySingleton InfernoType)
Proxy InfernoType -> Gen (ADTArbitrary InfernoType)
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy InfernoType -> Gen (ADTArbitrary InfernoType)
$ctoADTArbitrary :: Proxy InfernoType -> Gen (ADTArbitrary InfernoType)
toADTArbitrarySingleton :: Proxy InfernoType -> Gen (ADTArbitrarySingleton InfernoType)
$ctoADTArbitrarySingleton :: Proxy InfernoType -> Gen (ADTArbitrarySingleton InfernoType)
ToADTArbitrary)
  deriving anyclass (Get InfernoType
Putter InfernoType
forall t. Putter t -> Get t -> Serialize t
get :: Get InfernoType
$cget :: Get InfernoType
put :: Putter InfernoType
$cput :: Putter InfernoType
Serialize)

instance Arbitrary InfernoType where
  shrink :: InfernoType -> [InfernoType]
shrink = forall a. (Generic a, RecursivelyShrink (Rep a)) => a -> [a]
recursivelyShrink
  arbitrary :: Gen InfernoType
arbitrary = forall a. (Int -> Gen a) -> Gen a
sized forall {a}. Integral a => a -> Gen InfernoType
arbitrarySized
    where
      arbitraryVar :: Gen InfernoType
arbitraryVar =
        TV -> InfernoType
TVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

      arbitraryArr :: a -> Gen InfernoType
arbitraryArr a
n =
        InfernoType -> InfernoType -> InfernoType
TArr
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Gen InfernoType
arbitrarySized forall a b. (a -> b) -> a -> b
$ a
n forall a. Integral a => a -> a -> a
`div` a
3)
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> Gen InfernoType
arbitrarySized forall a b. (a -> b) -> a -> b
$ a
n forall a. Integral a => a -> a -> a
`div` a
3)

      arbitraryTTuple :: a -> Gen InfernoType
arbitraryTTuple a
n =
        forall a. [Gen a] -> Gen a
oneof
          [ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TList InfernoType -> InfernoType
TTuple forall a. TList a
TNil,
            TList InfernoType -> InfernoType
TTuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> a -> [a] -> TList a
TCons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Gen InfernoType
arbitrarySized forall a b. (a -> b) -> a -> b
$ a
n forall a. Integral a => a -> a -> a
`div` a
3) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> Gen InfernoType
arbitrarySized forall a b. (a -> b) -> a -> b
$ a
n forall a. Integral a => a -> a -> a
`div` a
3) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen [a]
listOf (a -> Gen InfernoType
arbitrarySized forall a b. (a -> b) -> a -> b
$ a
n forall a. Integral a => a -> a -> a
`div` a
3))
          ]

      arbitraryBase :: Gen InfernoType
arbitraryBase = BaseType -> InfernoType
TBase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

      arbitraryRest :: a -> Gen InfernoType
arbitraryRest a
n = do
        InfernoType -> InfernoType
constr <- forall a. [a] -> Gen a
elements [InfernoType -> InfernoType
TArray, InfernoType -> InfernoType
TSeries, InfernoType -> InfernoType
TOptional, InfernoType -> InfernoType
TRep]
        InfernoType -> InfernoType
constr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Gen InfernoType
arbitrarySized forall a b. (a -> b) -> a -> b
$ a
n forall a. Integral a => a -> a -> a
`div` a
3)

      arbitrarySized :: a -> Gen InfernoType
arbitrarySized a
0 =
        forall a. [Gen a] -> Gen a
oneof
          [ Gen InfernoType
arbitraryVar,
            Gen InfernoType
arbitraryBase
          ]
      arbitrarySized a
n =
        forall a. [Gen a] -> Gen a
oneof
          [ Gen InfernoType
arbitraryVar,
            Gen InfernoType
arbitraryBase,
            a -> Gen InfernoType
arbitraryArr a
n,
            a -> Gen InfernoType
arbitraryTTuple a
n,
            a -> Gen InfernoType
arbitraryRest a
n
          ]

punctuate' :: Doc ann -> [Doc ann] -> [Doc ann]
punctuate' :: forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate' Doc ann
_ [] = []
punctuate' Doc ann
_ [Doc ann
d] = [Doc ann
d]
punctuate' Doc ann
p (Doc ann
d : [Doc ann]
ds) = (Doc ann
d forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
p) forall a. a -> [a] -> [a]
: forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate' Doc ann
p [Doc ann]
ds

collectArrs :: InfernoType -> [InfernoType]
collectArrs :: InfernoType -> [InfernoType]
collectArrs (TArr InfernoType
ty1 InfernoType
ty2) = InfernoType
ty1 forall a. a -> [a] -> [a]
: InfernoType -> [InfernoType]
collectArrs InfernoType
ty2
collectArrs InfernoType
t = [InfernoType
t]

letters :: [Text]
letters :: [Text]
letters = forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ [Int
1 ..] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM [Char
'a' .. Char
'z']

instance Pretty TV where
  pretty :: forall ann. TV -> Doc ann
pretty (TV Int
i) = Doc ann
"'" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ([Text]
letters forall a. [a] -> Int -> a
!! Int
i)

instance Pretty BaseType where
  pretty :: forall ann. BaseType -> Doc ann
pretty = \case
    BaseType
TInt -> Doc ann
"int"
    BaseType
TDouble -> Doc ann
"double"
    BaseType
TWord16 -> Doc ann
"word16"
    BaseType
TWord32 -> Doc ann
"word32"
    BaseType
TWord64 -> Doc ann
"word64"
    BaseType
TText -> Doc ann
"text"
    BaseType
TTime -> Doc ann
"time"
    BaseType
TTimeDiff -> Doc ann
"timeDiff"
    BaseType
TResolution -> Doc ann
"resolution"
    TEnum Text
t Set Ident
_ -> forall a ann. Pretty a => a -> Doc ann
pretty Text
t

instance Pretty InfernoType where
  pretty :: forall ann. InfernoType -> Doc ann
pretty = \case
    TVar TV
v -> forall a ann. Pretty a => a -> Doc ann
pretty TV
v
    TBase BaseType
b -> forall a ann. Pretty a => a -> Doc ann
pretty BaseType
b
    t :: InfernoType
t@(TArr InfernoType
_ InfernoType
_) ->
      let prettyType :: [Doc ann] -> Doc ann
prettyType = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate' Doc ann
"→"
       in forall ann. [Doc ann] -> Doc ann
prettyType forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map (\InfernoType
t' -> case InfernoType
t' of TArr InfernoType
_ InfernoType
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
t'; InfernoType
_ -> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
t') forall a b. (a -> b) -> a -> b
$
              InfernoType -> [InfernoType]
collectArrs InfernoType
t
    TArray ty :: InfernoType
ty@(TVar TV
_) -> Doc ann
"array of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TArray ty :: InfernoType
ty@(TBase BaseType
_) -> Doc ann
"array of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TArray ty :: InfernoType
ty@(TTuple TList InfernoType
_) -> Doc ann
"array of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TArray InfernoType
ty -> Doc ann
"array of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TSeries ty :: InfernoType
ty@(TVar TV
_) -> Doc ann
"series of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TSeries ty :: InfernoType
ty@(TBase BaseType
_) -> Doc ann
"series of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TSeries ty :: InfernoType
ty@(TTuple TList InfernoType
_) -> Doc ann
"series of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TSeries InfernoType
ty -> Doc ann
"series of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TOptional ty :: InfernoType
ty@(TVar TV
_) -> Doc ann
"option of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TOptional ty :: InfernoType
ty@(TBase BaseType
_) -> Doc ann
"option of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TOptional ty :: InfernoType
ty@(TTuple TList InfernoType
_) -> Doc ann
"option of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TOptional InfernoType
ty -> Doc ann
"option of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TTuple TList InfernoType
tys -> forall ann. [Doc ann] -> Doc ann
Pretty.tupled (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. TList a -> [a]
tListToList TList InfernoType
tys)
    TRep ty :: InfernoType
ty@(TVar TV
_) -> Doc ann
"rep of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TRep ty :: InfernoType
ty@(TBase BaseType
_) -> Doc ann
"rep of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TRep ty :: InfernoType
ty@(TTuple TList InfernoType
_) -> Doc ann
"rep of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)
    TRep InfernoType
ty -> Doc ann
"rep of" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty)

incSourceCol :: SourcePos -> Int -> SourcePos
incSourceCol :: SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos Int
0 = SourcePos
pos
incSourceCol (SourcePos FilePath
n Pos
l Pos
c) Int
i = FilePath -> Pos -> Pos -> SourcePos
SourcePos FilePath
n Pos
l (Pos
c forall a. Semigroup a => a -> a -> a
<> Int -> Pos
mkPos Int
i)

rws :: [Text] -- list of reserved words
rws :: [Text]
rws = [Text
"if", Text
"then", Text
"else", Text
"let", Text
"module", Text
"in", Text
"match", Text
"with", Text
"Some", Text
"None", Text
"assert", Text
"fun", Text
"infixr", Text
"infixl", Text
"infix", Text
"enum", Text
"open"]

newtype Ident = Ident {Ident -> Text
unIdent :: Text}
  deriving stock (Ident -> Ident -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c== :: Ident -> Ident -> Bool
Eq, Eq Ident
Ident -> Ident -> Bool
Ident -> Ident -> Ordering
Ident -> Ident -> Ident
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmax :: Ident -> Ident -> Ident
>= :: Ident -> Ident -> Bool
$c>= :: Ident -> Ident -> Bool
> :: Ident -> Ident -> Bool
$c> :: Ident -> Ident -> Bool
<= :: Ident -> Ident -> Bool
$c<= :: Ident -> Ident -> Bool
< :: Ident -> Ident -> Bool
$c< :: Ident -> Ident -> Bool
compare :: Ident -> Ident -> Ordering
$ccompare :: Ident -> Ident -> Ordering
Ord, Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> FilePath
$cshow :: Ident -> FilePath
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show, Typeable Ident
Ident -> DataType
Ident -> Constr
(forall b. Data b => b -> b) -> Ident -> Ident
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
forall u. (forall d. Data d => d -> u) -> Ident -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
$cgmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
dataTypeOf :: Ident -> DataType
$cdataTypeOf :: Ident -> DataType
toConstr :: Ident -> Constr
$ctoConstr :: Ident -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
Data, forall x. Rep Ident x -> Ident
forall x. Ident -> Rep Ident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ident x -> Ident
$cfrom :: forall x. Ident -> Rep Ident x
Generic)
  deriving newtype ([Ident] -> Encoding
[Ident] -> Value
Ident -> Encoding
Ident -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Ident] -> Encoding
$ctoEncodingList :: [Ident] -> Encoding
toJSONList :: [Ident] -> Value
$ctoJSONList :: [Ident] -> Value
toEncoding :: Ident -> Encoding
$ctoEncoding :: Ident -> Encoding
toJSON :: Ident -> Value
$ctoJSON :: Ident -> Value
ToJSON, Value -> Parser [Ident]
Value -> Parser Ident
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Ident]
$cparseJSONList :: Value -> Parser [Ident]
parseJSON :: Value -> Parser Ident
$cparseJSON :: Value -> Parser Ident
FromJSON, ToJSONKeyFunction [Ident]
ToJSONKeyFunction Ident
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Ident]
$ctoJSONKeyList :: ToJSONKeyFunction [Ident]
toJSONKey :: ToJSONKeyFunction Ident
$ctoJSONKey :: ToJSONKeyFunction Ident
ToJSONKey, FromJSONKeyFunction [Ident]
FromJSONKeyFunction Ident
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [Ident]
$cfromJSONKeyList :: FromJSONKeyFunction [Ident]
fromJSONKey :: FromJSONKeyFunction Ident
$cfromJSONKey :: FromJSONKeyFunction Ident
FromJSONKey, FilePath -> Ident
forall a. (FilePath -> a) -> IsString a
fromString :: FilePath -> Ident
$cfromString :: FilePath -> Ident
IsString, Ident -> ()
forall a. (a -> ()) -> NFData a
rnf :: Ident -> ()
$crnf :: Ident -> ()
NFData, Eq Ident
Int -> Ident -> Int
Ident -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Ident -> Int
$chash :: Ident -> Int
hashWithSalt :: Int -> Ident -> Int
$chashWithSalt :: Int -> Ident -> Int
Hashable)
  deriving anyclass (Proxy Ident -> Gen (ADTArbitrarySingleton Ident)
Proxy Ident -> Gen (ADTArbitrary Ident)
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy Ident -> Gen (ADTArbitrary Ident)
$ctoADTArbitrary :: Proxy Ident -> Gen (ADTArbitrary Ident)
toADTArbitrarySingleton :: Proxy Ident -> Gen (ADTArbitrarySingleton Ident)
$ctoADTArbitrarySingleton :: Proxy Ident -> Gen (ADTArbitrarySingleton Ident)
ToADTArbitrary)

arbitraryName :: Gen Text
arbitraryName :: Gen Text
arbitraryName =
  ( (\Char
a FilePath
as -> FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ Char
a forall a. a -> [a] -> [a]
: FilePath
as)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> Gen a
elements [Char
'a' .. Char
'z'])
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Gen a -> Gen [a]
listOf forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Gen a
elements forall a b. (a -> b) -> a -> b
$ [Char
'0' .. Char
'9'] forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'_'])
  )
    forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (\Text
i -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
rws)

instance Arbitrary Ident where
  shrink :: Ident -> [Ident]
shrink = forall a. a -> [a]
shrinkNothing
  arbitrary :: Gen Ident
arbitrary = Text -> Ident
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbitraryName

newtype ModuleName = ModuleName {ModuleName -> Text
unModuleName :: Text}
  deriving stock (ModuleName -> ModuleName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
Ord, Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModuleName] -> ShowS
$cshowList :: [ModuleName] -> ShowS
show :: ModuleName -> FilePath
$cshow :: ModuleName -> FilePath
showsPrec :: Int -> ModuleName -> ShowS
$cshowsPrec :: Int -> ModuleName -> ShowS
Show, Typeable ModuleName
ModuleName -> DataType
ModuleName -> Constr
(forall b. Data b => b -> b) -> ModuleName -> ModuleName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ModuleName -> u
forall u. (forall d. Data d => d -> u) -> ModuleName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModuleName -> m ModuleName
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModuleName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModuleName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModuleName -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModuleName -> r
gmapT :: (forall b. Data b => b -> b) -> ModuleName -> ModuleName
$cgmapT :: (forall b. Data b => b -> b) -> ModuleName -> ModuleName
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModuleName)
dataTypeOf :: ModuleName -> DataType
$cdataTypeOf :: ModuleName -> DataType
toConstr :: ModuleName -> Constr
$ctoConstr :: ModuleName -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModuleName -> c ModuleName
Data, forall x. Rep ModuleName x -> ModuleName
forall x. ModuleName -> Rep ModuleName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModuleName x -> ModuleName
$cfrom :: forall x. ModuleName -> Rep ModuleName x
Generic)
  deriving newtype ([ModuleName] -> Encoding
[ModuleName] -> Value
ModuleName -> Encoding
ModuleName -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ModuleName] -> Encoding
$ctoEncodingList :: [ModuleName] -> Encoding
toJSONList :: [ModuleName] -> Value
$ctoJSONList :: [ModuleName] -> Value
toEncoding :: ModuleName -> Encoding
$ctoEncoding :: ModuleName -> Encoding
toJSON :: ModuleName -> Value
$ctoJSON :: ModuleName -> Value
ToJSON, Value -> Parser [ModuleName]
Value -> Parser ModuleName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ModuleName]
$cparseJSONList :: Value -> Parser [ModuleName]
parseJSON :: Value -> Parser ModuleName
$cparseJSON :: Value -> Parser ModuleName
FromJSON, FilePath -> ModuleName
forall a. (FilePath -> a) -> IsString a
fromString :: FilePath -> ModuleName
$cfromString :: FilePath -> ModuleName
IsString)
  deriving anyclass (Proxy ModuleName -> Gen (ADTArbitrarySingleton ModuleName)
Proxy ModuleName -> Gen (ADTArbitrary ModuleName)
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy ModuleName -> Gen (ADTArbitrary ModuleName)
$ctoADTArbitrary :: Proxy ModuleName -> Gen (ADTArbitrary ModuleName)
toADTArbitrarySingleton :: Proxy ModuleName -> Gen (ADTArbitrarySingleton ModuleName)
$ctoADTArbitrarySingleton :: Proxy ModuleName -> Gen (ADTArbitrarySingleton ModuleName)
ToADTArbitrary)

instance Arbitrary ModuleName where
  shrink :: ModuleName -> [ModuleName]
shrink = forall a. a -> [a]
shrinkNothing
  arbitrary :: Gen ModuleName
arbitrary = Text -> ModuleName
ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbitraryName

class ElementPosition a where
  elementPosition :: SourcePos -> a -> (SourcePos, SourcePos)

instance ElementPosition Ident where
  elementPosition :: SourcePos -> Ident -> (SourcePos, SourcePos)
elementPosition SourcePos
pos (Ident Text
a) = (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
a)

instance ElementPosition ModuleName where
  elementPosition :: SourcePos -> ModuleName -> (SourcePos, SourcePos)
elementPosition SourcePos
pos (ModuleName Text
a) = (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
a)

instance ElementPosition (Maybe Ident) where
  elementPosition :: SourcePos -> Maybe Ident -> (SourcePos, SourcePos)
elementPosition SourcePos
pos = \case
    Just Ident
i -> forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos Ident
i
    Maybe Ident
Nothing -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos Int
1)

-- | An extended identifier; either an internal (e.g., var$4) or a regular variable
newtype ExtIdent = ExtIdent (Either Int Text)
  deriving (Int -> ExtIdent -> ShowS
[ExtIdent] -> ShowS
ExtIdent -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ExtIdent] -> ShowS
$cshowList :: [ExtIdent] -> ShowS
show :: ExtIdent -> FilePath
$cshow :: ExtIdent -> FilePath
showsPrec :: Int -> ExtIdent -> ShowS
$cshowsPrec :: Int -> ExtIdent -> ShowS
Show, ExtIdent -> ExtIdent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtIdent -> ExtIdent -> Bool
$c/= :: ExtIdent -> ExtIdent -> Bool
== :: ExtIdent -> ExtIdent -> Bool
$c== :: ExtIdent -> ExtIdent -> Bool
Eq, Eq ExtIdent
ExtIdent -> ExtIdent -> Bool
ExtIdent -> ExtIdent -> Ordering
ExtIdent -> ExtIdent -> ExtIdent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtIdent -> ExtIdent -> ExtIdent
$cmin :: ExtIdent -> ExtIdent -> ExtIdent
max :: ExtIdent -> ExtIdent -> ExtIdent
$cmax :: ExtIdent -> ExtIdent -> ExtIdent
>= :: ExtIdent -> ExtIdent -> Bool
$c>= :: ExtIdent -> ExtIdent -> Bool
> :: ExtIdent -> ExtIdent -> Bool
$c> :: ExtIdent -> ExtIdent -> Bool
<= :: ExtIdent -> ExtIdent -> Bool
$c<= :: ExtIdent -> ExtIdent -> Bool
< :: ExtIdent -> ExtIdent -> Bool
$c< :: ExtIdent -> ExtIdent -> Bool
compare :: ExtIdent -> ExtIdent -> Ordering
$ccompare :: ExtIdent -> ExtIdent -> Ordering
Ord, Typeable ExtIdent
ExtIdent -> DataType
ExtIdent -> Constr
(forall b. Data b => b -> b) -> ExtIdent -> ExtIdent
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ExtIdent -> u
forall u. (forall d. Data d => d -> u) -> ExtIdent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtIdent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtIdent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtIdent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtIdent -> c ExtIdent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtIdent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExtIdent)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExtIdent -> m ExtIdent
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExtIdent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExtIdent -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExtIdent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExtIdent -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtIdent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExtIdent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtIdent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExtIdent -> r
gmapT :: (forall b. Data b => b -> b) -> ExtIdent -> ExtIdent
$cgmapT :: (forall b. Data b => b -> b) -> ExtIdent -> ExtIdent
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExtIdent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExtIdent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtIdent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExtIdent)
dataTypeOf :: ExtIdent -> DataType
$cdataTypeOf :: ExtIdent -> DataType
toConstr :: ExtIdent -> Constr
$ctoConstr :: ExtIdent -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtIdent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExtIdent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtIdent -> c ExtIdent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExtIdent -> c ExtIdent
Data, forall x. Rep ExtIdent x -> ExtIdent
forall x. ExtIdent -> Rep ExtIdent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExtIdent x -> ExtIdent
$cfrom :: forall x. ExtIdent -> Rep ExtIdent x
Generic)
  deriving newtype ([ExtIdent] -> Encoding
[ExtIdent] -> Value
ExtIdent -> Encoding
ExtIdent -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExtIdent] -> Encoding
$ctoEncodingList :: [ExtIdent] -> Encoding
toJSONList :: [ExtIdent] -> Value
$ctoJSONList :: [ExtIdent] -> Value
toEncoding :: ExtIdent -> Encoding
$ctoEncoding :: ExtIdent -> Encoding
toJSON :: ExtIdent -> Value
$ctoJSON :: ExtIdent -> Value
ToJSON, Value -> Parser [ExtIdent]
Value -> Parser ExtIdent
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExtIdent]
$cparseJSONList :: Value -> Parser [ExtIdent]
parseJSON :: Value -> Parser ExtIdent
$cparseJSON :: Value -> Parser ExtIdent
FromJSON)

instance Arbitrary ExtIdent where
  shrink :: ExtIdent -> [ExtIdent]
shrink = forall a. a -> [a]
shrinkNothing
  arbitrary :: Gen ExtIdent
arbitrary =
    Either Int Text -> ExtIdent
ExtIdent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [Gen a] -> Gen a
oneof [forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (forall a. Ord a => a -> a -> Bool
(<) Int
0)), forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
arbitraryName]

instance ToJSONKey ExtIdent where
  toJSONKey :: ToJSONKeyFunction ExtIdent
toJSONKey = forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText forall a b. (a -> b) -> a -> b
$ \case
    ExtIdent (Left Int
i) -> Text
"var$" forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Int
i)
    ExtIdent (Right Text
k) -> Text
"reg$" forall a. Semigroup a => a -> a -> a
<> Text
k

instance FromJSONKey ExtIdent where
  fromJSONKey :: FromJSONKeyFunction ExtIdent
fromJSONKey = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Int -> Text -> Text
Text.take Int
4 Text
t of
      Text
"var$" -> case forall a. Read a => FilePath -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
4 Text
t of
        Just Int
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Int
i
        Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Could not read internal var"
      Text
"reg$" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
4 Text
t
      Text
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Invalid ExtIdent key"

data ImplExpl = Impl ExtIdent | Expl ExtIdent
  deriving (Int -> ImplExpl -> ShowS
[ImplExpl] -> ShowS
ImplExpl -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImplExpl] -> ShowS
$cshowList :: [ImplExpl] -> ShowS
show :: ImplExpl -> FilePath
$cshow :: ImplExpl -> FilePath
showsPrec :: Int -> ImplExpl -> ShowS
$cshowsPrec :: Int -> ImplExpl -> ShowS
Show, ImplExpl -> ImplExpl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImplExpl -> ImplExpl -> Bool
$c/= :: ImplExpl -> ImplExpl -> Bool
== :: ImplExpl -> ImplExpl -> Bool
$c== :: ImplExpl -> ImplExpl -> Bool
Eq, Eq ImplExpl
ImplExpl -> ImplExpl -> Bool
ImplExpl -> ImplExpl -> Ordering
ImplExpl -> ImplExpl -> ImplExpl
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImplExpl -> ImplExpl -> ImplExpl
$cmin :: ImplExpl -> ImplExpl -> ImplExpl
max :: ImplExpl -> ImplExpl -> ImplExpl
$cmax :: ImplExpl -> ImplExpl -> ImplExpl
>= :: ImplExpl -> ImplExpl -> Bool
$c>= :: ImplExpl -> ImplExpl -> Bool
> :: ImplExpl -> ImplExpl -> Bool
$c> :: ImplExpl -> ImplExpl -> Bool
<= :: ImplExpl -> ImplExpl -> Bool
$c<= :: ImplExpl -> ImplExpl -> Bool
< :: ImplExpl -> ImplExpl -> Bool
$c< :: ImplExpl -> ImplExpl -> Bool
compare :: ImplExpl -> ImplExpl -> Ordering
$ccompare :: ImplExpl -> ImplExpl -> Ordering
Ord, Typeable ImplExpl
ImplExpl -> DataType
ImplExpl -> Constr
(forall b. Data b => b -> b) -> ImplExpl -> ImplExpl
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImplExpl -> u
forall u. (forall d. Data d => d -> u) -> ImplExpl -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImplExpl -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImplExpl -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImplExpl
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImplExpl -> c ImplExpl
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImplExpl)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImplExpl)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImplExpl -> m ImplExpl
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImplExpl -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImplExpl -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImplExpl -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImplExpl -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImplExpl -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImplExpl -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImplExpl -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImplExpl -> r
gmapT :: (forall b. Data b => b -> b) -> ImplExpl -> ImplExpl
$cgmapT :: (forall b. Data b => b -> b) -> ImplExpl -> ImplExpl
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImplExpl)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImplExpl)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImplExpl)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImplExpl)
dataTypeOf :: ImplExpl -> DataType
$cdataTypeOf :: ImplExpl -> DataType
toConstr :: ImplExpl -> Constr
$ctoConstr :: ImplExpl -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImplExpl
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImplExpl
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImplExpl -> c ImplExpl
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImplExpl -> c ImplExpl
Data, forall x. Rep ImplExpl x -> ImplExpl
forall x. ImplExpl -> Rep ImplExpl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImplExpl x -> ImplExpl
$cfrom :: forall x. ImplExpl -> Rep ImplExpl x
Generic, [ImplExpl] -> Encoding
[ImplExpl] -> Value
ImplExpl -> Encoding
ImplExpl -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ImplExpl] -> Encoding
$ctoEncodingList :: [ImplExpl] -> Encoding
toJSONList :: [ImplExpl] -> Value
$ctoJSONList :: [ImplExpl] -> Value
toEncoding :: ImplExpl -> Encoding
$ctoEncoding :: ImplExpl -> Encoding
toJSON :: ImplExpl -> Value
$ctoJSON :: ImplExpl -> Value
ToJSON, Value -> Parser [ImplExpl]
Value -> Parser ImplExpl
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ImplExpl]
$cparseJSONList :: Value -> Parser [ImplExpl]
parseJSON :: Value -> Parser ImplExpl
$cparseJSON :: Value -> Parser ImplExpl
FromJSON)

instance Pretty ExtIdent where
  pretty :: forall ann. ExtIdent -> Doc ann
pretty (ExtIdent Either Int Text
i) = case Either Int Text
i of
    Left Int
n -> Doc ann
"var$" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int
n
    Right Text
x -> forall a ann. Pretty a => a -> Doc ann
pretty Text
x

instance Pretty ImplExpl where
  pretty :: forall ann. ImplExpl -> Doc ann
pretty = \case
    Impl ExtIdent
a -> Doc ann
"?" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ExtIdent
a
    Expl ExtIdent
a -> forall a ann. Pretty a => a -> Doc ann
pretty ExtIdent
a

instance ElementPosition ImplExpl where
  elementPosition :: SourcePos -> ImplExpl -> (SourcePos, SourcePos)
elementPosition SourcePos
pos = \case
    Impl (ExtIdent (Left Int
_)) -> (SourcePos
pos, SourcePos
pos)
    Impl (ExtIdent (Right Text
a)) -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
a forall a. Num a => a -> a -> a
+ Int
1)
    Expl (ExtIdent (Left Int
_)) -> (SourcePos
pos, SourcePos
pos)
    Expl (ExtIdent (Right Text
a)) -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
a)

data Fixity = InfixOp InfixFixity | PrefixOp deriving (Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> FilePath
$cshow :: Fixity -> FilePath
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show, Fixity -> Fixity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: Fixity -> Fixity -> Bool
Eq, Eq Fixity
Fixity -> Fixity -> Bool
Fixity -> Fixity -> Ordering
Fixity -> Fixity -> Fixity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fixity -> Fixity -> Fixity
$cmin :: Fixity -> Fixity -> Fixity
max :: Fixity -> Fixity -> Fixity
$cmax :: Fixity -> Fixity -> Fixity
>= :: Fixity -> Fixity -> Bool
$c>= :: Fixity -> Fixity -> Bool
> :: Fixity -> Fixity -> Bool
$c> :: Fixity -> Fixity -> Bool
<= :: Fixity -> Fixity -> Bool
$c<= :: Fixity -> Fixity -> Bool
< :: Fixity -> Fixity -> Bool
$c< :: Fixity -> Fixity -> Bool
compare :: Fixity -> Fixity -> Ordering
$ccompare :: Fixity -> Fixity -> Ordering
Ord, Typeable Fixity
Fixity -> DataType
Fixity -> Constr
(forall b. Data b => b -> b) -> Fixity -> Fixity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Fixity -> u
forall u. (forall d. Data d => d -> u) -> Fixity -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixity -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixity -> c Fixity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixity)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fixity -> m Fixity
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fixity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fixity -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Fixity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Fixity -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Fixity -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Fixity -> r
gmapT :: (forall b. Data b => b -> b) -> Fixity -> Fixity
$cgmapT :: (forall b. Data b => b -> b) -> Fixity -> Fixity
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fixity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fixity)
dataTypeOf :: Fixity -> DataType
$cdataTypeOf :: Fixity -> DataType
toConstr :: Fixity -> Constr
$ctoConstr :: Fixity -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fixity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixity -> c Fixity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixity -> c Fixity
Data, forall x. Rep Fixity x -> Fixity
forall x. Fixity -> Rep Fixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fixity x -> Fixity
$cfrom :: forall x. Fixity -> Rep Fixity x
Generic, [Fixity] -> Encoding
[Fixity] -> Value
Fixity -> Encoding
Fixity -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Fixity] -> Encoding
$ctoEncodingList :: [Fixity] -> Encoding
toJSONList :: [Fixity] -> Value
$ctoJSONList :: [Fixity] -> Value
toEncoding :: Fixity -> Encoding
$ctoEncoding :: Fixity -> Encoding
toJSON :: Fixity -> Value
$ctoJSON :: Fixity -> Value
ToJSON, Value -> Parser [Fixity]
Value -> Parser Fixity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Fixity]
$cparseJSONList :: Value -> Parser [Fixity]
parseJSON :: Value -> Parser Fixity
$cparseJSON :: Value -> Parser Fixity
FromJSON)

data InfixFixity = NoFix | LeftFix | RightFix deriving (Int -> InfixFixity -> ShowS
[InfixFixity] -> ShowS
InfixFixity -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InfixFixity] -> ShowS
$cshowList :: [InfixFixity] -> ShowS
show :: InfixFixity -> FilePath
$cshow :: InfixFixity -> FilePath
showsPrec :: Int -> InfixFixity -> ShowS
$cshowsPrec :: Int -> InfixFixity -> ShowS
Show, InfixFixity -> InfixFixity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfixFixity -> InfixFixity -> Bool
$c/= :: InfixFixity -> InfixFixity -> Bool
== :: InfixFixity -> InfixFixity -> Bool
$c== :: InfixFixity -> InfixFixity -> Bool
Eq, Eq InfixFixity
InfixFixity -> InfixFixity -> Bool
InfixFixity -> InfixFixity -> Ordering
InfixFixity -> InfixFixity -> InfixFixity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InfixFixity -> InfixFixity -> InfixFixity
$cmin :: InfixFixity -> InfixFixity -> InfixFixity
max :: InfixFixity -> InfixFixity -> InfixFixity
$cmax :: InfixFixity -> InfixFixity -> InfixFixity
>= :: InfixFixity -> InfixFixity -> Bool
$c>= :: InfixFixity -> InfixFixity -> Bool
> :: InfixFixity -> InfixFixity -> Bool
$c> :: InfixFixity -> InfixFixity -> Bool
<= :: InfixFixity -> InfixFixity -> Bool
$c<= :: InfixFixity -> InfixFixity -> Bool
< :: InfixFixity -> InfixFixity -> Bool
$c< :: InfixFixity -> InfixFixity -> Bool
compare :: InfixFixity -> InfixFixity -> Ordering
$ccompare :: InfixFixity -> InfixFixity -> Ordering
Ord, Typeable InfixFixity
InfixFixity -> DataType
InfixFixity -> Constr
(forall b. Data b => b -> b) -> InfixFixity -> InfixFixity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InfixFixity -> u
forall u. (forall d. Data d => d -> u) -> InfixFixity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InfixFixity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InfixFixity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InfixFixity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InfixFixity -> c InfixFixity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InfixFixity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InfixFixity)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InfixFixity -> m InfixFixity
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InfixFixity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InfixFixity -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InfixFixity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InfixFixity -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InfixFixity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InfixFixity -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InfixFixity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InfixFixity -> r
gmapT :: (forall b. Data b => b -> b) -> InfixFixity -> InfixFixity
$cgmapT :: (forall b. Data b => b -> b) -> InfixFixity -> InfixFixity
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InfixFixity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InfixFixity)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InfixFixity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InfixFixity)
dataTypeOf :: InfixFixity -> DataType
$cdataTypeOf :: InfixFixity -> DataType
toConstr :: InfixFixity -> Constr
$ctoConstr :: InfixFixity -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InfixFixity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InfixFixity
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InfixFixity -> c InfixFixity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InfixFixity -> c InfixFixity
Data, forall x. Rep InfixFixity x -> InfixFixity
forall x. InfixFixity -> Rep InfixFixity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InfixFixity x -> InfixFixity
$cfrom :: forall x. InfixFixity -> Rep InfixFixity x
Generic, [InfixFixity] -> Encoding
[InfixFixity] -> Value
InfixFixity -> Encoding
InfixFixity -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InfixFixity] -> Encoding
$ctoEncodingList :: [InfixFixity] -> Encoding
toJSONList :: [InfixFixity] -> Value
$ctoJSONList :: [InfixFixity] -> Value
toEncoding :: InfixFixity -> Encoding
$ctoEncoding :: InfixFixity -> Encoding
toJSON :: InfixFixity -> Value
$ctoJSON :: InfixFixity -> Value
ToJSON, Value -> Parser [InfixFixity]
Value -> Parser InfixFixity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InfixFixity]
$cparseJSONList :: Value -> Parser [InfixFixity]
parseJSON :: Value -> Parser InfixFixity
$cparseJSON :: Value -> Parser InfixFixity
FromJSON)

instance ToJSON Pos where
  toJSON :: Pos -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos

deriving instance ToJSON SourcePos

instance FromJSON Pos where
  parseJSON :: Value -> Parser Pos
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Pos
mkPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

deriving instance FromJSON SourcePos

data Comment pos
  = LineComment pos Text pos
  | BlockComment pos Text pos
  deriving (Int -> Comment pos -> ShowS
forall pos. Show pos => Int -> Comment pos -> ShowS
forall pos. Show pos => [Comment pos] -> ShowS
forall pos. Show pos => Comment pos -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Comment pos] -> ShowS
$cshowList :: forall pos. Show pos => [Comment pos] -> ShowS
show :: Comment pos -> FilePath
$cshow :: forall pos. Show pos => Comment pos -> FilePath
showsPrec :: Int -> Comment pos -> ShowS
$cshowsPrec :: forall pos. Show pos => Int -> Comment pos -> ShowS
Show, Comment pos -> Comment pos -> Bool
forall pos. Eq pos => Comment pos -> Comment pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comment pos -> Comment pos -> Bool
$c/= :: forall pos. Eq pos => Comment pos -> Comment pos -> Bool
== :: Comment pos -> Comment pos -> Bool
$c== :: forall pos. Eq pos => Comment pos -> Comment pos -> Bool
Eq, Comment pos -> Comment pos -> Bool
Comment pos -> Comment pos -> Ordering
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 {pos}. Ord pos => Eq (Comment pos)
forall pos. Ord pos => Comment pos -> Comment pos -> Bool
forall pos. Ord pos => Comment pos -> Comment pos -> Ordering
forall pos. Ord pos => Comment pos -> Comment pos -> Comment pos
min :: Comment pos -> Comment pos -> Comment pos
$cmin :: forall pos. Ord pos => Comment pos -> Comment pos -> Comment pos
max :: Comment pos -> Comment pos -> Comment pos
$cmax :: forall pos. Ord pos => Comment pos -> Comment pos -> Comment pos
>= :: Comment pos -> Comment pos -> Bool
$c>= :: forall pos. Ord pos => Comment pos -> Comment pos -> Bool
> :: Comment pos -> Comment pos -> Bool
$c> :: forall pos. Ord pos => Comment pos -> Comment pos -> Bool
<= :: Comment pos -> Comment pos -> Bool
$c<= :: forall pos. Ord pos => Comment pos -> Comment pos -> Bool
< :: Comment pos -> Comment pos -> Bool
$c< :: forall pos. Ord pos => Comment pos -> Comment pos -> Bool
compare :: Comment pos -> Comment pos -> Ordering
$ccompare :: forall pos. Ord pos => Comment pos -> Comment pos -> Ordering
Ord, Comment pos -> DataType
Comment pos -> Constr
forall {pos}. Data pos => Typeable (Comment pos)
forall pos. Data pos => Comment pos -> DataType
forall pos. Data pos => Comment pos -> Constr
forall pos.
Data pos =>
(forall b. Data b => b -> b) -> Comment pos -> Comment pos
forall pos u.
Data pos =>
Int -> (forall d. Data d => d -> u) -> Comment pos -> u
forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> Comment pos -> [u]
forall pos r r'.
Data pos =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment pos -> r
forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment pos -> r
forall pos (m :: * -> *).
(Data pos, Monad m) =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
forall pos (c :: * -> *).
Data pos =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comment pos)
forall pos (c :: * -> *).
Data pos =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment pos -> c (Comment pos)
forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Comment pos))
forall pos (t :: * -> * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comment pos))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comment pos)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment pos -> c (Comment pos)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Comment pos))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
$cgmapMo :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
$cgmapMp :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
$cgmapM :: forall pos (m :: * -> *).
(Data pos, Monad m) =>
(forall d. Data d => d -> m d) -> Comment pos -> m (Comment pos)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Comment pos -> u
$cgmapQi :: forall pos u.
Data pos =>
Int -> (forall d. Data d => d -> u) -> Comment pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Comment pos -> [u]
$cgmapQ :: forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> Comment pos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment pos -> r
$cgmapQr :: forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Comment pos -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment pos -> r
$cgmapQl :: forall pos r r'.
Data pos =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Comment pos -> r
gmapT :: (forall b. Data b => b -> b) -> Comment pos -> Comment pos
$cgmapT :: forall pos.
Data pos =>
(forall b. Data b => b -> b) -> Comment pos -> Comment pos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comment pos))
$cdataCast2 :: forall pos (t :: * -> * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Comment pos))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Comment pos))
$cdataCast1 :: forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Comment pos))
dataTypeOf :: Comment pos -> DataType
$cdataTypeOf :: forall pos. Data pos => Comment pos -> DataType
toConstr :: Comment pos -> Constr
$ctoConstr :: forall pos. Data pos => Comment pos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comment pos)
$cgunfold :: forall pos (c :: * -> *).
Data pos =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Comment pos)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment pos -> c (Comment pos)
$cgfoldl :: forall pos (c :: * -> *).
Data pos =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Comment pos -> c (Comment pos)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall pos x. Rep (Comment pos) x -> Comment pos
forall pos x. Comment pos -> Rep (Comment pos) x
$cto :: forall pos x. Rep (Comment pos) x -> Comment pos
$cfrom :: forall pos x. Comment pos -> Rep (Comment pos) x
Generic, forall a b. a -> Comment b -> Comment a
forall a b. (a -> b) -> Comment a -> Comment b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Comment b -> Comment a
$c<$ :: forall a b. a -> Comment b -> Comment a
fmap :: forall a b. (a -> b) -> Comment a -> Comment b
$cfmap :: forall a b. (a -> b) -> Comment a -> Comment b
Functor, forall a. Eq a => a -> Comment a -> Bool
forall a. Num a => Comment a -> a
forall a. Ord a => Comment a -> a
forall m. Monoid m => Comment m -> m
forall a. Comment a -> Bool
forall a. Comment a -> Int
forall a. Comment a -> [a]
forall a. (a -> a -> a) -> Comment a -> a
forall m a. Monoid m => (a -> m) -> Comment a -> m
forall b a. (b -> a -> b) -> b -> Comment a -> b
forall a b. (a -> b -> b) -> b -> Comment 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
product :: forall a. Num a => Comment a -> a
$cproduct :: forall a. Num a => Comment a -> a
sum :: forall a. Num a => Comment a -> a
$csum :: forall a. Num a => Comment a -> a
minimum :: forall a. Ord a => Comment a -> a
$cminimum :: forall a. Ord a => Comment a -> a
maximum :: forall a. Ord a => Comment a -> a
$cmaximum :: forall a. Ord a => Comment a -> a
elem :: forall a. Eq a => a -> Comment a -> Bool
$celem :: forall a. Eq a => a -> Comment a -> Bool
length :: forall a. Comment a -> Int
$clength :: forall a. Comment a -> Int
null :: forall a. Comment a -> Bool
$cnull :: forall a. Comment a -> Bool
toList :: forall a. Comment a -> [a]
$ctoList :: forall a. Comment a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Comment a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Comment a -> a
foldr1 :: forall a. (a -> a -> a) -> Comment a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Comment a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Comment a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Comment a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Comment a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Comment a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Comment a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Comment a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Comment a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Comment a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Comment a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Comment a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Comment a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Comment a -> m
fold :: forall m. Monoid m => Comment m -> m
$cfold :: forall m. Monoid m => Comment m -> m
Foldable, forall pos. ToJSON pos => [Comment pos] -> Encoding
forall pos. ToJSON pos => [Comment pos] -> Value
forall pos. ToJSON pos => Comment pos -> Encoding
forall pos. ToJSON pos => Comment pos -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Comment pos] -> Encoding
$ctoEncodingList :: forall pos. ToJSON pos => [Comment pos] -> Encoding
toJSONList :: [Comment pos] -> Value
$ctoJSONList :: forall pos. ToJSON pos => [Comment pos] -> Value
toEncoding :: Comment pos -> Encoding
$ctoEncoding :: forall pos. ToJSON pos => Comment pos -> Encoding
toJSON :: Comment pos -> Value
$ctoJSON :: forall pos. ToJSON pos => Comment pos -> Value
ToJSON, forall pos. FromJSON pos => Value -> Parser [Comment pos]
forall pos. FromJSON pos => Value -> Parser (Comment pos)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Comment pos]
$cparseJSONList :: forall pos. FromJSON pos => Value -> Parser [Comment pos]
parseJSON :: Value -> Parser (Comment pos)
$cparseJSON :: forall pos. FromJSON pos => Value -> Parser (Comment pos)
FromJSON)

instance Pretty (Comment a) where
  pretty :: forall ann. Comment a -> Doc ann
pretty = \case
    LineComment a
_ Text
str a
_ -> (Doc ann
"//" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
str)
    BlockComment a
_ Text
str a
_ -> forall ann. [Doc ann] -> Doc ann
encloseComment forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
"\n" forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip Text
str
    where
      encloseComment :: [Doc ann] -> Doc ann
encloseComment [Doc ann]
ds = case [Doc ann]
ds of
        [] -> Doc ann
"/*  */"
        [Doc ann
d] -> Doc ann
"/*" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
d forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"*/"
        [Doc ann]
_ -> forall ann. [Doc ann] -> Doc ann
hardVcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Semigroup a => a -> a -> a
(<>) (Doc ann
"/* " forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. Monoid a => a
mempty) [Doc ann]
ds) forall a. Semigroup a => a -> a -> a
<> Doc ann
" */"

      hardVcat :: [Doc ann] -> Doc ann
      hardVcat :: forall ann. [Doc ann] -> Doc ann
hardVcat = forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
y)

data Lit
  = LInt Int64
  | LDouble Double
  | LText Text
  | LHex Word64
  deriving (Int -> Lit -> ShowS
[Lit] -> ShowS
Lit -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Lit] -> ShowS
$cshowList :: [Lit] -> ShowS
show :: Lit -> FilePath
$cshow :: Lit -> FilePath
showsPrec :: Int -> Lit -> ShowS
$cshowsPrec :: Int -> Lit -> ShowS
Show, Lit -> Lit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lit -> Lit -> Bool
$c/= :: Lit -> Lit -> Bool
== :: Lit -> Lit -> Bool
$c== :: Lit -> Lit -> Bool
Eq, Eq Lit
Lit -> Lit -> Bool
Lit -> Lit -> Ordering
Lit -> Lit -> Lit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Lit -> Lit -> Lit
$cmin :: Lit -> Lit -> Lit
max :: Lit -> Lit -> Lit
$cmax :: Lit -> Lit -> Lit
>= :: Lit -> Lit -> Bool
$c>= :: Lit -> Lit -> Bool
> :: Lit -> Lit -> Bool
$c> :: Lit -> Lit -> Bool
<= :: Lit -> Lit -> Bool
$c<= :: Lit -> Lit -> Bool
< :: Lit -> Lit -> Bool
$c< :: Lit -> Lit -> Bool
compare :: Lit -> Lit -> Ordering
$ccompare :: Lit -> Lit -> Ordering
Ord, Typeable Lit
Lit -> DataType
Lit -> Constr
(forall b. Data b => b -> b) -> Lit -> Lit
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Lit -> u
forall u. (forall d. Data d => d -> u) -> Lit -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lit -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lit -> c Lit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lit)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lit -> m Lit
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lit -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Lit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Lit -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Lit -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Lit -> r
gmapT :: (forall b. Data b => b -> b) -> Lit -> Lit
$cgmapT :: (forall b. Data b => b -> b) -> Lit -> Lit
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lit)
dataTypeOf :: Lit -> DataType
$cdataTypeOf :: Lit -> DataType
toConstr :: Lit -> Constr
$ctoConstr :: Lit -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lit -> c Lit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lit -> c Lit
Data, forall x. Rep Lit x -> Lit
forall x. Lit -> Rep Lit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Lit x -> Lit
$cfrom :: forall x. Lit -> Rep Lit x
Generic, [Lit] -> Encoding
[Lit] -> Value
Lit -> Encoding
Lit -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Lit] -> Encoding
$ctoEncodingList :: [Lit] -> Encoding
toJSONList :: [Lit] -> Value
$ctoJSONList :: [Lit] -> Value
toEncoding :: Lit -> Encoding
$ctoEncoding :: Lit -> Encoding
toJSON :: Lit -> Value
$ctoJSON :: Lit -> Value
ToJSON, Value -> Parser [Lit]
Value -> Parser Lit
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Lit]
$cparseJSONList :: Value -> Parser [Lit]
parseJSON :: Value -> Parser Lit
$cparseJSON :: Value -> Parser Lit
FromJSON)

instance Pretty Lit where
  pretty :: forall ann. Lit -> Doc ann
pretty = \case
    LInt Int64
i -> if Int64
i forall a. Ord a => a -> a -> Bool
< Int64
0 then Doc ann
"(" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int64
i forall a. Semigroup a => a -> a -> a
<> Doc ann
")" else forall a ann. Pretty a => a -> Doc ann
pretty Int64
i
    LDouble Double
d -> if Double
d forall a. Ord a => a -> a -> Bool
< Double
0 then Doc ann
"(" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Double
d forall a. Semigroup a => a -> a -> a
<> Doc ann
")" else forall a ann. Pretty a => a -> Doc ann
pretty Double
d
    LText Text
t -> forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Text
t
    LHex Word64
w -> Doc ann
"0x" forall a. Semigroup a => a -> a -> a
<> (forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> ShowS
showHex Word64
w FilePath
"")

instance ElementPosition Lit where
  elementPosition :: SourcePos -> Lit -> (SourcePos, SourcePos)
elementPosition SourcePos
pos Lit
l = (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Lit
l)

data TList a = TNil | TCons a a [a]
  deriving (Int -> TList a -> ShowS
forall a. Show a => Int -> TList a -> ShowS
forall a. Show a => [TList a] -> ShowS
forall a. Show a => TList a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TList a] -> ShowS
$cshowList :: forall a. Show a => [TList a] -> ShowS
show :: TList a -> FilePath
$cshow :: forall a. Show a => TList a -> FilePath
showsPrec :: Int -> TList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TList a -> ShowS
Show, TList a -> TList a -> Bool
forall a. Eq a => TList a -> TList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TList a -> TList a -> Bool
$c/= :: forall a. Eq a => TList a -> TList a -> Bool
== :: TList a -> TList a -> Bool
$c== :: forall a. Eq a => TList a -> TList a -> Bool
Eq, TList a -> TList a -> Bool
TList a -> TList a -> Ordering
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 (TList a)
forall a. Ord a => TList a -> TList a -> Bool
forall a. Ord a => TList a -> TList a -> Ordering
forall a. Ord a => TList a -> TList a -> TList a
min :: TList a -> TList a -> TList a
$cmin :: forall a. Ord a => TList a -> TList a -> TList a
max :: TList a -> TList a -> TList a
$cmax :: forall a. Ord a => TList a -> TList a -> TList a
>= :: TList a -> TList a -> Bool
$c>= :: forall a. Ord a => TList a -> TList a -> Bool
> :: TList a -> TList a -> Bool
$c> :: forall a. Ord a => TList a -> TList a -> Bool
<= :: TList a -> TList a -> Bool
$c<= :: forall a. Ord a => TList a -> TList a -> Bool
< :: TList a -> TList a -> Bool
$c< :: forall a. Ord a => TList a -> TList a -> Bool
compare :: TList a -> TList a -> Ordering
$ccompare :: forall a. Ord a => TList a -> TList a -> Ordering
Ord, forall a b. a -> TList b -> TList a
forall a b. (a -> b) -> TList a -> TList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TList b -> TList a
$c<$ :: forall a b. a -> TList b -> TList a
fmap :: forall a b. (a -> b) -> TList a -> TList b
$cfmap :: forall a b. (a -> b) -> TList a -> TList b
Functor, forall a. Eq a => a -> TList a -> Bool
forall a. Num a => TList a -> a
forall a. Ord a => TList a -> a
forall m. Monoid m => TList m -> m
forall a. TList a -> Bool
forall a. TList a -> Int
forall a. TList a -> [a]
forall a. (a -> a -> a) -> TList a -> a
forall m a. Monoid m => (a -> m) -> TList a -> m
forall b a. (b -> a -> b) -> b -> TList a -> b
forall a b. (a -> b -> b) -> b -> TList 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
product :: forall a. Num a => TList a -> a
$cproduct :: forall a. Num a => TList a -> a
sum :: forall a. Num a => TList a -> a
$csum :: forall a. Num a => TList a -> a
minimum :: forall a. Ord a => TList a -> a
$cminimum :: forall a. Ord a => TList a -> a
maximum :: forall a. Ord a => TList a -> a
$cmaximum :: forall a. Ord a => TList a -> a
elem :: forall a. Eq a => a -> TList a -> Bool
$celem :: forall a. Eq a => a -> TList a -> Bool
length :: forall a. TList a -> Int
$clength :: forall a. TList a -> Int
null :: forall a. TList a -> Bool
$cnull :: forall a. TList a -> Bool
toList :: forall a. TList a -> [a]
$ctoList :: forall a. TList a -> [a]
foldl1 :: forall a. (a -> a -> a) -> TList a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> TList a -> a
foldr1 :: forall a. (a -> a -> a) -> TList a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> TList a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> TList a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> TList a -> b
foldl :: forall b a. (b -> a -> b) -> b -> TList a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> TList a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> TList a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> TList a -> b
foldr :: forall a b. (a -> b -> b) -> b -> TList a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> TList a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> TList a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> TList a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> TList a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> TList a -> m
fold :: forall m. Monoid m => TList m -> m
$cfold :: forall m. Monoid m => TList m -> m
Foldable, TList a -> DataType
TList a -> Constr
forall {a}. Data a => Typeable (TList a)
forall a. Data a => TList a -> DataType
forall a. Data a => TList a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> TList a -> TList a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> TList a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> TList a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TList a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TList a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TList a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TList a -> c (TList a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TList a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (TList a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TList a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TList a -> c (TList a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TList a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> TList a -> m (TList a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TList a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> TList a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TList a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> TList a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TList a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TList a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TList a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TList a -> r
gmapT :: (forall b. Data b => b -> b) -> TList a -> TList a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> TList a -> TList a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (TList a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (TList a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TList a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TList a))
dataTypeOf :: TList a -> DataType
$cdataTypeOf :: forall a. Data a => TList a -> DataType
toConstr :: TList a -> Constr
$ctoConstr :: forall a. Data a => TList a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TList a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TList a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TList a -> c (TList a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TList a -> c (TList a)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TList a) x -> TList a
forall a x. TList a -> Rep (TList a) x
$cto :: forall a x. Rep (TList a) x -> TList a
$cfrom :: forall a x. TList a -> Rep (TList a) x
Generic, forall a. ToJSON a => [TList a] -> Encoding
forall a. ToJSON a => [TList a] -> Value
forall a. ToJSON a => TList a -> Encoding
forall a. ToJSON a => TList a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TList a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [TList a] -> Encoding
toJSONList :: [TList a] -> Value
$ctoJSONList :: forall a. ToJSON a => [TList a] -> Value
toEncoding :: TList a -> Encoding
$ctoEncoding :: forall a. ToJSON a => TList a -> Encoding
toJSON :: TList a -> Value
$ctoJSON :: forall a. ToJSON a => TList a -> Value
ToJSON, forall a. FromJSON a => Value -> Parser [TList a]
forall a. FromJSON a => Value -> Parser (TList a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TList a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [TList a]
parseJSON :: Value -> Parser (TList a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (TList a)
FromJSON, forall a. NFData a => TList a -> ()
forall a. (a -> ()) -> NFData a
rnf :: TList a -> ()
$crnf :: forall a. NFData a => TList a -> ()
NFData, forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {a}. Hashable a => Eq (TList a)
forall a. Hashable a => Int -> TList a -> Int
forall a. Hashable a => TList a -> Int
hash :: TList a -> Int
$chash :: forall a. Hashable a => TList a -> Int
hashWithSalt :: Int -> TList a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> TList a -> Int
Hashable, forall a.
Arbitrary a =>
Proxy (TList a) -> Gen (ADTArbitrarySingleton (TList a))
forall a.
Arbitrary a =>
Proxy (TList a) -> Gen (ADTArbitrary (TList a))
forall a.
(Proxy a -> Gen (ADTArbitrarySingleton a))
-> (Proxy a -> Gen (ADTArbitrary a)) -> ToADTArbitrary a
toADTArbitrary :: Proxy (TList a) -> Gen (ADTArbitrary (TList a))
$ctoADTArbitrary :: forall a.
Arbitrary a =>
Proxy (TList a) -> Gen (ADTArbitrary (TList a))
toADTArbitrarySingleton :: Proxy (TList a) -> Gen (ADTArbitrarySingleton (TList a))
$ctoADTArbitrarySingleton :: forall a.
Arbitrary a =>
Proxy (TList a) -> Gen (ADTArbitrarySingleton (TList a))
ToADTArbitrary)
  deriving anyclass (forall a. Serialize a => Get (TList a)
forall a. Serialize a => Putter (TList a)
forall t. Putter t -> Get t -> Serialize t
get :: Get (TList a)
$cget :: forall a. Serialize a => Get (TList a)
put :: Putter (TList a)
$cput :: forall a. Serialize a => Putter (TList a)
Serialize)

instance Arbitrary a => Arbitrary (TList a) where
  arbitrary :: Gen (TList a)
arbitrary =
    forall a. [Gen a] -> Gen a
oneof
      [ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. TList a
TNil,
        forall a. a -> a -> [a] -> TList a
TCons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Traversable TList where
  {-# INLINE traverse #-} -- so that traverse can fuse
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TList a -> f (TList b)
traverse a -> f b
f = \case
    TList a
TNil -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. TList a
TNil
    TCons a
x a
y [a]
zs -> forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 forall a. a -> a -> [a] -> TList a
TCons (a -> f b
f a
x) (a -> f b
f a
y) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
zs)

tListToList :: TList a -> [a]
tListToList :: forall a. TList a -> [a]
tListToList = \case
  TList a
TNil -> []
  TCons a
a a
b [a]
cs -> a
a forall a. a -> [a] -> [a]
: a
b forall a. a -> [a] -> [a]
: [a]
cs

tListFromList :: [a] -> TList a
tListFromList :: forall a. [a] -> TList a
tListFromList = \case
  [] -> forall a. TList a
TNil
  (a
a : a
b : [a]
cs) -> forall a. a -> a -> [a] -> TList a
TCons a
a a
b [a]
cs
  [a]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"undefined TList"

data IStr (f :: Bool) e where
  ISEmpty :: IStr 'True e
  ISStr :: Text -> IStr 'True e -> IStr 'False e
  ISExpr :: Typeable f => e -> IStr f e -> IStr 'True e

instance (Typeable f, Data e) => Data (IStr f e) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IStr f e -> c (IStr f e)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
_ forall g. g -> c g
z IStr f e
ISEmpty = forall g. g -> c g
z forall e. IStr 'True e
ISEmpty
  gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z (ISStr Text
s IStr 'True e
xs) = forall g. g -> c g
z forall e. Text -> IStr 'True e -> IStr 'False e
ISStr forall d b. Data d => c (d -> b) -> d -> c b
`k` Text
s forall d b. Data d => c (d -> b) -> d -> c b
`k` IStr 'True e
xs
  gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z (ISExpr e
e IStr f e
xs) = forall g. g -> c g
z forall (f :: Bool) e. Typeable f => e -> IStr f e -> IStr 'True e
ISExpr forall d b. Data d => c (d -> b) -> d -> c b
`k` e
e forall d b. Data d => c (d -> b) -> d -> c b
`k` IStr f e
xs

  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IStr f e)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ =
    forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$
      FilePath
"Cannot derive a gunfold instance without unsafeCoerce.\n"
        forall a. Semigroup a => a -> a -> a
<> FilePath
"If this function is needed, try uncommenting the lines below. However, this definition might not be correct."

  -- where
  --   gunfold' :: forall c. (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (IStr f e)
  --   gunfold' k z c = case constrIndex c of
  --     1 -> unsafeCoerce $ z ISEmpty
  --     2 -> unsafeCoerce $ k (k (z ISStr) :: Typeable f => c (IStr 'True e -> IStr 'False e))
  --     _ -> unsafeCoerce $ k (k (z ISExpr) :: Typeable f => c (IStr f e -> IStr 'True e))

  toConstr :: IStr f e -> Constr
toConstr IStr f e
ISEmpty = Constr
con_ISEmpty
  toConstr (ISStr Text
_ IStr 'True e
_) = Constr
con_ISStr
  toConstr (ISExpr e
_ IStr f e
_) = Constr
con_ISExpr

  dataTypeOf :: IStr f e -> DataType
dataTypeOf IStr f e
_ = DataType
ty_IStr
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (IStr f e))
dataCast1 forall d. Data d => c (t d)
f = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f

con_ISEmpty, con_ISStr, con_ISExpr :: Constr
con_ISEmpty :: Constr
con_ISEmpty = DataType -> FilePath -> [FilePath] -> Fixity -> Constr
mkConstr DataType
ty_IStr FilePath
"ISEmpty" [] Fixity
Data.Prefix
con_ISStr :: Constr
con_ISStr = DataType -> FilePath -> [FilePath] -> Fixity -> Constr
mkConstr DataType
ty_IStr FilePath
"ISStr" [] Fixity
Data.Prefix
con_ISExpr :: Constr
con_ISExpr = DataType -> FilePath -> [FilePath] -> Fixity -> Constr
mkConstr DataType
ty_IStr FilePath
"ISExpr" [] Fixity
Data.Prefix

ty_IStr :: Data.DataType
ty_IStr :: DataType
ty_IStr = FilePath -> [Constr] -> DataType
mkDataType FilePath
"Inferno.Syntax.IStr" [Constr
con_ISEmpty, Constr
con_ISStr, Constr
con_ISExpr]

deriving instance Show e => Show (IStr f e)

deriving instance Functor (IStr f)

deriving instance Foldable (IStr f)

instance Traversable (IStr f) where
  {-# INLINE traverse #-} -- so that traverse can fuse
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IStr f a -> f (IStr f b)
traverse a -> f b
f = \case
    IStr f a
ISEmpty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall e. IStr 'True e
ISEmpty
    ISStr Text
s IStr 'True a
xs -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA (forall e. Text -> IStr 'True e -> IStr 'False e
ISStr Text
s) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IStr 'True a
xs)
    ISExpr a
e IStr f a
xs -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: Bool) e. Typeable f => e -> IStr f e -> IStr 'True e
ISExpr (a -> f b
f a
e) (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IStr f a
xs)

data SomeIStr e = forall f. Typeable f => SomeIStr (IStr f e)

instance Data e => Data (SomeIStr e) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SomeIStr e -> c (SomeIStr e)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z (SomeIStr IStr f e
xs) = forall g. g -> c g
z forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall d b. Data d => c (d -> b) -> d -> c b
`k` IStr f e
xs

  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SomeIStr e)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ =
    forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$
      FilePath
"Cannot derive a gunfold instance without unsafeCoerce.\n"
        forall a. Semigroup a => a -> a -> a
<> FilePath
"If this function is needed, try uncommenting the lines below. However, this definition might not be correct."

  -- where
  --   gunfold' :: forall c. (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (SomeIStr e)
  --   gunfold' k z _ = k (z SomeIStr :: c (IStr 'False e -> SomeIStr e))

  toConstr :: SomeIStr e -> Constr
toConstr SomeIStr e
_ = Constr
con_SomeIStr
  dataTypeOf :: SomeIStr e -> DataType
dataTypeOf SomeIStr e
_ = DataType
ty_SomeIStr
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SomeIStr e))
dataCast1 forall d. Data d => c (t d)
f = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f

con_SomeIStr :: Constr
con_SomeIStr :: Constr
con_SomeIStr = DataType -> FilePath -> [FilePath] -> Fixity -> Constr
mkConstr DataType
ty_SomeIStr FilePath
"SomeIStr" [] Fixity
Data.Prefix

ty_SomeIStr :: Data.DataType
ty_SomeIStr :: DataType
ty_SomeIStr = FilePath -> [Constr] -> DataType
mkDataType FilePath
"Inferno.Syntax.SomeIStr" [Constr
con_SomeIStr]

deriving instance Show e => Show (SomeIStr e)

instance Eq e => Eq (SomeIStr e) where
  (SomeIStr IStr f e
ISEmpty) == :: SomeIStr e -> SomeIStr e -> Bool
== (SomeIStr IStr f e
ISEmpty) = Bool
True
  (SomeIStr (ISStr Text
s1 IStr 'True e
xs)) == (SomeIStr (ISStr Text
s2 IStr 'True e
ys)) =
    (Text
s1 forall a. Eq a => a -> a -> Bool
== Text
s2) Bool -> Bool -> Bool
&& (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr 'True e
xs) forall a. Eq a => a -> a -> Bool
== (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr 'True e
ys)
  (SomeIStr (ISExpr e
e1 IStr f e
xs)) == (SomeIStr (ISExpr e
e2 IStr f e
ys)) =
    (e
e1 forall a. Eq a => a -> a -> Bool
== e
e2) Bool -> Bool -> Bool
&& (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr f e
xs) forall a. Eq a => a -> a -> Bool
== (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr f e
ys)
  SomeIStr e
_ == SomeIStr e
_ = Bool
False

instance Ord e => Ord (SomeIStr e) where
  compare :: SomeIStr e -> SomeIStr e -> Ordering
compare (SomeIStr IStr f e
ISEmpty) (SomeIStr IStr f e
ISEmpty) = Ordering
EQ
  compare (SomeIStr IStr f e
ISEmpty) SomeIStr e
_ = Ordering
LT
  compare SomeIStr e
_ (SomeIStr IStr f e
ISEmpty) = Ordering
GT
  compare (SomeIStr (ISStr Text
_ IStr 'True e
_)) (SomeIStr (ISExpr e
_ IStr f e
_)) = Ordering
LT
  compare (SomeIStr (ISExpr e
_ IStr f e
_)) (SomeIStr (ISStr Text
_ IStr 'True e
_)) = Ordering
GT
  compare (SomeIStr (ISStr Text
s IStr 'True e
xs)) (SomeIStr (ISStr Text
t IStr 'True e
ys)) = case forall a. Ord a => a -> a -> Ordering
compare Text
s Text
t of
    Ordering
EQ -> forall a. Ord a => a -> a -> Ordering
compare (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr 'True e
xs) (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr 'True e
ys)
    Ordering
other -> Ordering
other
  compare (SomeIStr (ISExpr e
e IStr f e
xs)) (SomeIStr (ISExpr e
f IStr f e
ys)) = case forall a. Ord a => a -> a -> Ordering
compare e
e e
f of
    Ordering
EQ -> forall a. Ord a => a -> a -> Ordering
compare (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr f e
xs) (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr f e
ys)
    Ordering
other -> Ordering
other

deriving instance Functor SomeIStr

deriving instance Foldable SomeIStr

toEitherList :: SomeIStr e -> [Either Text e]
toEitherList :: forall e. SomeIStr e -> [Either Text e]
toEitherList = \case
  SomeIStr IStr f e
ISEmpty -> []
  SomeIStr (ISStr Text
s IStr 'True e
ys) -> forall a b. a -> Either a b
Left Text
s forall a. a -> [a] -> [a]
: forall e. SomeIStr e -> [Either Text e]
toEitherList (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr 'True e
ys)
  SomeIStr (ISExpr e
e IStr f e
ys) -> forall a b. b -> Either a b
Right e
e forall a. a -> [a] -> [a]
: forall e. SomeIStr e -> [Either Text e]
toEitherList (forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr IStr f e
ys)

fromEitherList :: [Either Text e] -> SomeIStr e
fromEitherList :: forall e. [Either Text e] -> SomeIStr e
fromEitherList = \case
  [] -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr (forall e. IStr 'True e
ISEmpty :: IStr 'True e)
  Left Text
s : [Either Text e]
xs -> case forall e. [Either Text e] -> SomeIStr e
fromEitherList [Either Text e]
xs of
    SomeIStr IStr f e
ISEmpty -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall e. Text -> IStr 'True e -> IStr 'False e
ISStr Text
s forall e. IStr 'True e
ISEmpty
    SomeIStr (ISStr Text
s' IStr 'True e
xs') -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall e. Text -> IStr 'True e -> IStr 'False e
ISStr (Text
s forall a. Semigroup a => a -> a -> a
<> Text
s') IStr 'True e
xs'
    SomeIStr rest :: IStr f e
rest@(ISExpr e
_ IStr f e
_) -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall e. Text -> IStr 'True e -> IStr 'False e
ISStr Text
s IStr f e
rest
  Right e
e : [Either Text e]
xs -> case forall e. [Either Text e] -> SomeIStr e
fromEitherList [Either Text e]
xs of
    SomeIStr IStr f e
rest -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall (f :: Bool) e. Typeable f => e -> IStr f e -> IStr 'True e
ISExpr e
e IStr f e
rest

instance FromJSON e => FromJSON (SomeIStr e) where
  parseJSON :: Value -> Parser (SomeIStr e)
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e. [Either Text e] -> SomeIStr e
fromEitherList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON e => ToJSON (SomeIStr e) where
  toJSON :: SomeIStr e -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. SomeIStr e -> [Either Text e]
toEitherList

instance Traversable SomeIStr where
  {-# INLINE traverse #-} -- so that traverse can fuse
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SomeIStr a -> f (SomeIStr b)
traverse a -> f b
f = \case
    SomeIStr (IStr f a
ISEmpty :: IStr f a) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr (forall e. IStr 'True e
ISEmpty :: IStr f b)
    SomeIStr (ISStr Text
s IStr 'True a
xs) -> do
      IStr 'True b
res <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IStr 'True a
xs
      pure $ case IStr 'True b
res of
        IStr 'True b
ISEmpty -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall e. Text -> IStr 'True e -> IStr 'False e
ISStr Text
s forall e. IStr 'True e
ISEmpty
        rest :: IStr 'True b
rest@(ISExpr b
_ IStr f b
_) -> forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall e. Text -> IStr 'True e -> IStr 'False e
ISStr Text
s IStr 'True b
rest
    SomeIStr (ISExpr a
e IStr f a
xs) -> do
      b
e' <- a -> f b
f a
e
      IStr f b
res <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f IStr f a
xs
      pure $ forall e (f :: Bool). Typeable f => IStr f e -> SomeIStr e
SomeIStr forall a b. (a -> b) -> a -> b
$ forall (f :: Bool) e. Typeable f => e -> IStr f e -> IStr 'True e
ISExpr b
e' IStr f b
res

data Import pos
  = IVar pos Ident
  | IOpVar pos Ident
  | IEnum
      pos -- position of `enum`
      pos -- position of ident
      Ident
  | ICommentAbove (Comment pos) (Import pos)
  | ICommentAfter (Import pos) (Comment pos)
  | ICommentBelow (Import pos) (Comment pos)
  deriving (Int -> Import pos -> ShowS
forall pos. Show pos => Int -> Import pos -> ShowS
forall pos. Show pos => [Import pos] -> ShowS
forall pos. Show pos => Import pos -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Import pos] -> ShowS
$cshowList :: forall pos. Show pos => [Import pos] -> ShowS
show :: Import pos -> FilePath
$cshow :: forall pos. Show pos => Import pos -> FilePath
showsPrec :: Int -> Import pos -> ShowS
$cshowsPrec :: forall pos. Show pos => Int -> Import pos -> ShowS
Show, Import pos -> Import pos -> Bool
forall pos. Eq pos => Import pos -> Import pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import pos -> Import pos -> Bool
$c/= :: forall pos. Eq pos => Import pos -> Import pos -> Bool
== :: Import pos -> Import pos -> Bool
$c== :: forall pos. Eq pos => Import pos -> Import pos -> Bool
Eq, Import pos -> Import pos -> Ordering
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 {pos}. Ord pos => Eq (Import pos)
forall pos. Ord pos => Import pos -> Import pos -> Bool
forall pos. Ord pos => Import pos -> Import pos -> Ordering
forall pos. Ord pos => Import pos -> Import pos -> Import pos
min :: Import pos -> Import pos -> Import pos
$cmin :: forall pos. Ord pos => Import pos -> Import pos -> Import pos
max :: Import pos -> Import pos -> Import pos
$cmax :: forall pos. Ord pos => Import pos -> Import pos -> Import pos
>= :: Import pos -> Import pos -> Bool
$c>= :: forall pos. Ord pos => Import pos -> Import pos -> Bool
> :: Import pos -> Import pos -> Bool
$c> :: forall pos. Ord pos => Import pos -> Import pos -> Bool
<= :: Import pos -> Import pos -> Bool
$c<= :: forall pos. Ord pos => Import pos -> Import pos -> Bool
< :: Import pos -> Import pos -> Bool
$c< :: forall pos. Ord pos => Import pos -> Import pos -> Bool
compare :: Import pos -> Import pos -> Ordering
$ccompare :: forall pos. Ord pos => Import pos -> Import pos -> Ordering
Ord, forall a b. a -> Import b -> Import a
forall a b. (a -> b) -> Import a -> Import b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Import b -> Import a
$c<$ :: forall a b. a -> Import b -> Import a
fmap :: forall a b. (a -> b) -> Import a -> Import b
$cfmap :: forall a b. (a -> b) -> Import a -> Import b
Functor, forall a. Eq a => a -> Import a -> Bool
forall a. Num a => Import a -> a
forall a. Ord a => Import a -> a
forall m. Monoid m => Import m -> m
forall a. Import a -> Bool
forall a. Import a -> Int
forall a. Import a -> [a]
forall a. (a -> a -> a) -> Import a -> a
forall m a. Monoid m => (a -> m) -> Import a -> m
forall b a. (b -> a -> b) -> b -> Import a -> b
forall a b. (a -> b -> b) -> b -> Import 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
product :: forall a. Num a => Import a -> a
$cproduct :: forall a. Num a => Import a -> a
sum :: forall a. Num a => Import a -> a
$csum :: forall a. Num a => Import a -> a
minimum :: forall a. Ord a => Import a -> a
$cminimum :: forall a. Ord a => Import a -> a
maximum :: forall a. Ord a => Import a -> a
$cmaximum :: forall a. Ord a => Import a -> a
elem :: forall a. Eq a => a -> Import a -> Bool
$celem :: forall a. Eq a => a -> Import a -> Bool
length :: forall a. Import a -> Int
$clength :: forall a. Import a -> Int
null :: forall a. Import a -> Bool
$cnull :: forall a. Import a -> Bool
toList :: forall a. Import a -> [a]
$ctoList :: forall a. Import a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Import a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Import a -> a
foldr1 :: forall a. (a -> a -> a) -> Import a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Import a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Import a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Import a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Import a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Import a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Import a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Import a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Import a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Import a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Import a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Import a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Import a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Import a -> m
fold :: forall m. Monoid m => Import m -> m
$cfold :: forall m. Monoid m => Import m -> m
Foldable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall pos x. Rep (Import pos) x -> Import pos
forall pos x. Import pos -> Rep (Import pos) x
$cto :: forall pos x. Rep (Import pos) x -> Import pos
$cfrom :: forall pos x. Import pos -> Rep (Import pos) x
Generic, Import pos -> DataType
Import pos -> Constr
forall {pos}. Data pos => Typeable (Import pos)
forall pos. Data pos => Import pos -> DataType
forall pos. Data pos => Import pos -> Constr
forall pos.
Data pos =>
(forall b. Data b => b -> b) -> Import pos -> Import pos
forall pos u.
Data pos =>
Int -> (forall d. Data d => d -> u) -> Import pos -> u
forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> Import pos -> [u]
forall pos r r'.
Data pos =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Import pos -> r
forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Import pos -> r
forall pos (m :: * -> *).
(Data pos, Monad m) =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
forall pos (c :: * -> *).
Data pos =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Import pos)
forall pos (c :: * -> *).
Data pos =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Import pos -> c (Import pos)
forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Import pos))
forall pos (t :: * -> * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Import pos))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Import pos)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Import pos -> c (Import pos)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Import pos))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
$cgmapMo :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
$cgmapMp :: forall pos (m :: * -> *).
(Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
$cgmapM :: forall pos (m :: * -> *).
(Data pos, Monad m) =>
(forall d. Data d => d -> m d) -> Import pos -> m (Import pos)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Import pos -> u
$cgmapQi :: forall pos u.
Data pos =>
Int -> (forall d. Data d => d -> u) -> Import pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Import pos -> [u]
$cgmapQ :: forall pos u.
Data pos =>
(forall d. Data d => d -> u) -> Import pos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Import pos -> r
$cgmapQr :: forall pos r r'.
Data pos =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Import pos -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Import pos -> r
$cgmapQl :: forall pos r r'.
Data pos =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Import pos -> r
gmapT :: (forall b. Data b => b -> b) -> Import pos -> Import pos
$cgmapT :: forall pos.
Data pos =>
(forall b. Data b => b -> b) -> Import pos -> Import pos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Import pos))
$cdataCast2 :: forall pos (t :: * -> * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Import pos))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Import pos))
$cdataCast1 :: forall pos (t :: * -> *) (c :: * -> *).
(Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Import pos))
dataTypeOf :: Import pos -> DataType
$cdataTypeOf :: forall pos. Data pos => Import pos -> DataType
toConstr :: Import pos -> Constr
$ctoConstr :: forall pos. Data pos => Import pos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Import pos)
$cgunfold :: forall pos (c :: * -> *).
Data pos =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Import pos)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Import pos -> c (Import pos)
$cgfoldl :: forall pos (c :: * -> *).
Data pos =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Import pos -> c (Import pos)
Data, forall pos. ToJSON pos => [Import pos] -> Encoding
forall pos. ToJSON pos => [Import pos] -> Value
forall pos. ToJSON pos => Import pos -> Encoding
forall pos. ToJSON pos => Import pos -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Import pos] -> Encoding
$ctoEncodingList :: forall pos. ToJSON pos => [Import pos] -> Encoding
toJSONList :: [Import pos] -> Value
$ctoJSONList :: forall pos. ToJSON pos => [Import pos] -> Value
toEncoding :: Import pos -> Encoding
$ctoEncoding :: forall pos. ToJSON pos => Import pos -> Encoding
toJSON :: Import pos -> Value
$ctoJSON :: forall pos. ToJSON pos => Import pos -> Value
ToJSON, forall pos. FromJSON pos => Value -> Parser [Import pos]
forall pos. FromJSON pos => Value -> Parser (Import pos)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Import pos]
$cparseJSONList :: forall pos. FromJSON pos => Value -> Parser [Import pos]
parseJSON :: Value -> Parser (Import pos)
$cparseJSON :: forall pos. FromJSON pos => Value -> Parser (Import pos)
FromJSON)

makeBaseFunctor ''Import

data Scoped a = LocalScope | Scope a
  deriving (Int -> Scoped a -> ShowS
forall a. Show a => Int -> Scoped a -> ShowS
forall a. Show a => [Scoped a] -> ShowS
forall a. Show a => Scoped a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Scoped a] -> ShowS
$cshowList :: forall a. Show a => [Scoped a] -> ShowS
show :: Scoped a -> FilePath
$cshow :: forall a. Show a => Scoped a -> FilePath
showsPrec :: Int -> Scoped a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Scoped a -> ShowS
Show, Scoped a -> Scoped a -> Bool
forall a. Eq a => Scoped a -> Scoped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scoped a -> Scoped a -> Bool
$c/= :: forall a. Eq a => Scoped a -> Scoped a -> Bool
== :: Scoped a -> Scoped a -> Bool
$c== :: forall a. Eq a => Scoped a -> Scoped a -> Bool
Eq, Scoped a -> Scoped a -> Bool
Scoped a -> Scoped a -> Ordering
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 (Scoped a)
forall a. Ord a => Scoped a -> Scoped a -> Bool
forall a. Ord a => Scoped a -> Scoped a -> Ordering
forall a. Ord a => Scoped a -> Scoped a -> Scoped a
min :: Scoped a -> Scoped a -> Scoped a
$cmin :: forall a. Ord a => Scoped a -> Scoped a -> Scoped a
max :: Scoped a -> Scoped a -> Scoped a
$cmax :: forall a. Ord a => Scoped a -> Scoped a -> Scoped a
>= :: Scoped a -> Scoped a -> Bool
$c>= :: forall a. Ord a => Scoped a -> Scoped a -> Bool
> :: Scoped a -> Scoped a -> Bool
$c> :: forall a. Ord a => Scoped a -> Scoped a -> Bool
<= :: Scoped a -> Scoped a -> Bool
$c<= :: forall a. Ord a => Scoped a -> Scoped a -> Bool
< :: Scoped a -> Scoped a -> Bool
$c< :: forall a. Ord a => Scoped a -> Scoped a -> Bool
compare :: Scoped a -> Scoped a -> Ordering
$ccompare :: forall a. Ord a => Scoped a -> Scoped a -> Ordering
Ord, forall a b. a -> Scoped b -> Scoped a
forall a b. (a -> b) -> Scoped a -> Scoped b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Scoped b -> Scoped a
$c<$ :: forall a b. a -> Scoped b -> Scoped a
fmap :: forall a b. (a -> b) -> Scoped a -> Scoped b
$cfmap :: forall a b. (a -> b) -> Scoped a -> Scoped b
Functor, forall a. Eq a => a -> Scoped a -> Bool
forall a. Num a => Scoped a -> a
forall a. Ord a => Scoped a -> a
forall m. Monoid m => Scoped m -> m
forall a. Scoped a -> Bool
forall a. Scoped a -> Int
forall a. Scoped a -> [a]
forall a. (a -> a -> a) -> Scoped a -> a
forall m a. Monoid m => (a -> m) -> Scoped a -> m
forall b a. (b -> a -> b) -> b -> Scoped a -> b
forall a b. (a -> b -> b) -> b -> Scoped 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
product :: forall a. Num a => Scoped a -> a
$cproduct :: forall a. Num a => Scoped a -> a
sum :: forall a. Num a => Scoped a -> a
$csum :: forall a. Num a => Scoped a -> a
minimum :: forall a. Ord a => Scoped a -> a
$cminimum :: forall a. Ord a => Scoped a -> a
maximum :: forall a. Ord a => Scoped a -> a
$cmaximum :: forall a. Ord a => Scoped a -> a
elem :: forall a. Eq a => a -> Scoped a -> Bool
$celem :: forall a. Eq a => a -> Scoped a -> Bool
length :: forall a. Scoped a -> Int
$clength :: forall a. Scoped a -> Int
null :: forall a. Scoped a -> Bool
$cnull :: forall a. Scoped a -> Bool
toList :: forall a. Scoped a -> [a]
$ctoList :: forall a. Scoped a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Scoped a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Scoped a -> a
foldr1 :: forall a. (a -> a -> a) -> Scoped a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Scoped a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Scoped a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Scoped a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Scoped a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Scoped a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Scoped a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Scoped a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Scoped a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Scoped a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Scoped a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Scoped a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Scoped a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Scoped a -> m
fold :: forall m. Monoid m => Scoped m -> m
$cfold :: forall m. Monoid m => Scoped m -> m
Foldable, Functor Scoped
Foldable Scoped
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 => Scoped (m a) -> m (Scoped a)
forall (f :: * -> *) a.
Applicative f =>
Scoped (f a) -> f (Scoped a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scoped a -> m (Scoped b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scoped a -> f (Scoped b)
sequence :: forall (m :: * -> *) a. Monad m => Scoped (m a) -> m (Scoped a)
$csequence :: forall (m :: * -> *) a. Monad m => Scoped (m a) -> m (Scoped a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scoped a -> m (Scoped b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scoped a -> m (Scoped b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Scoped (f a) -> f (Scoped a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Scoped (f a) -> f (Scoped a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scoped a -> f (Scoped b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scoped a -> f (Scoped b)
Traversable, Scoped a -> DataType
Scoped a -> Constr
forall {a}. Data a => Typeable (Scoped a)
forall a. Data a => Scoped a -> DataType
forall a. Data a => Scoped a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Scoped a -> Scoped a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Scoped a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Scoped a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scoped a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scoped a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Scoped a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scoped a -> c (Scoped a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Scoped a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Scoped a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Scoped a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scoped a -> c (Scoped a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Scoped a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Scoped a -> m (Scoped a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Scoped a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Scoped a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Scoped a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Scoped a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scoped a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Scoped a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scoped a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Scoped a -> r
gmapT :: (forall b. Data b => b -> b) -> Scoped a -> Scoped a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Scoped a -> Scoped a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Scoped a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Scoped a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Scoped a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Scoped a))
dataTypeOf :: Scoped a -> DataType
$cdataTypeOf :: forall a. Data a => Scoped a -> DataType
toConstr :: Scoped a -> Constr
$ctoConstr :: forall a. Data a => Scoped a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Scoped a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Scoped a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scoped a -> c (Scoped a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Scoped a -> c (Scoped a)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Scoped a) x -> Scoped a
forall a x. Scoped a -> Rep (Scoped a) x
$cto :: forall a x. Rep (Scoped a) x -> Scoped a
$cfrom :: forall a x. Scoped a -> Rep (Scoped a) x
Generic, forall a. ToJSON a => [Scoped a] -> Encoding
forall a. ToJSON a => [Scoped a] -> Value
forall a. ToJSON a => Scoped a -> Encoding
forall a. ToJSON a => Scoped a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Scoped a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Scoped a] -> Encoding
toJSONList :: [Scoped a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Scoped a] -> Value
toEncoding :: Scoped a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Scoped a -> Encoding
toJSON :: Scoped a -> Value
$ctoJSON :: forall a. ToJSON a => Scoped a -> Value
ToJSON, forall a. FromJSON a => Value -> Parser [Scoped a]
forall a. FromJSON a => Value -> Parser (Scoped a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Scoped a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Scoped a]
parseJSON :: Value -> Parser (Scoped a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Scoped a)
FromJSON)

fromScoped :: a -> Scoped a -> a
fromScoped :: forall a. a -> Scoped a -> a
fromScoped a
d = \case
  Scope a
a -> a
a
  Scoped a
LocalScope -> a
d

data Expr hash pos
  = Var
      pos
      hash
      (Scoped ModuleName)
      ImplExpl
  | OpVar pos hash (Scoped ModuleName) Ident -- infix ops like `+` used as prefix, i.e. `(+)`
  | TypeRep pos InfernoType
  | Enum pos hash (Scoped ModuleName) Ident
  | App (Expr hash pos) (Expr hash pos)
  | Lam
      pos -- position of `fun`
      ( NonEmpty
          ( pos, -- position of variable,
            Maybe ExtIdent
          )
      )
      pos -- position of `->`
      (Expr hash pos)
  | Let
      pos -- position of `let`
      pos -- position of variable
      ImplExpl
      pos -- position of `=`
      (Expr hash pos)
      pos -- position of `in`
      (Expr hash pos)
  | Lit pos Lit
  | InterpolatedString
      pos -- position of string start
      (SomeIStr (pos, Expr hash pos, pos))
      pos -- position of string end
  | If
      pos -- position of `if`
      (Expr hash pos)
      pos -- position of then`
      (Expr hash pos)
      pos -- position of `else`
      (Expr hash pos)
  | Op
      (Expr hash pos)
      pos -- position of operator
      hash
      (Int, InfixFixity) -- level and fixity of the operaror
      (Scoped ModuleName)
      Ident
      (Expr hash pos)
  | PreOp
      pos -- position of operator
      hash
      Int -- level of the operaror
      (Scoped ModuleName)
      Ident
      (Expr hash pos)
  | Tuple
      pos -- position of `(`
      (TList (Expr hash pos, Maybe pos))
      pos -- position of `)`
      -- NOTE: the frontend syntax is Some/None but internally we use one/empty for legacy reasons
  | One
      pos -- position of `Some`
      (Expr hash pos)
  | Empty pos -- position of `None`
  | Assert
      pos -- position of `assert`
      (Expr hash pos)
      pos -- position of `in`
      (Expr hash pos)
  | Case
      pos -- position of `match`
      (Expr hash pos)
      pos -- position of `{`
      ( NonEmpty
          ( pos, -- position of `|`
            Pat hash pos,
            pos, -- position of `->`
            Expr hash pos
          )
      )
      pos -- position of `}`
  | Array
      pos -- position of `[`
      [ ( Expr hash pos,
          Maybe pos -- position of `,`
        )
      ]
      pos -- position of `]`
  | ArrayComp
      pos -- position of `[`
      (Expr hash pos)
      pos -- position of `|`
      ( NonEmpty
          ( pos, -- position of identifier
            Ident,
            pos, -- position of `<-`
            Expr hash pos,
            Maybe pos -- position of `,`
          )
      )
      ( Maybe
          ( pos, -- position of `if`
            Expr hash pos
          )
      )
      pos -- position of `]`
  | CommentAbove
      (Comment pos)
      (Expr hash pos)
  | CommentAfter
      (Expr hash pos)
      (Comment pos)
  | CommentBelow
      (Expr hash pos)
      (Comment pos)
  | Bracketed pos (Expr hash pos) pos
  | RenameModule
      pos -- pos of new name
      ModuleName
      pos -- pos of old name
      ModuleName
      pos -- pos of `in`
      (Expr hash pos)
  | OpenModule
      pos
      hash
      ModuleName
      [(Import pos, Maybe pos)]
      pos -- pos of `in`
      (Expr hash pos)
  deriving (Int -> Expr hash pos -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall hash pos.
(Show pos, Show hash) =>
Int -> Expr hash pos -> ShowS
forall hash pos. (Show pos, Show hash) => [Expr hash pos] -> ShowS
forall hash pos. (Show pos, Show hash) => Expr hash pos -> FilePath
showList :: [Expr hash pos] -> ShowS
$cshowList :: forall hash pos. (Show pos, Show hash) => [Expr hash pos] -> ShowS
show :: Expr hash pos -> FilePath
$cshow :: forall hash pos. (Show pos, Show hash) => Expr hash pos -> FilePath
showsPrec :: Int -> Expr hash pos -> ShowS
$cshowsPrec :: forall hash pos.
(Show pos, Show hash) =>
Int -> Expr hash pos -> ShowS
Show, Expr hash pos -> Expr hash pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall hash pos.
(Eq pos, Eq hash) =>
Expr hash pos -> Expr hash pos -> Bool
/= :: Expr hash pos -> Expr hash pos -> Bool
$c/= :: forall hash pos.
(Eq pos, Eq hash) =>
Expr hash pos -> Expr hash pos -> Bool
== :: Expr hash pos -> Expr hash pos -> Bool
$c== :: forall hash pos.
(Eq pos, Eq hash) =>
Expr hash pos -> Expr hash pos -> Bool
Eq, Expr hash pos -> Expr hash pos -> Ordering
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 {hash} {pos}. (Ord pos, Ord hash) => Eq (Expr hash pos)
forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Bool
forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Ordering
forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Expr hash pos
min :: Expr hash pos -> Expr hash pos -> Expr hash pos
$cmin :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Expr hash pos
max :: Expr hash pos -> Expr hash pos -> Expr hash pos
$cmax :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Expr hash pos
>= :: Expr hash pos -> Expr hash pos -> Bool
$c>= :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Bool
> :: Expr hash pos -> Expr hash pos -> Bool
$c> :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Bool
<= :: Expr hash pos -> Expr hash pos -> Bool
$c<= :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Bool
< :: Expr hash pos -> Expr hash pos -> Bool
$c< :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Bool
compare :: Expr hash pos -> Expr hash pos -> Ordering
$ccompare :: forall hash pos.
(Ord pos, Ord hash) =>
Expr hash pos -> Expr hash pos -> Ordering
Ord, forall a b. a -> Expr hash b -> Expr hash a
forall a b. (a -> b) -> Expr hash a -> Expr hash b
forall hash a b. a -> Expr hash b -> Expr hash a
forall hash a b. (a -> b) -> Expr hash a -> Expr hash b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Expr hash b -> Expr hash a
$c<$ :: forall hash a b. a -> Expr hash b -> Expr hash a
fmap :: forall a b. (a -> b) -> Expr hash a -> Expr hash b
$cfmap :: forall hash a b. (a -> b) -> Expr hash a -> Expr hash b
Functor, forall a. Expr hash a -> Bool
forall hash a. Eq a => a -> Expr hash a -> Bool
forall hash a. Num a => Expr hash a -> a
forall hash a. Ord a => Expr hash a -> a
forall m a. Monoid m => (a -> m) -> Expr hash a -> m
forall hash m. Monoid m => Expr hash m -> m
forall hash a. Expr hash a -> Bool
forall hash a. Expr hash a -> Int
forall hash a. Expr hash a -> [a]
forall a b. (a -> b -> b) -> b -> Expr hash a -> b
forall hash a. (a -> a -> a) -> Expr hash a -> a
forall hash m a. Monoid m => (a -> m) -> Expr hash a -> m
forall hash b a. (b -> a -> b) -> b -> Expr hash a -> b
forall hash a b. (a -> b -> b) -> b -> Expr hash 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
product :: forall a. Num a => Expr hash a -> a
$cproduct :: forall hash a. Num a => Expr hash a -> a
sum :: forall a. Num a => Expr hash a -> a
$csum :: forall hash a. Num a => Expr hash a -> a
minimum :: forall a. Ord a => Expr hash a -> a
$cminimum :: forall hash a. Ord a => Expr hash a -> a
maximum :: forall a. Ord a => Expr hash a -> a
$cmaximum :: forall hash a. Ord a => Expr hash a -> a
elem :: forall a. Eq a => a -> Expr hash a -> Bool
$celem :: forall hash a. Eq a => a -> Expr hash a -> Bool
length :: forall a. Expr hash a -> Int
$clength :: forall hash a. Expr hash a -> Int
null :: forall a. Expr hash a -> Bool
$cnull :: forall hash a. Expr hash a -> Bool
toList :: forall a. Expr hash a -> [a]
$ctoList :: forall hash a. Expr hash a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Expr hash a -> a
$cfoldl1 :: forall hash a. (a -> a -> a) -> Expr hash a -> a
foldr1 :: forall a. (a -> a -> a) -> Expr hash a -> a
$cfoldr1 :: forall hash a. (a -> a -> a) -> Expr hash a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Expr hash a -> b
$cfoldl' :: forall hash b a. (b -> a -> b) -> b -> Expr hash a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Expr hash a -> b
$cfoldl :: forall hash b a. (b -> a -> b) -> b -> Expr hash a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Expr hash a -> b
$cfoldr' :: forall hash a b. (a -> b -> b) -> b -> Expr hash a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Expr hash a -> b
$cfoldr :: forall hash a b. (a -> b -> b) -> b -> Expr hash a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Expr hash a -> m
$cfoldMap' :: forall hash m a. Monoid m => (a -> m) -> Expr hash a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Expr hash a -> m
$cfoldMap :: forall hash m a. Monoid m => (a -> m) -> Expr hash a -> m
fold :: forall m. Monoid m => Expr hash m -> m
$cfold :: forall hash m. Monoid m => Expr hash m -> m
Foldable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall hash pos x. Rep (Expr hash pos) x -> Expr hash pos
forall hash pos x. Expr hash pos -> Rep (Expr hash pos) x
$cto :: forall hash pos x. Rep (Expr hash pos) x -> Expr hash pos
$cfrom :: forall hash pos x. Expr hash pos -> Rep (Expr hash pos) x
Generic, Expr hash pos -> DataType
Expr hash pos -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {hash} {pos}.
(Data hash, Data pos) =>
Typeable (Expr hash pos)
forall hash pos. (Data hash, Data pos) => Expr hash pos -> DataType
forall hash pos. (Data hash, Data pos) => Expr hash pos -> Constr
forall hash pos.
(Data hash, Data pos) =>
(forall b. Data b => b -> b) -> Expr hash pos -> Expr hash pos
forall hash pos u.
(Data hash, Data pos) =>
Int -> (forall d. Data d => d -> u) -> Expr hash pos -> u
forall hash pos u.
(Data hash, Data pos) =>
(forall d. Data d => d -> u) -> Expr hash pos -> [u]
forall hash pos r r'.
(Data hash, Data pos) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr hash pos -> r
forall hash pos r r'.
(Data hash, Data pos) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr hash pos -> r
forall hash pos (m :: * -> *).
(Data hash, Data pos, Monad m) =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
forall hash pos (m :: * -> *).
(Data hash, Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr hash pos)
forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr hash pos -> c (Expr hash pos)
forall hash pos (t :: * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr hash pos))
forall hash pos (t :: * -> * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr hash pos))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr hash pos)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr hash pos -> c (Expr hash pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr hash pos))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
$cgmapMo :: forall hash pos (m :: * -> *).
(Data hash, Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
$cgmapMp :: forall hash pos (m :: * -> *).
(Data hash, Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
$cgmapM :: forall hash pos (m :: * -> *).
(Data hash, Data pos, Monad m) =>
(forall d. Data d => d -> m d)
-> Expr hash pos -> m (Expr hash pos)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Expr hash pos -> u
$cgmapQi :: forall hash pos u.
(Data hash, Data pos) =>
Int -> (forall d. Data d => d -> u) -> Expr hash pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Expr hash pos -> [u]
$cgmapQ :: forall hash pos u.
(Data hash, Data pos) =>
(forall d. Data d => d -> u) -> Expr hash pos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr hash pos -> r
$cgmapQr :: forall hash pos r r'.
(Data hash, Data pos) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Expr hash pos -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr hash pos -> r
$cgmapQl :: forall hash pos r r'.
(Data hash, Data pos) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Expr hash pos -> r
gmapT :: (forall b. Data b => b -> b) -> Expr hash pos -> Expr hash pos
$cgmapT :: forall hash pos.
(Data hash, Data pos) =>
(forall b. Data b => b -> b) -> Expr hash pos -> Expr hash pos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr hash pos))
$cdataCast2 :: forall hash pos (t :: * -> * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Expr hash pos))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr hash pos))
$cdataCast1 :: forall hash pos (t :: * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr hash pos))
dataTypeOf :: Expr hash pos -> DataType
$cdataTypeOf :: forall hash pos. (Data hash, Data pos) => Expr hash pos -> DataType
toConstr :: Expr hash pos -> Constr
$ctoConstr :: forall hash pos. (Data hash, Data pos) => Expr hash pos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr hash pos)
$cgunfold :: forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr hash pos)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr hash pos -> c (Expr hash pos)
$cgfoldl :: forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr hash pos -> c (Expr hash pos)
Data, forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall hash pos.
(ToJSON hash, ToJSON pos) =>
[Expr hash pos] -> Encoding
forall hash pos.
(ToJSON hash, ToJSON pos) =>
[Expr hash pos] -> Value
forall hash pos.
(ToJSON hash, ToJSON pos) =>
Expr hash pos -> Encoding
forall hash pos.
(ToJSON hash, ToJSON pos) =>
Expr hash pos -> Value
toEncodingList :: [Expr hash pos] -> Encoding
$ctoEncodingList :: forall hash pos.
(ToJSON hash, ToJSON pos) =>
[Expr hash pos] -> Encoding
toJSONList :: [Expr hash pos] -> Value
$ctoJSONList :: forall hash pos.
(ToJSON hash, ToJSON pos) =>
[Expr hash pos] -> Value
toEncoding :: Expr hash pos -> Encoding
$ctoEncoding :: forall hash pos.
(ToJSON hash, ToJSON pos) =>
Expr hash pos -> Encoding
toJSON :: Expr hash pos -> Value
$ctoJSON :: forall hash pos.
(ToJSON hash, ToJSON pos) =>
Expr hash pos -> Value
ToJSON, forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser [Expr hash pos]
forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser (Expr hash pos)
parseJSONList :: Value -> Parser [Expr hash pos]
$cparseJSONList :: forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser [Expr hash pos]
parseJSON :: Value -> Parser (Expr hash pos)
$cparseJSON :: forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser (Expr hash pos)
FromJSON)

{-# COMPLETE
  Var_,
  OpVar_,
  TypeRep_,
  Enum_,
  App_,
  Lam_,
  Let_,
  Lit_,
  InterpolatedString_,
  If_,
  Op_,
  PreOp_,
  Tuple_,
  One_,
  Empty_,
  Assert_,
  Case_,
  Array_,
  ArrayComp_,
  CommentAbove,
  CommentAfter,
  CommentBelow,
  Bracketed_,
  RenameModule_,
  OpenModule_
  #-}

pattern Var_ :: forall hash pos. hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
pattern $mVar_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (hash -> Scoped ModuleName -> ImplExpl -> r)
-> ((# #) -> r)
-> r
Var_ h ns x <- Var _ h ns x

pattern OpVar_ :: forall hash pos. hash -> Scoped ModuleName -> Ident -> Expr hash pos
pattern $mOpVar_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (hash -> Scoped ModuleName -> Ident -> r) -> ((# #) -> r) -> r
OpVar_ h ns x <- OpVar _ h ns x

pattern TypeRep_ :: forall hash pos. InfernoType -> Expr hash pos
pattern $mTypeRep_ :: forall {r} {hash} {pos}.
Expr hash pos -> (InfernoType -> r) -> ((# #) -> r) -> r
TypeRep_ ty <- TypeRep _ ty

pattern Enum_ :: forall hash pos. hash -> Scoped ModuleName -> Ident -> Expr hash pos
pattern $mEnum_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (hash -> Scoped ModuleName -> Ident -> r) -> ((# #) -> r) -> r
Enum_ h ns x <- Enum _ h ns x

pattern App_ :: forall hash pos. Expr hash pos -> Expr hash pos -> Expr hash pos
pattern $mApp_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (Expr hash pos -> Expr hash pos -> r) -> ((# #) -> r) -> r
App_ e1 e2 <- App e1 e2

pattern Lam_ :: forall hash pos. NonEmpty (pos, Maybe ExtIdent) -> Expr hash pos -> Expr hash pos
pattern $mLam_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (NonEmpty (pos, Maybe ExtIdent) -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
Lam_ xs e <- Lam _ xs _ e

pattern Let_ :: forall hash pos. ImplExpl -> Expr hash pos -> Expr hash pos -> Expr hash pos
pattern $mLet_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (ImplExpl -> Expr hash pos -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
Let_ x e1 e2 <- Let _ _ x _ e1 _ e2

pattern Lit_ :: forall hash pos. Lit -> Expr hash pos
pattern $mLit_ :: forall {r} {hash} {pos}.
Expr hash pos -> (Lit -> r) -> ((# #) -> r) -> r
Lit_ l <- Lit _ l

pattern InterpolatedString_ :: forall hash pos. SomeIStr (pos, Expr hash pos, pos) -> Expr hash pos
pattern $mInterpolatedString_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (SomeIStr (pos, Expr hash pos, pos) -> r) -> ((# #) -> r) -> r
InterpolatedString_ xs <- InterpolatedString _ xs _

pattern If_ :: forall hash pos. Expr hash pos -> Expr hash pos -> Expr hash pos -> Expr hash pos
pattern $mIf_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (Expr hash pos -> Expr hash pos -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
If_ c t f <- If _ c _ t _ f

pattern Op_ :: forall hash pos. Expr hash pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos -> Expr hash pos
pattern $mOp_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (Expr hash pos
    -> hash -> Scoped ModuleName -> Ident -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
Op_ e1 h ns op e2 <- Op e1 _ h _ ns op e2

pattern PreOp_ :: forall hash pos. hash -> Scoped ModuleName -> Ident -> Expr hash pos -> Expr hash pos
pattern $mPreOp_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (hash -> Scoped ModuleName -> Ident -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
PreOp_ h ns op e <- PreOp _ h _ ns op e

pattern Tuple_ :: forall hash pos. TList (Expr hash pos, Maybe pos) -> Expr hash pos
pattern $mTuple_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (TList (Expr hash pos, Maybe pos) -> r) -> ((# #) -> r) -> r
Tuple_ xs <- Tuple _ xs _

pattern One_ :: forall hash pos. Expr hash pos -> Expr hash pos
pattern $mOne_ :: forall {r} {hash} {pos}.
Expr hash pos -> (Expr hash pos -> r) -> ((# #) -> r) -> r
One_ e <- One _ e

pattern Empty_ :: forall hash pos. Expr hash pos
pattern $mEmpty_ :: forall {r} {hash} {pos}.
Expr hash pos -> ((# #) -> r) -> ((# #) -> r) -> r
Empty_ <- Empty _

pattern Assert_ :: forall hash pos. Expr hash pos -> Expr hash pos -> Expr hash pos
pattern $mAssert_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (Expr hash pos -> Expr hash pos -> r) -> ((# #) -> r) -> r
Assert_ c e <- Assert _ c _ e

pattern Case_ :: forall hash pos. Expr hash pos -> NonEmpty (pos, Pat hash pos, pos, Expr hash pos) -> Expr hash pos
pattern $mCase_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (Expr hash pos
    -> NonEmpty (pos, Pat hash pos, pos, Expr hash pos) -> r)
-> ((# #) -> r)
-> r
Case_ e xs <- Case _ e _ xs _

pattern Array_ :: forall hash pos. [(Expr hash pos, Maybe pos)] -> Expr hash pos
pattern $mArray_ :: forall {r} {hash} {pos}.
Expr hash pos
-> ([(Expr hash pos, Maybe pos)] -> r) -> ((# #) -> r) -> r
Array_ xs <- Array _ xs _

pattern ArrayComp_ ::
  forall hash pos.
  Expr hash pos ->
  NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos) ->
  Maybe (pos, Expr hash pos) ->
  Expr hash pos
pattern $mArrayComp_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (Expr hash pos
    -> NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
    -> Maybe (pos, Expr hash pos)
    -> r)
-> ((# #) -> r)
-> r
ArrayComp_ e xs c <- ArrayComp _ e _ xs c _

pattern Bracketed_ :: forall hash pos. Expr hash pos -> Expr hash pos
pattern $mBracketed_ :: forall {r} {hash} {pos}.
Expr hash pos -> (Expr hash pos -> r) -> ((# #) -> r) -> r
Bracketed_ e <- Bracketed _ e _

pattern RenameModule_ :: forall hash pos. ModuleName -> ModuleName -> Expr hash pos -> Expr hash pos
pattern $mRenameModule_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (ModuleName -> ModuleName -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
RenameModule_ n1 n2 e <- RenameModule _ n1 _ n2 _ e

pattern OpenModule_ :: forall hash pos. ModuleName -> [(Import pos, Maybe pos)] -> Expr hash pos -> Expr hash pos
pattern $mOpenModule_ :: forall {r} {hash} {pos}.
Expr hash pos
-> (ModuleName -> [(Import pos, Maybe pos)] -> Expr hash pos -> r)
-> ((# #) -> r)
-> r
OpenModule_ n1 ns e <- OpenModule _ _ n1 ns _ e

data Pat hash pos
  = PVar pos (Maybe Ident)
  | PEnum pos hash (Scoped ModuleName) Ident
  | PLit pos Lit
  | POne pos (Pat hash pos)
  | PEmpty pos
  | PTuple pos (TList (Pat hash pos, Maybe pos)) pos
  | PCommentAbove
      (Comment pos)
      (Pat hash pos)
  | PCommentAfter
      (Pat hash pos)
      (Comment pos)
  | PCommentBelow
      (Pat hash pos)
      (Comment pos)
  deriving (Int -> Pat hash pos -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall hash pos.
(Show pos, Show hash) =>
Int -> Pat hash pos -> ShowS
forall hash pos. (Show pos, Show hash) => [Pat hash pos] -> ShowS
forall hash pos. (Show pos, Show hash) => Pat hash pos -> FilePath
showList :: [Pat hash pos] -> ShowS
$cshowList :: forall hash pos. (Show pos, Show hash) => [Pat hash pos] -> ShowS
show :: Pat hash pos -> FilePath
$cshow :: forall hash pos. (Show pos, Show hash) => Pat hash pos -> FilePath
showsPrec :: Int -> Pat hash pos -> ShowS
$cshowsPrec :: forall hash pos.
(Show pos, Show hash) =>
Int -> Pat hash pos -> ShowS
Show, Pat hash pos -> Pat hash pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall hash pos.
(Eq pos, Eq hash) =>
Pat hash pos -> Pat hash pos -> Bool
/= :: Pat hash pos -> Pat hash pos -> Bool
$c/= :: forall hash pos.
(Eq pos, Eq hash) =>
Pat hash pos -> Pat hash pos -> Bool
== :: Pat hash pos -> Pat hash pos -> Bool
$c== :: forall hash pos.
(Eq pos, Eq hash) =>
Pat hash pos -> Pat hash pos -> Bool
Eq, Pat hash pos -> Pat hash pos -> Ordering
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 {hash} {pos}. (Ord pos, Ord hash) => Eq (Pat hash pos)
forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Bool
forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Ordering
forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Pat hash pos
min :: Pat hash pos -> Pat hash pos -> Pat hash pos
$cmin :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Pat hash pos
max :: Pat hash pos -> Pat hash pos -> Pat hash pos
$cmax :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Pat hash pos
>= :: Pat hash pos -> Pat hash pos -> Bool
$c>= :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Bool
> :: Pat hash pos -> Pat hash pos -> Bool
$c> :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Bool
<= :: Pat hash pos -> Pat hash pos -> Bool
$c<= :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Bool
< :: Pat hash pos -> Pat hash pos -> Bool
$c< :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Bool
compare :: Pat hash pos -> Pat hash pos -> Ordering
$ccompare :: forall hash pos.
(Ord pos, Ord hash) =>
Pat hash pos -> Pat hash pos -> Ordering
Ord, forall a b. a -> Pat hash b -> Pat hash a
forall a b. (a -> b) -> Pat hash a -> Pat hash b
forall hash a b. a -> Pat hash b -> Pat hash a
forall hash a b. (a -> b) -> Pat hash a -> Pat hash b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Pat hash b -> Pat hash a
$c<$ :: forall hash a b. a -> Pat hash b -> Pat hash a
fmap :: forall a b. (a -> b) -> Pat hash a -> Pat hash b
$cfmap :: forall hash a b. (a -> b) -> Pat hash a -> Pat hash b
Functor, forall a. Pat hash a -> Bool
forall hash a. Eq a => a -> Pat hash a -> Bool
forall hash a. Num a => Pat hash a -> a
forall hash a. Ord a => Pat hash a -> a
forall m a. Monoid m => (a -> m) -> Pat hash a -> m
forall hash m. Monoid m => Pat hash m -> m
forall hash a. Pat hash a -> Bool
forall hash a. Pat hash a -> Int
forall hash a. Pat hash a -> [a]
forall a b. (a -> b -> b) -> b -> Pat hash a -> b
forall hash a. (a -> a -> a) -> Pat hash a -> a
forall hash m a. Monoid m => (a -> m) -> Pat hash a -> m
forall hash b a. (b -> a -> b) -> b -> Pat hash a -> b
forall hash a b. (a -> b -> b) -> b -> Pat hash 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
product :: forall a. Num a => Pat hash a -> a
$cproduct :: forall hash a. Num a => Pat hash a -> a
sum :: forall a. Num a => Pat hash a -> a
$csum :: forall hash a. Num a => Pat hash a -> a
minimum :: forall a. Ord a => Pat hash a -> a
$cminimum :: forall hash a. Ord a => Pat hash a -> a
maximum :: forall a. Ord a => Pat hash a -> a
$cmaximum :: forall hash a. Ord a => Pat hash a -> a
elem :: forall a. Eq a => a -> Pat hash a -> Bool
$celem :: forall hash a. Eq a => a -> Pat hash a -> Bool
length :: forall a. Pat hash a -> Int
$clength :: forall hash a. Pat hash a -> Int
null :: forall a. Pat hash a -> Bool
$cnull :: forall hash a. Pat hash a -> Bool
toList :: forall a. Pat hash a -> [a]
$ctoList :: forall hash a. Pat hash a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Pat hash a -> a
$cfoldl1 :: forall hash a. (a -> a -> a) -> Pat hash a -> a
foldr1 :: forall a. (a -> a -> a) -> Pat hash a -> a
$cfoldr1 :: forall hash a. (a -> a -> a) -> Pat hash a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Pat hash a -> b
$cfoldl' :: forall hash b a. (b -> a -> b) -> b -> Pat hash a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Pat hash a -> b
$cfoldl :: forall hash b a. (b -> a -> b) -> b -> Pat hash a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Pat hash a -> b
$cfoldr' :: forall hash a b. (a -> b -> b) -> b -> Pat hash a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Pat hash a -> b
$cfoldr :: forall hash a b. (a -> b -> b) -> b -> Pat hash a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Pat hash a -> m
$cfoldMap' :: forall hash m a. Monoid m => (a -> m) -> Pat hash a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Pat hash a -> m
$cfoldMap :: forall hash m a. Monoid m => (a -> m) -> Pat hash a -> m
fold :: forall m. Monoid m => Pat hash m -> m
$cfold :: forall hash m. Monoid m => Pat hash m -> m
Foldable, Pat hash pos -> DataType
Pat hash pos -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {hash} {pos}.
(Data hash, Data pos) =>
Typeable (Pat hash pos)
forall hash pos. (Data hash, Data pos) => Pat hash pos -> DataType
forall hash pos. (Data hash, Data pos) => Pat hash pos -> Constr
forall hash pos.
(Data hash, Data pos) =>
(forall b. Data b => b -> b) -> Pat hash pos -> Pat hash pos
forall hash pos u.
(Data hash, Data pos) =>
Int -> (forall d. Data d => d -> u) -> Pat hash pos -> u
forall hash pos u.
(Data hash, Data pos) =>
(forall d. Data d => d -> u) -> Pat hash pos -> [u]
forall hash pos r r'.
(Data hash, Data pos) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pat hash pos -> r
forall hash pos r r'.
(Data hash, Data pos) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pat hash pos -> r
forall hash pos (m :: * -> *).
(Data hash, Data pos, Monad m) =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
forall hash pos (m :: * -> *).
(Data hash, Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pat hash pos)
forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pat hash pos -> c (Pat hash pos)
forall hash pos (t :: * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pat hash pos))
forall hash pos (t :: * -> * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pat hash pos))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pat hash pos)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pat hash pos -> c (Pat hash pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pat hash pos))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
$cgmapMo :: forall hash pos (m :: * -> *).
(Data hash, Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
$cgmapMp :: forall hash pos (m :: * -> *).
(Data hash, Data pos, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
$cgmapM :: forall hash pos (m :: * -> *).
(Data hash, Data pos, Monad m) =>
(forall d. Data d => d -> m d) -> Pat hash pos -> m (Pat hash pos)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pat hash pos -> u
$cgmapQi :: forall hash pos u.
(Data hash, Data pos) =>
Int -> (forall d. Data d => d -> u) -> Pat hash pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Pat hash pos -> [u]
$cgmapQ :: forall hash pos u.
(Data hash, Data pos) =>
(forall d. Data d => d -> u) -> Pat hash pos -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pat hash pos -> r
$cgmapQr :: forall hash pos r r'.
(Data hash, Data pos) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pat hash pos -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pat hash pos -> r
$cgmapQl :: forall hash pos r r'.
(Data hash, Data pos) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pat hash pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pat hash pos -> Pat hash pos
$cgmapT :: forall hash pos.
(Data hash, Data pos) =>
(forall b. Data b => b -> b) -> Pat hash pos -> Pat hash pos
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pat hash pos))
$cdataCast2 :: forall hash pos (t :: * -> * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pat hash pos))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Pat hash pos))
$cdataCast1 :: forall hash pos (t :: * -> *) (c :: * -> *).
(Data hash, Data pos, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pat hash pos))
dataTypeOf :: Pat hash pos -> DataType
$cdataTypeOf :: forall hash pos. (Data hash, Data pos) => Pat hash pos -> DataType
toConstr :: Pat hash pos -> Constr
$ctoConstr :: forall hash pos. (Data hash, Data pos) => Pat hash pos -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pat hash pos)
$cgunfold :: forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pat hash pos)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pat hash pos -> c (Pat hash pos)
$cgfoldl :: forall hash pos (c :: * -> *).
(Data hash, Data pos) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pat hash pos -> c (Pat hash pos)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall hash pos x. Rep (Pat hash pos) x -> Pat hash pos
forall hash pos x. Pat hash pos -> Rep (Pat hash pos) x
$cto :: forall hash pos x. Rep (Pat hash pos) x -> Pat hash pos
$cfrom :: forall hash pos x. Pat hash pos -> Rep (Pat hash pos) x
Generic, forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall hash pos.
(ToJSON pos, ToJSON hash) =>
[Pat hash pos] -> Encoding
forall hash pos.
(ToJSON pos, ToJSON hash) =>
[Pat hash pos] -> Value
forall hash pos.
(ToJSON pos, ToJSON hash) =>
Pat hash pos -> Encoding
forall hash pos. (ToJSON pos, ToJSON hash) => Pat hash pos -> Value
toEncodingList :: [Pat hash pos] -> Encoding
$ctoEncodingList :: forall hash pos.
(ToJSON pos, ToJSON hash) =>
[Pat hash pos] -> Encoding
toJSONList :: [Pat hash pos] -> Value
$ctoJSONList :: forall hash pos.
(ToJSON pos, ToJSON hash) =>
[Pat hash pos] -> Value
toEncoding :: Pat hash pos -> Encoding
$ctoEncoding :: forall hash pos.
(ToJSON pos, ToJSON hash) =>
Pat hash pos -> Encoding
toJSON :: Pat hash pos -> Value
$ctoJSON :: forall hash pos. (ToJSON pos, ToJSON hash) => Pat hash pos -> Value
ToJSON, forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser [Pat hash pos]
forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser (Pat hash pos)
parseJSONList :: Value -> Parser [Pat hash pos]
$cparseJSONList :: forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser [Pat hash pos]
parseJSON :: Value -> Parser (Pat hash pos)
$cparseJSON :: forall hash pos.
(FromJSON hash, FromJSON pos) =>
Value -> Parser (Pat hash pos)
FromJSON)

makeBaseFunctor ''Pat

makeBaseFunctor ''Expr

deriveBifunctor ''Pat

deriveBifunctor ''Expr

patternToExpr :: Pat () () -> Expr () ()
patternToExpr :: Pat () () -> Expr () ()
patternToExpr = \case
  PVar ()
_ Maybe Ident
Nothing -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var () () forall a. Scoped a
LocalScope forall a b. (a -> b) -> a -> b
$ ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
"_"
  PVar ()
_ (Just (Ident Text
i)) -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var () () forall a. Scoped a
LocalScope forall a b. (a -> b) -> a -> b
$ ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
i
  PEnum ()
_ ()
_ Scoped ModuleName
modNm Ident
i -> forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
Enum () () Scoped ModuleName
modNm Ident
i
  PLit ()
_ Lit
l -> forall hash pos. pos -> Lit -> Expr hash pos
Lit () Lit
l
  POne ()
_ Pat () ()
p -> forall hash pos. pos -> Expr hash pos -> Expr hash pos
One () forall a b. (a -> b) -> a -> b
$ Pat () () -> Expr () ()
patternToExpr Pat () ()
p
  PEmpty ()
_ -> forall hash pos. pos -> Expr hash pos
Empty ()
  PTuple ()
_ TList (Pat () (), Maybe ())
ps ()
_ -> forall hash pos.
pos -> TList (Expr hash pos, Maybe pos) -> pos -> Expr hash pos
Tuple () (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pat () ()
pat, Maybe ()
pos) -> (Pat () () -> Expr () ()
patternToExpr Pat () ()
pat, Maybe ()
pos)) TList (Pat () (), Maybe ())
ps) ()
  PCommentAbove Comment ()
c Pat () ()
p -> forall hash pos. Comment pos -> Expr hash pos -> Expr hash pos
CommentAbove Comment ()
c forall a b. (a -> b) -> a -> b
$ Pat () () -> Expr () ()
patternToExpr Pat () ()
p
  PCommentAfter Pat () ()
p Comment ()
c -> forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentAfter (Pat () () -> Expr () ()
patternToExpr Pat () ()
p) Comment ()
c
  PCommentBelow Pat () ()
p Comment ()
c -> forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentBelow (Pat () () -> Expr () ()
patternToExpr Pat () ()
p) Comment ()
c

getIdentifierPositions :: Ident -> Expr a SourcePos -> [(SourcePos, SourcePos)]
getIdentifierPositions :: forall a. Ident -> Expr a SourcePos -> [(SourcePos, SourcePos)]
getIdentifierPositions (Ident Text
i) = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a.
ExprF a SourcePos [(SourcePos, SourcePos)]
-> [(SourcePos, SourcePos)]
go
  where
    go :: ExprF a SourcePos [(SourcePos, SourcePos)] -> [(SourcePos, SourcePos)]
    go :: forall a.
ExprF a SourcePos [(SourcePos, SourcePos)]
-> [(SourcePos, SourcePos)]
go = \case
      VarF SourcePos
pos a
_ Scoped ModuleName
_ v :: ImplExpl
v@(Expl (ExtIdent (Right Text
a))) -> if Text
i forall a. Eq a => a -> a -> Bool
== Text
a then let (SourcePos
sPos, SourcePos
ePos) = forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos ImplExpl
v in [(SourcePos
sPos, SourcePos
ePos)] else []
      ExprF a SourcePos [(SourcePos, SourcePos)]
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. [a] -> [a] -> [a]
(++) [] ExprF a SourcePos [(SourcePos, SourcePos)]
rest

class BlockUtils f where
  blockPosition :: f SourcePos -> (SourcePos, SourcePos)
  removeComments :: f pos -> f pos
  hasLeadingComment :: f pos -> Bool
  hasTrailingComment :: f pos -> Bool
  renameModule :: Scoped ModuleName -> f pos -> f pos

instance BlockUtils Comment where
  blockPosition :: Comment SourcePos -> (SourcePos, SourcePos)
blockPosition = \case
    LineComment SourcePos
s Text
_ SourcePos
e -> (SourcePos
s, SourcePos
e)
    BlockComment SourcePos
s Text
_ SourcePos
e -> (SourcePos
s, SourcePos
e)

  removeComments :: forall pos. Comment pos -> Comment pos
removeComments = forall a. a -> a
id
  hasLeadingComment :: forall a. Comment a -> Bool
hasLeadingComment Comment pos
_ = Bool
True
  hasTrailingComment :: forall a. Comment a -> Bool
hasTrailingComment Comment pos
_ = Bool
True
  renameModule :: forall pos. Scoped ModuleName -> Comment pos -> Comment pos
renameModule Scoped ModuleName
_ = forall a. a -> a
id

instance BlockUtils Import where
  blockPosition :: Import SourcePos -> (SourcePos, SourcePos)
blockPosition Import SourcePos
p = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ImportF SourcePos (SourcePos, SourcePos) -> (SourcePos, SourcePos)
go Import SourcePos
p
    where
      go :: ImportF SourcePos (SourcePos, SourcePos) -> (SourcePos, SourcePos)
go = \case
        IVarF SourcePos
pos Ident
v -> forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos Ident
v
        IOpVarF SourcePos
pos (Ident Text
i) -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
i forall a. Num a => a -> a -> a
+ Int
2)
        IEnumF SourcePos
pos1 SourcePos
pos2 (Ident Text
i) -> (SourcePos
pos1, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos2 forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
i)
        ICommentAboveF Comment SourcePos
c (SourcePos
_, SourcePos
pos2) -> let (SourcePos
pos1, SourcePos
_) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        ICommentAfterF (SourcePos
pos1, SourcePos
_) Comment SourcePos
c -> let (SourcePos
_, SourcePos
pos2) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        ICommentBelowF (SourcePos
pos1, SourcePos
_) Comment SourcePos
c -> let (SourcePos
_, SourcePos
pos2) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)

  removeComments :: forall pos. Import pos -> Import pos
removeComments = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \case
    ICommentAbove Comment pos
_ Import pos
p -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Import pos
p
    ICommentAfter Import pos
p Comment pos
_ -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Import pos
p
    ICommentBelow Import pos
p Comment pos
_ -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Import pos
p
    Import pos
other -> forall t. Recursive t => t -> Base t t
project Import pos
other
  renameModule :: forall pos. Scoped ModuleName -> Import pos -> Import pos
renameModule Scoped ModuleName
_ = forall a. a -> a
id

  hasLeadingComment :: forall a. Import a -> Bool
hasLeadingComment = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall {pos}. ImportF pos [Bool] -> [Bool]
go
    where
      go :: ImportF pos [Bool] -> [Bool]
go = \case
        ICommentAboveF Comment pos
_ [Bool]
_ -> [Bool
True]
        ImportF pos [Bool]
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. [a] -> [a] -> [a]
(++) [Bool
False] ImportF pos [Bool]
rest

  hasTrailingComment :: forall a. Import a -> Bool
hasTrailingComment = forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall {pos}. ImportF pos [Bool] -> [Bool]
go
    where
      go :: ImportF pos [Bool] -> [Bool]
go = \case
        ICommentAfterF [Bool]
_ Comment pos
_ -> [Bool
True]
        ICommentBelowF [Bool]
_ Comment pos
_ -> [Bool
True]
        ImportF pos [Bool]
rest -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. [a] -> [a] -> [a]
(++) [Bool
False] ImportF pos [Bool]
rest

instance BlockUtils (Pat hash) where
  blockPosition :: Pat hash SourcePos -> (SourcePos, SourcePos)
blockPosition Pat hash SourcePos
p = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata PatF hash SourcePos (SourcePos, SourcePos)
-> (SourcePos, SourcePos)
go Pat hash SourcePos
p
    where
      go :: PatF hash SourcePos (SourcePos, SourcePos) -> (SourcePos, SourcePos)
      go :: PatF hash SourcePos (SourcePos, SourcePos)
-> (SourcePos, SourcePos)
go = \case
        PVarF SourcePos
pos Maybe Ident
v -> forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos Maybe Ident
v
        PEnumF SourcePos
pos hash
_ Scoped ModuleName
ns (Ident Text
i) -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ (forall a. a -> Scoped a -> a
fromScoped Int
0 forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns))
        PLitF SourcePos
pos Lit
l -> forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos Lit
l
        PEmptyF SourcePos
pos -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos Int
5)
        POneF SourcePos
pos1 (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        PTupleF SourcePos
pos1 TList ((SourcePos, SourcePos), Maybe SourcePos)
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos2 Int
1)
        PCommentAboveF Comment SourcePos
c (SourcePos
_, SourcePos
pos2) -> let (SourcePos
pos1, SourcePos
_) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        PCommentAfterF (SourcePos
pos1, SourcePos
_) Comment SourcePos
c -> let (SourcePos
_, SourcePos
pos2) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        PCommentBelowF (SourcePos
pos1, SourcePos
_) Comment SourcePos
c -> let (SourcePos
_, SourcePos
pos2) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)

  removeComments :: forall pos. Pat hash pos -> Pat hash pos
removeComments = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \case
    PCommentAbove Comment pos
_ Pat hash pos
p -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Pat hash pos
p
    PCommentAfter Pat hash pos
p Comment pos
_ -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Pat hash pos
p
    PCommentBelow Pat hash pos
p Comment pos
_ -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Pat hash pos
p
    Pat hash pos
other -> forall t. Recursive t => t -> Base t t
project Pat hash pos
other

  renameModule :: forall pos. Scoped ModuleName -> Pat hash pos -> Pat hash pos
renameModule Scoped ModuleName
newNs = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \case
    PEnum pos
pos hash
hash Scoped ModuleName
_ns Ident
i -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Pat hash pos
PEnum pos
pos hash
hash Scoped ModuleName
newNs Ident
i
    Pat hash pos
other -> forall t. Recursive t => t -> Base t t
project Pat hash pos
other

  hasLeadingComment :: forall pos. Pat hash pos -> Bool
hasLeadingComment = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall pos. PatF hash pos [Bool] -> [Bool]
go
    where
      go :: PatF hash pos [Bool] -> [Bool]
      go :: forall pos. PatF hash pos [Bool] -> [Bool]
go = \case
        PCommentAboveF Comment pos
_ [Bool]
_ -> [Bool
True]
        PatF hash pos [Bool]
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. [a] -> [a] -> [a]
(++) [Bool
False] PatF hash pos [Bool]
rest

  hasTrailingComment :: forall pos. Pat hash pos -> Bool
hasTrailingComment = forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall pos. PatF hash pos [Bool] -> [Bool]
go
    where
      go :: PatF hash pos [Bool] -> [Bool]
      go :: forall pos. PatF hash pos [Bool] -> [Bool]
go = \case
        PCommentAfterF [Bool]
_ Comment pos
_ -> [Bool
True]
        PCommentBelowF [Bool]
_ Comment pos
_ -> [Bool
True]
        PatF hash pos [Bool]
rest -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. [a] -> [a] -> [a]
(++) [Bool
False] PatF hash pos [Bool]
rest

instance BlockUtils (Expr hash) where
  blockPosition :: Expr hash SourcePos -> (SourcePos, SourcePos)
blockPosition Expr hash SourcePos
e = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ExprF hash SourcePos (SourcePos, SourcePos)
-> (SourcePos, SourcePos)
go Expr hash SourcePos
e
    where
      go :: ExprF hash SourcePos (SourcePos, SourcePos) -> (SourcePos, SourcePos)
      go :: ExprF hash SourcePos (SourcePos, SourcePos)
-> (SourcePos, SourcePos)
go = \case
        VarF SourcePos
pos hash
_ Scoped ModuleName
ns ImplExpl
v -> let (SourcePos
sPos, SourcePos
ePos) = forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos ImplExpl
v in (SourcePos
sPos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
ePos forall a b. (a -> b) -> a -> b
$ forall a. a -> Scoped a -> a
fromScoped Int
0 forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns)
        OpVarF SourcePos
pos hash
_ Scoped ModuleName
ns Ident
v -> let (SourcePos
sPos, SourcePos
ePos) = forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
pos Ident
v in (SourcePos
sPos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
ePos forall a b. (a -> b) -> a -> b
$ forall a. a -> Scoped a -> a
fromScoped Int
2 forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
+ Int
3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns)
        EnumF SourcePos
pos hash
_ Scoped ModuleName
ns (Ident Text
i) -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ (forall a. a -> Scoped a -> a
fromScoped Int
0 forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
+ Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns))
        AppF (SourcePos
pos1, SourcePos
_) (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        LamF SourcePos
pos1 NonEmpty (SourcePos, Maybe ExtIdent)
_ SourcePos
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        LetF SourcePos
pos1 SourcePos
_ ImplExpl
_ SourcePos
_ (SourcePos, SourcePos)
_ SourcePos
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        LitF SourcePos
pos Lit
l -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty Lit
l)
        InterpolatedStringF SourcePos
pos1 SomeIStr (SourcePos, (SourcePos, SourcePos), SourcePos)
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos
pos2)
        IfF SourcePos
pos1 (SourcePos, SourcePos)
_ SourcePos
_ (SourcePos, SourcePos)
_ SourcePos
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        OpF (SourcePos
pos1, SourcePos
_) SourcePos
_ hash
_ (Int, InfixFixity)
_ Scoped ModuleName
_ Ident
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        PreOpF SourcePos
pos1 hash
_ Int
_ Scoped ModuleName
_ Ident
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        TupleF SourcePos
pos1 TList ((SourcePos, SourcePos), Maybe SourcePos)
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos2 Int
1)
        OneF SourcePos
pos1 (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        EmptyF SourcePos
pos -> (SourcePos
pos, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos Int
5)
        AssertF SourcePos
pos1 (SourcePos, SourcePos)
_ SourcePos
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        CaseF SourcePos
pos1 (SourcePos, SourcePos)
_ SourcePos
_ NonEmpty
  (SourcePos, Pat hash SourcePos, SourcePos, (SourcePos, SourcePos))
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos2 Int
1)
        ArrayF SourcePos
pos1 [((SourcePos, SourcePos), Maybe SourcePos)]
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos2 Int
1)
        ArrayCompF SourcePos
pos1 (SourcePos, SourcePos)
_ SourcePos
_ NonEmpty
  (SourcePos, Ident, SourcePos, (SourcePos, SourcePos),
   Maybe SourcePos)
_ Maybe (SourcePos, (SourcePos, SourcePos))
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos -> Int -> SourcePos
incSourceCol SourcePos
pos2 Int
1)
        CommentAboveF Comment SourcePos
c (SourcePos
_, SourcePos
pos2) -> let (SourcePos
pos1, SourcePos
_) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        CommentAfterF (SourcePos
pos1, SourcePos
_) Comment SourcePos
c -> let (SourcePos
_, SourcePos
pos2) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        CommentBelowF (SourcePos
pos1, SourcePos
_) Comment SourcePos
c -> let (SourcePos
_, SourcePos
pos2) = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Comment SourcePos
c in (SourcePos
pos1, SourcePos
pos2)
        BracketedF SourcePos
pos1 (SourcePos, SourcePos)
_ SourcePos
pos2 -> (SourcePos
pos1, SourcePos
pos2)
        RenameModuleF SourcePos
pos1 ModuleName
_ SourcePos
_ ModuleName
_ SourcePos
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        OpenModuleF SourcePos
pos1 hash
_ ModuleName
_ [(Import SourcePos, Maybe SourcePos)]
_ SourcePos
_ (SourcePos
_, SourcePos
pos2) -> (SourcePos
pos1, SourcePos
pos2)
        TypeRepF SourcePos
pos InfernoType
_ -> (SourcePos
pos, SourcePos
pos)

  removeComments :: forall pos. Expr hash pos -> Expr hash pos
removeComments = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \case
    CommentAbove Comment pos
_ Expr hash pos
p -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Expr hash pos
p
    CommentAfter Expr hash pos
p Comment pos
_ -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Expr hash pos
p
    CommentBelow Expr hash pos
p Comment pos
_ -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Expr hash pos
p
    Case pos
p1 Expr hash pos
e1 pos
p2 NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
xs pos
p3 ->
      forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$
        forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
-> pos
-> Expr hash pos
Case
          pos
p1
          (forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Expr hash pos
e1)
          pos
p2
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(pos
p4, Pat hash pos
pat, pos
p5, Expr hash pos
e2) -> (pos
p4, forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Pat hash pos
pat, pos
p5, forall (f :: * -> *) pos. BlockUtils f => f pos -> f pos
removeComments Expr hash pos
e2)) NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
xs)
          pos
p3
    Expr hash pos
other -> forall t. Recursive t => t -> Base t t
project Expr hash pos
other

  renameModule :: forall pos. Scoped ModuleName -> Expr hash pos -> Expr hash pos
renameModule Scoped ModuleName
newNs = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \Expr hash pos
e -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ case Expr hash pos
e of
    Var pos
pos hash
hash Scoped ModuleName
_ns ImplExpl
i -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var pos
pos hash
hash Scoped ModuleName
newNs ImplExpl
i
    OpVar pos
pos hash
hash Scoped ModuleName
_ns Ident
i -> forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
OpVar pos
pos hash
hash Scoped ModuleName
newNs Ident
i
    Enum pos
pos hash
hash Scoped ModuleName
_ns Ident
i -> forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
Enum pos
pos hash
hash Scoped ModuleName
newNs Ident
i
    Op Expr hash pos
e1 pos
p1 hash
hash (Int, InfixFixity)
meta Scoped ModuleName
_ns Ident
op Expr hash pos
e2 -> forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op Expr hash pos
e1 pos
p1 hash
hash (Int, InfixFixity)
meta Scoped ModuleName
newNs Ident
op Expr hash pos
e2
    Case pos
p1 Expr hash pos
e1 pos
p2 NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
xs pos
p3 ->
      forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
-> pos
-> Expr hash pos
Case
        pos
p1
        (forall (f :: * -> *) pos.
BlockUtils f =>
Scoped ModuleName -> f pos -> f pos
renameModule Scoped ModuleName
newNs Expr hash pos
e1)
        pos
p2
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(pos
p4, Pat hash pos
pat, pos
p5, Expr hash pos
e2) -> (pos
p4, forall (f :: * -> *) pos.
BlockUtils f =>
Scoped ModuleName -> f pos -> f pos
renameModule Scoped ModuleName
newNs Pat hash pos
pat, pos
p5, forall (f :: * -> *) pos.
BlockUtils f =>
Scoped ModuleName -> f pos -> f pos
renameModule Scoped ModuleName
newNs Expr hash pos
e2)) NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
xs)
        pos
p3
    Expr hash pos
other -> Expr hash pos
other
  hasLeadingComment :: forall pos. Expr hash pos -> Bool
hasLeadingComment = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall pos. ExprF hash pos [Bool] -> [Bool]
go
    where
      go :: ExprF hash pos [Bool] -> [Bool]
      go :: forall pos. ExprF hash pos [Bool] -> [Bool]
go = \case
        CommentAboveF Comment pos
_ [Bool]
_ -> [Bool
True]
        ExprF hash pos [Bool]
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. [a] -> [a] -> [a]
(++) [Bool
False] ExprF hash pos [Bool]
rest

  hasTrailingComment :: forall pos. Expr hash pos -> Bool
hasTrailingComment = forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall pos. ExprF hash pos [Bool] -> [Bool]
go
    where
      go :: ExprF hash pos [Bool] -> [Bool]
      go :: forall pos. ExprF hash pos [Bool] -> [Bool]
go = \case
        CommentAfterF [Bool]
_ Comment pos
_ -> [Bool
True]
        CommentBelowF [Bool]
_ Comment pos
_ -> [Bool
True]
        ExprF hash pos [Bool]
rest -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. [a] -> [a] -> [a]
(++) [Bool
False] ExprF hash pos [Bool]
rest

collectApps :: Expr hash pos -> [Expr hash pos]
collectApps :: forall hash pos. Expr hash pos -> [Expr hash pos]
collectApps (App x :: Expr hash pos
x@(App Expr hash pos
_ Expr hash pos
_) Expr hash pos
y) = forall hash pos. Expr hash pos -> [Expr hash pos]
collectApps Expr hash pos
x forall a. [a] -> [a] -> [a]
++ [Expr hash pos
y]
collectApps (App Expr hash pos
x Expr hash pos
y) = [Expr hash pos
x, Expr hash pos
y]
collectApps Expr hash pos
_ = forall a. HasCallStack => a
undefined

-- | Filter out any var$n/?var$n variables and their let/lambda bindings
-- This is used when pretty printing for the front-end, as we don't want the
-- users to see these auto-generated internal variables.
hideInternalIdents :: Expr hash pos -> Expr hash pos
hideInternalIdents :: forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \case
  App Expr hash pos
e (Var pos
_ hash
_ Scoped ModuleName
_ (Impl (ExtIdent (Left Int
_)))) -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
  App Expr hash pos
e (Var pos
_ hash
_ Scoped ModuleName
_ (Expl (ExtIdent (Left Int
_)))) -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
  App Expr hash pos
e (TypeRep pos
_ InfernoType
_) -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
  Let pos
_ pos
_ (Impl (ExtIdent (Left Int
_))) pos
_ Expr hash pos
_ pos
_ Expr hash pos
e -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
  Let pos
_ pos
_ (Expl (ExtIdent (Left Int
_))) pos
_ Expr hash pos
_ pos
_ Expr hash pos
e -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
  Lam pos
p1 NonEmpty (pos, Maybe ExtIdent)
xs pos
p2 Expr hash pos
e ->
    let filteredXs :: [(pos, Maybe ExtIdent)]
filteredXs = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> Bool) -> NonEmpty a -> [a]
NonEmpty.filter NonEmpty (pos, Maybe ExtIdent)
xs forall a b. (a -> b) -> a -> b
$ \case
          (pos
_, Just (ExtIdent (Left Int
_))) -> Bool
False
          (pos, Maybe ExtIdent)
_ -> Bool
True
     in case [(pos, Maybe ExtIdent)]
filteredXs of
          [] -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
          ((pos, Maybe ExtIdent)
x' : [(pos, Maybe ExtIdent)]
xs') -> forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos
-> NonEmpty (pos, Maybe ExtIdent)
-> pos
-> Expr hash pos
-> Expr hash pos
Lam pos
p1 ((pos, Maybe ExtIdent)
x' forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [(pos, Maybe ExtIdent)]
xs') pos
p2 forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
e
  Expr hash pos
other -> forall t. Recursive t => t -> Base t t
project Expr hash pos
other

-- | Extract the arguments of a script and pretty print the script body.
-- This hides the internal variable arguments.
extractArgsAndPrettyPrint :: Expr hash pos -> ([Maybe Ident], Text)
extractArgsAndPrettyPrint :: forall hash pos. Expr hash pos -> ([Maybe Ident], Text)
extractArgsAndPrettyPrint Expr hash pos
expr =
  forall {hash} {a}.
[Maybe ExtIdent] -> Expr hash a -> ([Maybe Ident], Text)
extract [] (forall hash pos. Expr hash pos -> Expr hash pos
hideInternalIdents Expr hash pos
expr)
  where
    extract :: [Maybe ExtIdent] -> Expr hash a -> ([Maybe Ident], Text)
extract [Maybe ExtIdent]
args = \case
      Lam a
_ ((a, Maybe ExtIdent)
x :| [(a, Maybe ExtIdent)]
xs) a
_ Expr hash a
e -> [Maybe ExtIdent] -> Expr hash a -> ([Maybe Ident], Text)
extract ([Maybe ExtIdent]
args forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd ((a, Maybe ExtIdent)
x forall a. a -> [a] -> [a]
: [(a, Maybe ExtIdent)]
xs)) Expr hash a
e
      Expr hash a
e -> (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Maybe ExtIdent -> Maybe (Maybe Ident)
extIdentToIdent [Maybe ExtIdent]
args, forall a. Pretty a => a -> Text
renderPretty Expr hash a
e)
    -- Strip the runtime type rep arguments, and convert others to Ident
    extIdentToIdent :: Maybe ExtIdent -> Maybe (Maybe Ident)
extIdentToIdent = \case
      (Just (ExtIdent (Left Int
_))) -> forall a. Maybe a
Nothing
      (Just (ExtIdent (Right Text
i))) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ident {unIdent :: Text
unIdent = Text
i}
      Maybe ExtIdent
Nothing -> forall a. a -> Maybe a
Just forall a. Maybe a
Nothing

-- | Substitute every variable occurrence of `?var$i` with `var$j`
-- if `(i, Left j)` is in in the supplied map.
-- otherwise replace `?var$i` with `@t` if (i, Right t) \in m`
substInternalIdents :: Map.Map Int (Either Int InfernoType) -> Expr hash pos -> Expr hash pos
substInternalIdents :: forall hash pos.
Map Int (Either Int InfernoType) -> Expr hash pos -> Expr hash pos
substInternalIdents Map Int (Either Int InfernoType)
m = forall t a. Corecursive t => (a -> Base t a) -> a -> t
ana forall a b. (a -> b) -> a -> b
$ \case
  Var pos
pos hash
h Scoped ModuleName
ns (Impl (ExtIdent (Left Int
i))) ->
    forall t. Recursive t => t -> Base t t
project forall a b. (a -> b) -> a -> b
$ case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i Map Int (Either Int InfernoType)
m of
      Just (Left Int
j) -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var pos
pos hash
h Scoped ModuleName
ns (ExtIdent -> ImplExpl
Expl (Either Int Text -> ExtIdent
ExtIdent (forall a b. a -> Either a b
Left Int
j)))
      Just (Right InfernoType
t) -> forall hash pos. pos -> InfernoType -> Expr hash pos
TypeRep pos
pos InfernoType
t
      Maybe (Either Int InfernoType)
Nothing -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var pos
pos hash
h Scoped ModuleName
ns (ExtIdent -> ImplExpl
Impl (Either Int Text -> ExtIdent
ExtIdent (forall a b. a -> Either a b
Left Int
i)))
  Expr hash pos
other -> forall t. Recursive t => t -> Base t t
project Expr hash pos
other

instance Pretty (Import a) where
  pretty :: forall ann. Import a -> Doc ann
pretty = \case
    IVar a
_ (Ident Text
x) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
x
    IOpVar a
_ (Ident Text
x) -> Doc ann
"(" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
x forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
    IEnum a
_ a
_ (Ident Text
x) -> Doc ann
"enum" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
x
    ICommentAbove Comment a
c Import a
e -> forall a ann. Pretty a => a -> Doc ann
pretty Comment a
c forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Import a
e
    ICommentAfter Import a
e Comment a
c -> forall a ann. Pretty a => a -> Doc ann
pretty Import a
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Comment a
c
    ICommentBelow Import a
e Comment a
c -> forall a ann. Pretty a => a -> Doc ann
pretty Import a
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Comment a
c

instance Pretty (Pat hash a) where
  pretty :: forall ann. Pat hash a -> Doc ann
pretty = \case
    PVar a
_ (Just (Ident Text
x)) -> forall a ann. Pretty a => a -> Doc ann
pretty Text
x
    PVar a
_ Maybe Ident
Nothing -> Doc ann
"_"
    PEnum a
_ hash
_ Scoped ModuleName
ns (Ident Text
n) -> (forall a. a -> Scoped a -> a
fromScoped forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Doc ann
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns) forall a. Semigroup a => a -> a -> a
<> Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
n
    PLit a
_ Lit
l -> forall a ann. Pretty a => a -> Doc ann
pretty Lit
l
    PTuple a
_ TList (Pat hash a, Maybe a)
TNil a
_ -> Doc ann
"()"
    PTuple a
_ TList (Pat hash a, Maybe a)
ps a
_ -> forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"( " Doc ann
"(") forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {pos} {b} {ann}.
(Pretty (f pos), BlockUtils f) =>
Bool -> [(f pos, b)] -> Doc ann
prettyTuple Bool
True (forall a. TList a -> [a]
tListToList TList (Pat hash a, Maybe a)
ps)
    POne a
_ Pat hash a
e -> Doc ann
"Some" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty Pat hash a
e)
    PEmpty a
_ -> Doc ann
"None"
    PCommentAbove Comment a
c Pat hash a
e -> forall a ann. Pretty a => a -> Doc ann
pretty Comment a
c forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Pat hash a
e
    PCommentAfter Pat hash a
e Comment a
c -> forall a ann. Pretty a => a -> Doc ann
pretty Pat hash a
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Comment a
c
    PCommentBelow Pat hash a
e Comment a
c -> forall a ann. Pretty a => a -> Doc ann
pretty Pat hash a
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Comment a
c
    where
      prettyTuple :: Bool -> [(f pos, b)] -> Doc ann
prettyTuple Bool
firstElement = \case
        [] -> forall a. Monoid a => a
mempty
        [(f pos
e, b
_)] ->
          forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty f pos
e)
            forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment f pos
e then forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
")" else forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" )" Doc ann
")")
        (f pos
e, b
_) : [(f pos, b)]
es ->
          (if Bool -> Bool
not Bool
firstElement Bool -> Bool -> Bool
&& forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment f pos
e then forall ann. Doc ann
line else forall a. Monoid a => a
mempty)
            forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty f pos
e)
            forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment f pos
e then forall ann. Doc ann
hardline else forall ann. Doc ann
line')
            forall a. Semigroup a => a -> a -> a
<> Doc ann
", "
            forall a. Semigroup a => a -> a -> a
<> Bool -> [(f pos, b)] -> Doc ann
prettyTuple Bool
False [(f pos, b)]
es

instance Pretty (Expr hash pos) where
  pretty :: forall ann. Expr hash pos -> Doc ann
pretty = forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0

prettyPrec :: Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec :: forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
isBracketed Int
prec Expr hash pos
expr =
  case Expr hash pos
expr of
    Var pos
_ hash
_ Scoped ModuleName
ns ImplExpl
x -> (forall a. a -> Scoped a -> a
fromScoped forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Doc ann
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty ImplExpl
x
    TypeRep pos
_ InfernoType
ty -> Doc ann
"@" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty InfernoType
ty
    OpVar pos
_ hash
_ Scoped ModuleName
ns (Ident Text
x) -> (forall a. a -> Scoped a -> a
fromScoped forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Doc ann
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns) forall a. Semigroup a => a -> a -> a
<> Doc ann
"(" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
x forall a. Semigroup a => a -> a -> a
<> Doc ann
")"
    Enum pos
_ hash
_ Scoped ModuleName
ns (Ident Text
n) -> (forall a. a -> Scoped a -> a
fromScoped forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Doc ann
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns) forall a. Semigroup a => a -> a -> a
<> Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
n
    App Expr hash pos
_ Expr hash pos
_ -> forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall hash pos ann. [Expr hash pos] -> Doc ann
prettyApp forall a b. (a -> b) -> a -> b
$ forall hash pos. Expr hash pos -> [Expr hash pos]
collectApps Expr hash pos
expr
      where
        prettyAppAux :: Expr hash pos -> Doc ann -> Doc ann
prettyAppAux Expr hash pos
m Doc ann
p = case Expr hash pos
m of
          Var pos
_ hash
_ Scoped ModuleName
_ ImplExpl
_ -> Doc ann
p
          OpVar pos
_ hash
_ Scoped ModuleName
_ Ident
_ -> Doc ann
p
          Enum pos
_ hash
_ Scoped ModuleName
_ Ident
_ -> Doc ann
p
          Lit pos
_ Lit
_ -> Doc ann
p
          InterpolatedString pos
_ SomeIStr (pos, Expr hash pos, pos)
_ pos
_ -> Doc ann
p
          Tuple pos
_ TList (Expr hash pos, Maybe pos)
_ pos
_ -> Doc ann
p
          Empty pos
_ -> Doc ann
p
          Array pos
_ [(Expr hash pos, Maybe pos)]
_ pos
_ -> Doc ann
p
          ArrayComp pos
_ Expr hash pos
_ pos
_ NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
_ Maybe (pos, Expr hash pos)
_ pos
_ -> Doc ann
p
          Bracketed pos
_ Expr hash pos
_ pos
_ -> Doc ann
p
          Expr hash pos
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
m then Doc ann
p forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline else Doc ann
p

        prettyApp :: [Expr hash pos] -> Doc ann
prettyApp = \case
          [] -> forall a. Monoid a => a
mempty
          [Expr hash pos
x] -> forall {hash} {pos} {ann}. Expr hash pos -> Doc ann -> Doc ann
prettyAppAux Expr hash pos
x forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
True Int
0 Expr hash pos
x
          (Expr hash pos
x : [Expr hash pos]
xs) -> (forall {hash} {pos} {ann}. Expr hash pos -> Doc ann -> Doc ann
prettyAppAux Expr hash pos
x forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
True Int
0 Expr hash pos
x) forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
x then forall ann. Doc ann
hardline else forall ann. Doc ann
line) forall a. Semigroup a => a -> a -> a
<> [Expr hash pos] -> Doc ann
prettyApp [Expr hash pos]
xs
    Lam pos
_ NonEmpty (pos, Maybe ExtIdent)
xs pos
_ Expr hash pos
e ->
      let fun :: Doc ann
fun = Doc ann
"fun" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall ann. [Doc ann] -> Doc ann
sep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe Doc ann
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty (pos, Maybe ExtIdent)
xs) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"
          body :: Doc ann
body = forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e
       in forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
fun, Doc ann
body]
    Let pos
_ pos
_ ImplExpl
x pos
_ Expr hash pos
e1 pos
_ Expr hash pos
e2 ->
      let letPretty :: Doc ann
letPretty = Doc ann
"let" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty ImplExpl
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e1))
          body :: Doc ann
body = Doc ann
"in" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e2
       in Doc ann
letPretty forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e1 then forall ann. Doc ann
hardline else forall ann. Doc ann
line) forall a. Semigroup a => a -> a -> a
<> Doc ann
body
    Lit pos
_ Lit
l -> forall a ann. Pretty a => a -> Doc ann
pretty Lit
l
    InterpolatedString pos
_ SomeIStr (pos, Expr hash pos, pos)
istr pos
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose Doc ann
"`" Doc ann
"`" forall a b. (a -> b) -> a -> b
$
      forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
        forall ann. [Doc ann] -> Doc ann
cat' forall a b. (a -> b) -> a -> b
$
          case SomeIStr (pos, Expr hash pos, pos)
istr of
            SomeIStr IStr f (pos, Expr hash pos, pos)
ISEmpty -> []
            SomeIStr xs :: IStr f (pos, Expr hash pos, pos)
xs@(ISStr Text
_ IStr 'True (pos, Expr hash pos, pos)
_) -> forall a hash ann. IStr 'False (a, Expr hash a, a) -> [Doc ann]
prettyISStr IStr f (pos, Expr hash pos, pos)
xs
            SomeIStr xs :: IStr f (pos, Expr hash pos, pos)
xs@(ISExpr (pos, Expr hash pos, pos)
_ IStr f (pos, Expr hash pos, pos)
_) -> Doc ann
"${" forall a. a -> [a] -> [a]
: forall a hash ann. IStr 'True (a, Expr hash a, a) -> [Doc ann]
prettyISExpr IStr f (pos, Expr hash pos, pos)
xs
      where
        prettyISExpr :: IStr 'True (a, Expr hash a, a) -> [Doc ann]
        prettyISExpr :: forall a hash ann. IStr 'True (a, Expr hash a, a) -> [Doc ann]
prettyISExpr = \case
          IStr 'True (a, Expr hash a, a)
ISEmpty -> []
          ISExpr (a
_, Expr hash a
e, a
_) IStr f (a, Expr hash a, a)
ISEmpty -> (forall ann. Doc ann -> Doc ann
indentE forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash a
e) forall a. a -> [a] -> [a]
: if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash a
e then [forall ann. Doc ann
hardline, Doc ann
"}"] else [Doc ann
"}"]
          ISExpr (a
_, Expr hash a
e, a
_) xs :: IStr f (a, Expr hash a, a)
xs@(ISExpr (a, Expr hash a, a)
_ IStr f (a, Expr hash a, a)
_) ->
            ((forall ann. Doc ann -> Doc ann
indentE forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash a
e) forall a. a -> [a] -> [a]
: if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash a
e then [forall ann. Doc ann
hardline, Doc ann
"}${"] else [Doc ann
"}${"]) forall a. [a] -> [a] -> [a]
++ forall a hash ann. IStr 'True (a, Expr hash a, a) -> [Doc ann]
prettyISExpr IStr f (a, Expr hash a, a)
xs
          ISExpr (a
_, Expr hash a
e, a
_) (ISStr Text
str xs :: IStr 'True (a, Expr hash a, a)
xs@(ISExpr (a, Expr hash a, a)
_ IStr f (a, Expr hash a, a)
_)) ->
            let str' :: Doc ann
str' = forall ann. [Doc ann] -> Doc ann
vsepHard forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> [Doc ann]
addToLast forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> [Doc ann]
addToFirst forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
"\n" Text
str
             in ((forall ann. Doc ann -> Doc ann
indentE forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash a
e) forall a. a -> [a] -> [a]
: if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash a
e then [forall ann. Doc ann
hardline, Doc ann
str'] else [Doc ann
str']) forall a. [a] -> [a] -> [a]
++ forall a hash ann. IStr 'True (a, Expr hash a, a) -> [Doc ann]
prettyISExpr IStr 'True (a, Expr hash a, a)
xs
          ISExpr (a
_, Expr hash a
e, a
_) (ISStr Text
str IStr 'True (a, Expr hash a, a)
xs) ->
            let str' :: Doc ann
str' = forall ann. [Doc ann] -> Doc ann
vsepHard forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> [Doc ann]
addToFirst forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
"\n" Text
str
             in ((forall ann. Doc ann -> Doc ann
indentE forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash a
e) forall a. a -> [a] -> [a]
: if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash a
e then [forall ann. Doc ann
hardline, Doc ann
str'] else [Doc ann
str']) forall a. [a] -> [a] -> [a]
++ forall a hash ann. IStr 'True (a, Expr hash a, a) -> [Doc ann]
prettyISExpr IStr 'True (a, Expr hash a, a)
xs

        prettyISStr :: IStr 'False (a, Expr hash a, a) -> [Doc ann]
        prettyISStr :: forall a hash ann. IStr 'False (a, Expr hash a, a) -> [Doc ann]
prettyISStr = \case
          ISStr Text
str IStr 'True (a, Expr hash a, a)
ISEmpty -> [forall a ann. Pretty a => a -> Doc ann
pretty Text
str]
          ISStr Text
str IStr 'True (a, Expr hash a, a)
xs ->
            let str' :: Doc ann
str' = forall ann. [Doc ann] -> Doc ann
vsepHard forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> [Doc ann]
addToLast forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text.splitOn Text
"\n" Text
str
             in Doc ann
str' forall a. a -> [a] -> [a]
: forall a hash ann. IStr 'True (a, Expr hash a, a) -> [Doc ann]
prettyISExpr IStr 'True (a, Expr hash a, a)
xs

        addToLast, addToFirst :: [Doc ann] -> [Doc ann]
        addToLast :: forall ann. [Doc ann] -> [Doc ann]
addToLast = \case
          [] -> []
          [Doc ann
s] -> [Doc ann
s forall a. Semigroup a => a -> a -> a
<> Doc ann
"${"]
          Doc ann
s : [Doc ann]
xs -> Doc ann
s forall a. a -> [a] -> [a]
: forall ann. [Doc ann] -> [Doc ann]
addToLast [Doc ann]
xs
        addToFirst :: forall ann. [Doc ann] -> [Doc ann]
addToFirst = \case
          [] -> []
          Doc ann
s : [Doc ann]
xs -> (Doc ann
"}" forall a. Semigroup a => a -> a -> a
<> Doc ann
s) forall a. a -> [a] -> [a]
: [Doc ann]
xs
    If pos
_ Expr hash pos
c pos
_ Expr hash pos
t pos
_ Expr hash pos
f ->
      let ifPretty :: Doc ann
ifPretty = Doc ann
"if" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
c)
          thenPretty :: Doc ann
thenPretty = Doc ann
"then" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
t)
          elsePretty :: Doc ann
elsePretty = Doc ann
"else" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
f)
       in forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
            Doc ann
ifPretty
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
c then forall ann. Doc ann
hardline else forall ann. Doc ann
line)
              forall a. Semigroup a => a -> a -> a
<> Doc ann
thenPretty
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
t then forall ann. Doc ann
hardline else forall ann. Doc ann
line)
              forall a. Semigroup a => a -> a -> a
<> Doc ann
elsePretty
    Op Expr hash pos
e1 pos
_ hash
_ (Int
n, InfixFixity
NoFix) Scoped ModuleName
ns (Ident Text
op) Expr hash pos
e2 ->
      Expr hash pos -> Bool -> Doc ann -> Doc ann
bracketWhen Expr hash pos
e2 (Int
prec forall a. Ord a => a -> a -> Bool
> Int
n) forall a b. (a -> b) -> a -> b
$
        forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux (Int
n forall a. Num a => a -> a -> a
+ Int
1) Expr hash pos
e1 forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e1 then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {a} {ann}. Pretty a => Scoped ModuleName -> a -> Doc ann
prettyOp Scoped ModuleName
ns Text
op
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Expr hash pos
e2 then forall ann. Doc ann
line else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux (Int
n forall a. Num a => a -> a -> a
+ Int
1) Expr hash pos
e2
    Op Expr hash pos
e1 pos
_ hash
_ (Int
n, InfixFixity
LeftFix) Scoped ModuleName
ns (Ident Text
op) Expr hash pos
e2 ->
      Expr hash pos -> Bool -> Doc ann -> Doc ann
bracketWhen Expr hash pos
e2 (Int
prec forall a. Ord a => a -> a -> Bool
> Int
n) forall a b. (a -> b) -> a -> b
$
        forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux Int
n Expr hash pos
e1 forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e1 then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {a} {ann}. Pretty a => Scoped ModuleName -> a -> Doc ann
prettyOp Scoped ModuleName
ns Text
op
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Expr hash pos
e2 then forall ann. Doc ann
line else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux (Int
n forall a. Num a => a -> a -> a
+ Int
1) Expr hash pos
e2
    Op Expr hash pos
e1 pos
_ hash
_ (Int
n, InfixFixity
RightFix) Scoped ModuleName
ns (Ident Text
op) Expr hash pos
e2 ->
      Expr hash pos -> Bool -> Doc ann -> Doc ann
bracketWhen Expr hash pos
e2 (Int
prec forall a. Ord a => a -> a -> Bool
> Int
n) forall a b. (a -> b) -> a -> b
$
        forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux (Int
n forall a. Num a => a -> a -> a
+ Int
1) Expr hash pos
e1 forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e1 then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {a} {ann}. Pretty a => Scoped ModuleName -> a -> Doc ann
prettyOp Scoped ModuleName
ns Text
op
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Expr hash pos
e2 then forall ann. Doc ann
line else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux Int
n Expr hash pos
e2
    PreOp pos
_ hash
_ Int
n Scoped ModuleName
ns (Ident Text
op) Expr hash pos
e ->
      Expr hash pos -> Bool -> Doc ann -> Doc ann
bracketWhen Expr hash pos
e (Int
prec forall a. Ord a => a -> a -> Bool
> Int
n) forall a b. (a -> b) -> a -> b
$
        forall {a} {ann}. Pretty a => Scoped ModuleName -> a -> Doc ann
prettyOp Scoped ModuleName
ns Text
op
          forall ann. Doc ann -> Doc ann -> Doc ann
<+> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Expr hash pos
e then forall ann. Doc ann
line else forall a. Monoid a => a
mempty) forall a. Semigroup a => a -> a -> a
<> forall {hash} {pos} {ann}. Int -> Expr hash pos -> Doc ann
prettyOpAux (Int
n forall a. Num a => a -> a -> a
+ Int
1) Expr hash pos
e
    Tuple pos
_ TList (Expr hash pos, Maybe pos)
TNil pos
_ -> Doc ann
"()"
    Tuple pos
_ TList (Expr hash pos, Maybe pos)
xs pos
_ -> forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"( " Doc ann
"(") forall a. Semigroup a => a -> a -> a
<> forall {hash} {pos} {b} {ann}.
Bool -> [(Expr hash pos, b)] -> Doc ann
prettyTuple Bool
True (forall a. TList a -> [a]
tListToList TList (Expr hash pos, Maybe pos)
xs)
      where
        prettyTuple :: Bool -> [(Expr hash pos, b)] -> Doc ann
prettyTuple Bool
firstElement = \case
          [] -> forall a. Monoid a => a
mempty
          [(Expr hash pos
e, b
_)] ->
            forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
")" else forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" )" Doc ann
")")
          (Expr hash pos
e, b
_) : [(Expr hash pos, b)]
es ->
            (if Bool -> Bool
not Bool
firstElement Bool -> Bool -> Bool
&& forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Expr hash pos
e then forall ann. Doc ann
line else forall a. Monoid a => a
mempty)
              forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline else forall ann. Doc ann
line')
              forall a. Semigroup a => a -> a -> a
<> Doc ann
", "
              forall a. Semigroup a => a -> a -> a
<> Bool -> [(Expr hash pos, b)] -> Doc ann
prettyTuple Bool
False [(Expr hash pos, b)]
es
    One pos
_ Expr hash pos
e -> Doc ann
"Some" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
    Empty pos
_ -> Doc ann
"None"
    Assert pos
_ Expr hash pos
c pos
_ Expr hash pos
e ->
      let assertPretty :: Doc ann
assertPretty = Doc ann
"assert" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
c)
          body :: Doc ann
body = (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"    in" Doc ann
"in") forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
       in Doc ann
assertPretty forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
c then forall ann. Doc ann
hardline else forall ann. Doc ann
line) forall a. Semigroup a => a -> a -> a
<> Doc ann
body
    Case pos
_ Expr hash pos
e_case pos
_ NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
patExprs pos
_ ->
      forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$
        forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
          forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc ann
"match" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e_case forall a. Semigroup a => a -> a -> a
<> if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e_case then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"with" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"{",
              (forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall a hash ann.
Bool -> [(a, Pat hash a, a, Expr hash a)] -> Doc ann
prettyCase Bool
True forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
patExprs) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" }" Doc ann
"}"
            ]
      where
        prettyCase :: Bool -> [(a, Pat hash a, a, Expr hash a)] -> Doc ann
        prettyCase :: forall a hash ann.
Bool -> [(a, Pat hash a, a, Expr hash a)] -> Doc ann
prettyCase Bool
firstElement = \case
          [] -> forall a. Monoid a => a
mempty
          [(a
_, Pat hash a
pat, a
_, Expr hash a
e)] ->
            forall ann. Doc ann -> Doc ann
group
              ( Doc ann
"|"
                  forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align
                    ( forall a ann. Pretty a => a -> Doc ann
pretty Pat hash a
pat forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Pat hash a
pat then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
                        forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->"
                          forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
                          forall a. Semigroup a => a -> a -> a
<> (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash a
e)
                    )
              )
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash a
e then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
          (a
_, Pat hash a
pat, a
_, Expr hash a
e) : [(a, Pat hash a, a, Expr hash a)]
es ->
            (if Bool -> Bool
not Bool
firstElement Bool -> Bool -> Bool
&& forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Pat hash a
pat then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
              forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
group (Doc ann
"|" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty Pat hash a
pat forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Pat hash a
pat then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"->" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash a
e)))
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash a
e then forall ann. Doc ann
hardline else forall ann. Doc ann
line)
              forall a. Semigroup a => a -> a -> a
<> forall a hash ann.
Bool -> [(a, Pat hash a, a, Expr hash a)] -> Doc ann
prettyCase Bool
False [(a, Pat hash a, a, Expr hash a)]
es
    Array pos
_ [] pos
_ -> Doc ann
"[]"
    Array pos
_ [(Expr hash pos, Maybe pos)]
xs pos
_ -> forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"[ " Doc ann
"[") forall a. Semigroup a => a -> a -> a
<> forall {hash} {pos} {b} {ann}.
Bool -> [(Expr hash pos, b)] -> Doc ann
prettyArray Bool
True [(Expr hash pos, Maybe pos)]
xs
      where
        prettyArray :: Bool -> [(Expr hash pos, b)] -> Doc ann
prettyArray Bool
firstElement = \case
          [] -> forall a. Monoid a => a
mempty
          [(Expr hash pos
e, b
_)] ->
            forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
"]" else forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" ]" Doc ann
"]")
          (Expr hash pos
e, b
_) : [(Expr hash pos, b)]
es ->
            (if Bool -> Bool
not Bool
firstElement Bool -> Bool -> Bool
&& forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment Expr hash pos
e then forall ann. Doc ann
line else forall a. Monoid a => a
mempty)
              forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline else forall ann. Doc ann
line')
              forall a. Semigroup a => a -> a -> a
<> Doc ann
", "
              forall a. Semigroup a => a -> a -> a
<> Bool -> [(Expr hash pos, b)] -> Doc ann
prettyArray Bool
False [(Expr hash pos, b)]
es
    ArrayComp pos
_ Expr hash pos
e_body pos
_ NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
args Maybe (pos, Expr hash pos)
e_cond pos
_ ->
      forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lbracket forall ann. Doc ann
rbracket forall a b. (a -> b) -> a -> b
$
        forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$
          (forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e_body forall a. Semigroup a => a -> a -> a
<> if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e_body then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (Doc ann
"|" forall ann. Doc ann -> Doc ann -> Doc ann
<+> ([(pos, Ident, pos, Expr hash pos, Maybe pos)] -> Doc ann
argsPretty forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
args))
      where
        argsPretty :: [(pos, Ident, pos, Expr hash pos, Maybe pos)] -> Doc ann
argsPretty = \case
          [] -> forall a. Monoid a => a
mempty
          [(pos
_, Ident Text
n, pos
_, Expr hash pos
e, Maybe pos
_)] ->
            forall a ann. Pretty a => a -> Doc ann
pretty Text
n
              forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
              forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
                forall a. Semigroup a => a -> a -> a
<> case Maybe (pos, Expr hash pos)
e_cond of
                  Just (pos
_, Expr hash pos
c) -> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline else forall ann. Doc ann
line') forall a. Semigroup a => a -> a -> a
<> Doc ann
"," forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"if" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
c) forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
c then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
                  Maybe (pos, Expr hash pos)
Nothing -> if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty
          (pos
_, Ident Text
n, pos
_, Expr hash pos
e, Maybe pos
_) : [(pos, Ident, pos, Expr hash pos, Maybe pos)]
xs ->
            forall a ann. Pretty a => a -> Doc ann
pretty Text
n
              forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<-"
              forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
                forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline else forall ann. Doc ann
line')
                forall a. Semigroup a => a -> a -> a
<> Doc ann
", "
                forall a. Semigroup a => a -> a -> a
<> [(pos, Ident, pos, Expr hash pos, Maybe pos)] -> Doc ann
argsPretty [(pos, Ident, pos, Expr hash pos, Maybe pos)]
xs
    CommentAbove Comment pos
c Expr hash pos
e -> forall a ann. Pretty a => a -> Doc ann
pretty Comment pos
c forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
isBracketed Int
prec Expr hash pos
e
    CommentAfter Expr hash pos
e Comment pos
c -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
isBracketed Int
prec Expr hash pos
e forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Comment pos
c
    CommentBelow Expr hash pos
e Comment pos
c -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
isBracketed Int
prec Expr hash pos
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Comment pos
c
    Bracketed pos
_ Expr hash pos
e pos
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
True Int
prec Expr hash pos
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline else forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
True Int
prec Expr hash pos
e
    RenameModule pos
_ (ModuleName Text
nNew) pos
_ (ModuleName Text
nOld) pos
_ Expr hash pos
e ->
      let letPretty :: Doc ann
letPretty = Doc ann
"let" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (Doc ann
"module" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
nNew forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
nOld)
          body :: Doc ann
body = (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" in" Doc ann
"in") forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
       in Doc ann
letPretty forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> Doc ann
body
    OpenModule pos
_ hash
_ (ModuleName Text
n) [(Import pos, Maybe pos)]
ns pos
_ Expr hash pos
e ->
      Doc ann
"open"
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
n
          forall a. Semigroup a => a -> a -> a
<> ( case [(Import pos, Maybe pos)]
ns of
                 [] -> forall ann. Doc ann
line
                 [(Import pos, Maybe pos)]
_ -> (forall ann. Doc ann -> Doc ann
align forall a b. (a -> b) -> a -> b
$ forall ann. Doc ann -> Doc ann
group forall a b. (a -> b) -> a -> b
$ (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"( " Doc ann
"(") forall a. Semigroup a => a -> a -> a
<> forall {f :: * -> *} {pos} {ann}.
(Pretty (f pos), BlockUtils f) =>
Bool -> [f pos] -> Doc ann
prettyImports Bool
True (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Import pos, Maybe pos)]
ns)) forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (forall a. [a] -> a
last [(Import pos, Maybe pos)]
ns) then forall ann. Doc ann
hardline else forall ann. Doc ann
line)
             )
          forall a. Semigroup a => a -> a -> a
<> (forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
"  in" Doc ann
"in")
        forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
align (forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
0 Expr hash pos
e)
      where
        prettyImports :: Bool -> [f pos] -> Doc ann
prettyImports Bool
firstElement = \case
          [] -> forall a. Monoid a => a
mempty
          [f pos
i] ->
            forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty f pos
i)
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment f pos
i then forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
")" else forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
" )" Doc ann
")")
          f pos
i : [f pos]
is ->
            (if Bool -> Bool
not Bool
firstElement Bool -> Bool -> Bool
&& forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasLeadingComment f pos
i then forall ann. Doc ann
line else forall a. Monoid a => a
mempty)
              forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
align (forall a ann. Pretty a => a -> Doc ann
pretty f pos
i)
              forall a. Semigroup a => a -> a -> a
<> (if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment f pos
i then forall ann. Doc ann
hardline else forall ann. Doc ann
line')
              forall a. Semigroup a => a -> a -> a
<> Doc ann
", "
              forall a. Semigroup a => a -> a -> a
<> Bool -> [f pos] -> Doc ann
prettyImports Bool
False [f pos]
is
  where
    indentE :: Doc ann -> Doc ann
indentE Doc ann
e = forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt (forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc ann
e) Doc ann
e

    vsepHard :: [Doc ann] -> Doc ann
    vsepHard :: forall ann. [Doc ann] -> Doc ann
vsepHard = forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> Doc ann
y)

    cat' :: [Doc ann] -> Doc ann
    cat' :: forall ann. [Doc ann] -> Doc ann
cat' [] = forall a. Monoid a => a
mempty
    cat' [Doc ann
x] = Doc ann
x
    cat' (Doc ann
x : Doc ann
Pretty.Line : [Doc ann]
xs) = Doc ann
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
cat' [Doc ann]
xs
    cat' (Doc ann
x : [Doc ann]
xs) = Doc ann
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line' forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
cat' [Doc ann]
xs

    bracketWhen :: Expr hash pos -> Bool -> Doc ann -> Doc ann
bracketWhen Expr hash pos
e Bool
b =
      if Bool
isBracketed
        then forall a. a -> a
id
        else
          if Bool
b
            then (\Doc ann
x -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ Doc ann
x forall a. Semigroup a => a -> a -> a
<> if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall ann. Doc ann
hardline else forall a. Monoid a => a
mempty)
            else forall a. a -> a
id

    prettyOp :: Scoped ModuleName -> a -> Doc ann
prettyOp Scoped ModuleName
ns a
op = (forall a. a -> Scoped a -> a
fromScoped forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ (forall a. Semigroup a => a -> a -> a
<> Doc ann
".") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scoped ModuleName
ns) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
op

    prettyOpAux :: Int -> Expr hash pos -> Doc ann
prettyOpAux Int
n Expr hash pos
e = case Expr hash pos
e of
      Var pos
_ hash
_ Scoped ModuleName
_ ImplExpl
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      OpVar pos
_ hash
_ Scoped ModuleName
_ Ident
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Enum pos
_ hash
_ Scoped ModuleName
_ Ident
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Lit pos
_ Lit
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      InterpolatedString pos
_ SomeIStr (pos, Expr hash pos, pos)
_ pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Tuple pos
_ TList (Expr hash pos, Maybe pos)
_ pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Empty pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Array pos
_ [(Expr hash pos, Maybe pos)]
_ pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      ArrayComp pos
_ Expr hash pos
_ pos
_ NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
_ Maybe (pos, Expr hash pos)
_ pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Bracketed pos
_ Expr hash pos
_ pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Op Expr hash pos
_ pos
_ hash
_ (Int, InfixFixity)
_ Scoped ModuleName
_ Ident
_ Expr hash pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      PreOp pos
_ hash
_ Int
_ Scoped ModuleName
_ Ident
_ Expr hash pos
_ -> forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e
      Expr hash pos
_ -> forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
enclose forall ann. Doc ann
lparen forall ann. Doc ann
rparen forall a b. (a -> b) -> a -> b
$ if forall (f :: * -> *) pos. BlockUtils f => f pos -> Bool
hasTrailingComment Expr hash pos
e then forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline else forall hash pos ann. Bool -> Int -> Expr hash pos -> Doc ann
prettyPrec Bool
False Int
n Expr hash pos
e

data SigVar = SigVar Text | SigOpVar Text deriving (SigVar -> SigVar -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigVar -> SigVar -> Bool
$c/= :: SigVar -> SigVar -> Bool
== :: SigVar -> SigVar -> Bool
$c== :: SigVar -> SigVar -> Bool
Eq, Int -> SigVar -> ShowS
[SigVar] -> ShowS
SigVar -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SigVar] -> ShowS
$cshowList :: [SigVar] -> ShowS
show :: SigVar -> FilePath
$cshow :: SigVar -> FilePath
showsPrec :: Int -> SigVar -> ShowS
$cshowsPrec :: Int -> SigVar -> ShowS
Show, Typeable SigVar
SigVar -> DataType
SigVar -> Constr
(forall b. Data b => b -> b) -> SigVar -> SigVar
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SigVar -> u
forall u. (forall d. Data d => d -> u) -> SigVar -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SigVar -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SigVar -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SigVar
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SigVar -> c SigVar
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SigVar)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SigVar)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SigVar -> m SigVar
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SigVar -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SigVar -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SigVar -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SigVar -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SigVar -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SigVar -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SigVar -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SigVar -> r
gmapT :: (forall b. Data b => b -> b) -> SigVar -> SigVar
$cgmapT :: (forall b. Data b => b -> b) -> SigVar -> SigVar
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SigVar)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SigVar)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SigVar)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SigVar)
dataTypeOf :: SigVar -> DataType
$cdataTypeOf :: SigVar -> DataType
toConstr :: SigVar -> Constr
$ctoConstr :: SigVar -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SigVar
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SigVar
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SigVar -> c SigVar
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SigVar -> c SigVar
Data)

sigVarToIdent :: SigVar -> Ident
sigVarToIdent :: SigVar -> Ident
sigVarToIdent SigVar
x = Text -> Ident
Ident forall a b. (a -> b) -> a -> b
$ case SigVar
x of
  SigVar Text
i -> Text
i
  SigOpVar Text
i -> Text
i

sigVarToExpr :: Scoped ModuleName -> SigVar -> Expr () ()
sigVarToExpr :: Scoped ModuleName -> SigVar -> Expr () ()
sigVarToExpr Scoped ModuleName
modNm = \case
  SigVar Text
i -> forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var () () Scoped ModuleName
modNm forall a b. (a -> b) -> a -> b
$ ExtIdent -> ImplExpl
Expl forall a b. (a -> b) -> a -> b
$ Either Int Text -> ExtIdent
ExtIdent forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
i
  SigOpVar Text
i -> forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
OpVar () () Scoped ModuleName
modNm forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident Text
i

type OpsTable = IntMap.IntMap [(Fixity, Scoped ModuleName, Text)]

class Dependencies f hash where
  getDependencies :: Ord hash => f -> Set.Set hash

instance Dependencies (Pat hash pos) hash where
  getDependencies :: Ord hash => Pat hash pos -> Set hash
getDependencies = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
    PEnumF pos
_ hash
h Scoped ModuleName
_ Ident
_ -> forall a. a -> Set a
Set.singleton hash
h
    Base (Pat hash pos) (Set hash)
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a. Monoid a => a
mempty Base (Pat hash pos) (Set hash)
rest

instance Dependencies (Expr hash pos) hash where
  getDependencies :: Ord hash => Expr hash pos -> Set hash
getDependencies = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
    VarF pos
_ hash
h Scoped ModuleName
_ ImplExpl
_ -> forall a. a -> Set a
Set.singleton hash
h
    OpVarF pos
_ hash
h Scoped ModuleName
_ Ident
_ -> forall a. a -> Set a
Set.singleton hash
h
    EnumF pos
_ hash
h Scoped ModuleName
_ Ident
_ -> forall a. a -> Set a
Set.singleton hash
h
    OpF Set hash
_ pos
_ hash
h (Int, InfixFixity)
_ Scoped ModuleName
_ Ident
_ Set hash
_ -> forall a. a -> Set a
Set.singleton hash
h
    Base (Expr hash pos) (Set hash)
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a. Monoid a => a
mempty Base (Expr hash pos) (Set hash)
rest