{-# OPTIONS -funbox-strict-fields #-}

-- | Common provides simple functions to the backend.
-- It defines most of the data types.
-- All modules should call 'error' via the 'common_error' function below.

module Text.Regex.TDFA.Common where

import Text.Regex.Base(RegexOptions(..))

{- By Chris Kuklewicz, 2007-2009. BSD License, see the LICENSE file. -}
import Data.Array.IArray(Array)
import Data.IntSet.EnumSet2(EnumSet)
import qualified Data.IntSet.EnumSet2 as Set(toList)
import Data.IntMap.CharMap2(CharMap(..))
import Data.IntMap (IntMap)
import qualified Data.IntMap as IMap (findWithDefault,assocs,toList,null,size,toAscList)
import Data.IntSet(IntSet)
import qualified Data.IntMap.CharMap2 as Map (assocs,toAscList,null)
import Data.Sequence as S(Seq)
--import Debug.Trace

import Text.Regex.TDFA.IntArrTrieSet(TrieSet)

{-# INLINE look #-}
look :: Int -> IntMap a -> a
look :: forall a. Int -> IntMap a -> a
look Int
key IntMap a
imap = a -> Int -> IntMap a -> a
forall a. a -> Int -> IntMap a -> a
IMap.findWithDefault (String -> String -> a
forall a. String -> String -> a
common_error String
"Text.Regex.DFA.Common" (String
"key "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
keyString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" not found in look")) Int
key IntMap a
imap

common_error :: String -> String -> a
common_error :: forall a. String -> String -> a
common_error String
moduleName String
message =
  String -> a
forall a. HasCallStack => String -> a
error (String
"Explict error in module "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
moduleNameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" : "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
message)

on :: (t1 -> t1 -> t2) -> (t -> t1) -> t -> t -> t2
t1 -> t1 -> t2
f on :: forall t1 t2 t. (t1 -> t1 -> t2) -> (t -> t1) -> t -> t -> t2
`on` t -> t1
g = (\t
x t
y -> (t -> t1
g t
x) t1 -> t1 -> t2
`f` (t -> t1
g t
y))

-- | After 'sort' or 'sortBy' the use of 'nub' or 'nubBy' can be replaced by 'norep' or 'norepBy'.
norep :: (Eq a) => [a]->[a]
norep :: forall a. Eq a => [a] -> [a]
norep [] = []
norep x :: [a]
x@[a
_] = [a]
x
norep (a
a:bs :: [a]
bs@(a
c:[a]
cs)) | a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
c = [a] -> [a]
forall a. Eq a => [a] -> [a]
norep (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs)
                    | Bool
otherwise = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
forall a. Eq a => [a] -> [a]
norep [a]
bs

-- | After 'sort' or 'sortBy' the use of 'nub' or 'nubBy' can be replaced by 'norep' or 'norepBy'.
norepBy :: (a -> a -> Bool) -> [a] -> [a]
norepBy :: forall a. (a -> a -> Bool) -> [a] -> [a]
norepBy a -> a -> Bool
_ [] = []
norepBy a -> a -> Bool
_ x :: [a]
x@[a
_] = [a]
x
norepBy a -> a -> Bool
eqF (a
a:bs :: [a]
bs@(a
c:[a]
cs)) | a
a a -> a -> Bool
`eqF` a
c = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
norepBy a -> a -> Bool
eqF (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs)
                          | Bool
otherwise = a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
norepBy a -> a -> Bool
eqF [a]
bs

mapFst :: (Functor f) => (t -> t2) -> f (t, t1) -> f (t2, t1)
mapFst :: forall (f :: * -> *) t t2 t1.
Functor f =>
(t -> t2) -> f (t, t1) -> f (t2, t1)
mapFst t -> t2
f = ((t, t1) -> (t2, t1)) -> f (t, t1) -> f (t2, t1)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (t
a,t1
b) -> (t -> t2
f t
a,t1
b))

mapSnd :: (Functor f) => (t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd :: forall (f :: * -> *) t1 t2 t.
Functor f =>
(t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd t1 -> t2
f = ((t, t1) -> (t, t2)) -> f (t, t1) -> f (t, t2)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (t
a,t1
b) -> (t
a,t1 -> t2
f t1
b))

fst3 :: (a,b,c) -> a
fst3 :: forall a b c. (a, b, c) -> a
fst3 (a
x,b
_,c
_) = a
x

snd3 :: (a,b,c) -> b
snd3 :: forall a b c. (a, b, c) -> b
snd3 (a
_,b
x,c
_) = b
x

thd3 :: (a,b,c) -> c
thd3 :: forall a b c. (a, b, c) -> c
thd3 (a
_,b
_,c
x) = c
x

flipOrder :: Ordering -> Ordering
flipOrder :: Ordering -> Ordering
flipOrder Ordering
GT = Ordering
LT
flipOrder Ordering
LT = Ordering
GT
flipOrder Ordering
EQ = Ordering
EQ

noWin :: WinTags -> Bool
noWin :: WinTags -> Bool
noWin = WinTags -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- | Used to track elements of the pattern that accept characters or are anchors.
newtype DoPa = DoPa {DoPa -> Int
dopaIndex :: Int} deriving (DoPa -> DoPa -> Bool
(DoPa -> DoPa -> Bool) -> (DoPa -> DoPa -> Bool) -> Eq DoPa
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DoPa -> DoPa -> Bool
== :: DoPa -> DoPa -> Bool
$c/= :: DoPa -> DoPa -> Bool
/= :: DoPa -> DoPa -> Bool
Eq,Eq DoPa
Eq DoPa =>
(DoPa -> DoPa -> Ordering)
-> (DoPa -> DoPa -> Bool)
-> (DoPa -> DoPa -> Bool)
-> (DoPa -> DoPa -> Bool)
-> (DoPa -> DoPa -> Bool)
-> (DoPa -> DoPa -> DoPa)
-> (DoPa -> DoPa -> DoPa)
-> Ord DoPa
DoPa -> DoPa -> Bool
DoPa -> DoPa -> Ordering
DoPa -> DoPa -> DoPa
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DoPa -> DoPa -> Ordering
compare :: DoPa -> DoPa -> Ordering
$c< :: DoPa -> DoPa -> Bool
< :: DoPa -> DoPa -> Bool
$c<= :: DoPa -> DoPa -> Bool
<= :: DoPa -> DoPa -> Bool
$c> :: DoPa -> DoPa -> Bool
> :: DoPa -> DoPa -> Bool
$c>= :: DoPa -> DoPa -> Bool
>= :: DoPa -> DoPa -> Bool
$cmax :: DoPa -> DoPa -> DoPa
max :: DoPa -> DoPa -> DoPa
$cmin :: DoPa -> DoPa -> DoPa
min :: DoPa -> DoPa -> DoPa
Ord)

instance Enum DoPa where
  toEnum :: Int -> DoPa
toEnum = Int -> DoPa
DoPa
  fromEnum :: DoPa -> Int
fromEnum = DoPa -> Int
dopaIndex

instance Show DoPa where
  showsPrec :: Int -> DoPa -> String -> String
showsPrec Int
p (DoPa {dopaIndex :: DoPa -> Int
dopaIndex=Int
i}) = (Key
'#'Key -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
p Int
i

-- | Control whether the pattern is multiline or case-sensitive like Text.Regex and whether to
-- capture the subgroups (\\1, \\2, etc).  Controls enabling extra anchor syntax.
data CompOption = CompOption {
    CompOption -> Bool
caseSensitive :: Bool
      -- ^ True in 'blankCompOpt' and 'defaultCompOpt'.
  , CompOption -> Bool
multiline :: Bool
      -- ^ False in 'blankCompOpt', True in 'defaultCompOpt'.
      -- Compile for newline-sensitive matching.
      --
      -- From [regexp man page](https://www.tcl.tk/man/tcl8.4/TclCmd/regexp.html#M8):
      -- "By default, newline is a completely ordinary character with no special meaning in either REs or strings.
      -- With this flag, inverted bracket expressions @[^@ and @.@ never match newline,
      -- a @^@ anchor matches the null string after any newline in the string in addition to its normal function,
      -- and the @$@ anchor matches the null string before any newline in the string in addition to its normal function."
  , CompOption -> Bool
rightAssoc :: Bool
      -- ^ True (and therefore right associative) in 'blankCompOpt' and 'defaultCompOpt'.
  , CompOption -> Bool
newSyntax :: Bool
      -- ^ False in 'blankCompOpt', True in 'defaultCompOpt'.
      -- Enables the extended non-POSIX syntax described in "Text.Regex.TDFA" haddock documentation.
  , CompOption -> Bool
lastStarGreedy ::  Bool
      -- ^ False by default.  This is POSIX correct but it takes space and is slower.
      -- Setting this to True will improve performance, and should be done
      -- if you plan to set the 'captureGroups' 'ExecOption' to False.
  } deriving (ReadPrec [CompOption]
ReadPrec CompOption
Int -> ReadS CompOption
ReadS [CompOption]
(Int -> ReadS CompOption)
-> ReadS [CompOption]
-> ReadPrec CompOption
-> ReadPrec [CompOption]
-> Read CompOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CompOption
readsPrec :: Int -> ReadS CompOption
$creadList :: ReadS [CompOption]
readList :: ReadS [CompOption]
$creadPrec :: ReadPrec CompOption
readPrec :: ReadPrec CompOption
$creadListPrec :: ReadPrec [CompOption]
readListPrec :: ReadPrec [CompOption]
Read,Int -> CompOption -> String -> String
[CompOption] -> String -> String
CompOption -> String
(Int -> CompOption -> String -> String)
-> (CompOption -> String)
-> ([CompOption] -> String -> String)
-> Show CompOption
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CompOption -> String -> String
showsPrec :: Int -> CompOption -> String -> String
$cshow :: CompOption -> String
show :: CompOption -> String
$cshowList :: [CompOption] -> String -> String
showList :: [CompOption] -> String -> String
Show)

data ExecOption = ExecOption {
    ExecOption -> Bool
captureGroups :: Bool    -- ^ True by default.  Set to False to improve speed (and space).
  } deriving (ReadPrec [ExecOption]
ReadPrec ExecOption
Int -> ReadS ExecOption
ReadS [ExecOption]
(Int -> ReadS ExecOption)
-> ReadS [ExecOption]
-> ReadPrec ExecOption
-> ReadPrec [ExecOption]
-> Read ExecOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ExecOption
readsPrec :: Int -> ReadS ExecOption
$creadList :: ReadS [ExecOption]
readList :: ReadS [ExecOption]
$creadPrec :: ReadPrec ExecOption
readPrec :: ReadPrec ExecOption
$creadListPrec :: ReadPrec [ExecOption]
readListPrec :: ReadPrec [ExecOption]
Read,Int -> ExecOption -> String -> String
[ExecOption] -> String -> String
ExecOption -> String
(Int -> ExecOption -> String -> String)
-> (ExecOption -> String)
-> ([ExecOption] -> String -> String)
-> Show ExecOption
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ExecOption -> String -> String
showsPrec :: Int -> ExecOption -> String -> String
$cshow :: ExecOption -> String
show :: ExecOption -> String
$cshowList :: [ExecOption] -> String -> String
showList :: [ExecOption] -> String -> String
Show)

-- | Used by implementation to name certain 'Postion's during
-- matching. Identity of 'Position' tag to set during a transition.
type Tag = Int

-- | Internal use to indicate type of tag and preference for larger or smaller 'Position's.
data OP = Maximize | Minimize | Orbit | Ignore deriving (OP -> OP -> Bool
(OP -> OP -> Bool) -> (OP -> OP -> Bool) -> Eq OP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OP -> OP -> Bool
== :: OP -> OP -> Bool
$c/= :: OP -> OP -> Bool
/= :: OP -> OP -> Bool
Eq,Int -> OP -> String -> String
[OP] -> String -> String
OP -> String
(Int -> OP -> String -> String)
-> (OP -> String) -> ([OP] -> String -> String) -> Show OP
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> OP -> String -> String
showsPrec :: Int -> OP -> String -> String
$cshow :: OP -> String
show :: OP -> String
$cshowList :: [OP] -> String -> String
showList :: [OP] -> String -> String
Show)

-- | Internal NFA node identity number.
type Index = Int

-- | Internal DFA identity is this 'Set' of NFA 'Index'.
type SetIndex = IntSet {- Index -}

-- | Index into the text being searched.
type Position = Int

-- | 'GroupIndex' is for indexing submatches from capturing parenthesized groups ('PGroup' or 'Group').
type GroupIndex = Int

-- | 'GroupInfo' collects the parent and tag information for an instance of a group.
data GroupInfo = GroupInfo {
    GroupInfo -> Int
thisIndex, GroupInfo -> Int
parentIndex :: GroupIndex
  , GroupInfo -> Int
startTag, GroupInfo -> Int
stopTag, GroupInfo -> Int
flagTag :: Tag
  } deriving Int -> GroupInfo -> String -> String
[GroupInfo] -> String -> String
GroupInfo -> String
(Int -> GroupInfo -> String -> String)
-> (GroupInfo -> String)
-> ([GroupInfo] -> String -> String)
-> Show GroupInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GroupInfo -> String -> String
showsPrec :: Int -> GroupInfo -> String -> String
$cshow :: GroupInfo -> String
show :: GroupInfo -> String
$cshowList :: [GroupInfo] -> String -> String
showList :: [GroupInfo] -> String -> String
Show

-- | The TDFA backend specific 'Regex' type, used by this module's 'RegexOptions' and 'RegexMaker'.
data Regex = Regex {
    Regex -> DFA
regex_dfa :: DFA                             -- ^ starting DFA state
  , Regex -> Int
regex_init :: Index                          -- ^ index of starting state
  , Regex -> (Int, Int)
regex_b_index :: (Index,Index)               -- ^ indexes of smallest and largest states
  , Regex -> (Int, Int)
regex_b_tags :: (Tag,Tag)                    -- ^ indexes of smallest and largest tags
  , Regex -> TrieSet DFA
regex_trie :: TrieSet DFA                    -- ^ All DFA states
  , Regex -> Array Int OP
regex_tags :: Array Tag OP                   -- ^ information about each tag
  , Regex -> Array Int [GroupInfo]
regex_groups :: Array GroupIndex [GroupInfo] -- ^ information about each group
  , Regex -> Bool
regex_isFrontAnchored :: Bool                -- ^ used for optimizing execution
  , Regex -> CompOption
regex_compOptions :: CompOption
  , Regex -> ExecOption
regex_execOptions :: ExecOption
  } -- no deriving at all, the DFA may be too big to ever traverse!


instance RegexOptions Regex CompOption ExecOption where
  blankCompOpt :: CompOption
blankCompOpt =  CompOption { caseSensitive :: Bool
caseSensitive = Bool
True
                             , multiline :: Bool
multiline = Bool
False
                             , rightAssoc :: Bool
rightAssoc = Bool
True
                             , newSyntax :: Bool
newSyntax = Bool
False
                             , lastStarGreedy :: Bool
lastStarGreedy = Bool
False
                             }
  blankExecOpt :: ExecOption
blankExecOpt =  ExecOption { captureGroups :: Bool
captureGroups = Bool
True }
  defaultCompOpt :: CompOption
defaultCompOpt = CompOption { caseSensitive :: Bool
caseSensitive = Bool
True
                              , multiline :: Bool
multiline = Bool
True
                              , rightAssoc :: Bool
rightAssoc = Bool
True
                              , newSyntax :: Bool
newSyntax = Bool
True
                              , lastStarGreedy :: Bool
lastStarGreedy = Bool
False
                              }
  defaultExecOpt :: ExecOption
defaultExecOpt =  ExecOption { captureGroups :: Bool
captureGroups = Bool
True }
  setExecOpts :: ExecOption -> Regex -> Regex
setExecOpts ExecOption
e Regex
r = Regex
r {regex_execOptions=e}
  getExecOpts :: Regex -> ExecOption
getExecOpts Regex
r = Regex -> ExecOption
regex_execOptions Regex
r


data WinEmpty = WinEmpty Instructions
              | WinTest WhichTest (Maybe WinEmpty) (Maybe WinEmpty)
  deriving Int -> WinEmpty -> String -> String
[WinEmpty] -> String -> String
WinEmpty -> String
(Int -> WinEmpty -> String -> String)
-> (WinEmpty -> String)
-> ([WinEmpty] -> String -> String)
-> Show WinEmpty
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> WinEmpty -> String -> String
showsPrec :: Int -> WinEmpty -> String -> String
$cshow :: WinEmpty -> String
show :: WinEmpty -> String
$cshowList :: [WinEmpty] -> String -> String
showList :: [WinEmpty] -> String -> String
Show

-- | Internal NFA node type.
data QNFA = QNFA {QNFA -> Int
q_id :: Index, QNFA -> QT
q_qt :: QT}

-- | Internal to 'QNFA' type.
data QT = Simple { QT -> WinTags
qt_win :: WinTags -- ^ empty transitions to the virtual winning state
                 , QT -> CharMap QTrans
qt_trans :: CharMap QTrans -- ^ all ways to leave this QNFA to other or the same QNFA
                 , QT -> QTrans
qt_other :: QTrans -- ^ default ways to leave this QNFA to other or the same QNFA
                 }
        | Testing { QT -> WhichTest
qt_test :: WhichTest -- ^ The test to perform
                  , QT -> EnumSet DoPa
qt_dopas :: EnumSet DoPa  -- ^ location(s) of the anchor(s) in the original regexp
                  , QT -> QT
qt_a, QT -> QT
qt_b :: QT -- ^ use qt_a if test is True, else use qt_b
                  }

-- | Internal type to represent the tagged transition from one QNFA to
-- another (or itself).  The key is the Index of the destination QNFA.
type QTrans = IntMap {- Destination Index -} [TagCommand]

-- | Known predicates, just Beginning of Line (^) and End of Line ($).
-- Also support for GNU extensions is being added: \\\` beginning of
-- buffer, \\\' end of buffer, \\\< and \\\> for begin and end of words, \\b
-- and \\B for word boundary and not word boundary.
data WhichTest
  = Test_BOL          -- ^ @^@ (affected by multiline option)
  | Test_EOL          -- ^ @$@ (affected by multiline option)
  | Test_BOB          -- ^ @\\`@ beginning of buffer
  | Test_EOB          -- ^ @\\'@ end ofbuffer
  | Test_BOW          -- ^ @\\<@ beginning of word
  | Test_EOW          -- ^ @\\>@ end of word
  | Test_EdgeWord     -- ^ @\\b@ word boundary
  | Test_NotEdgeWord  -- ^ @\\B@ not word boundary
  deriving (Int -> WhichTest -> String -> String
[WhichTest] -> String -> String
WhichTest -> String
(Int -> WhichTest -> String -> String)
-> (WhichTest -> String)
-> ([WhichTest] -> String -> String)
-> Show WhichTest
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> WhichTest -> String -> String
showsPrec :: Int -> WhichTest -> String -> String
$cshow :: WhichTest -> String
show :: WhichTest -> String
$cshowList :: [WhichTest] -> String -> String
showList :: [WhichTest] -> String -> String
Show,WhichTest -> WhichTest -> Bool
(WhichTest -> WhichTest -> Bool)
-> (WhichTest -> WhichTest -> Bool) -> Eq WhichTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhichTest -> WhichTest -> Bool
== :: WhichTest -> WhichTest -> Bool
$c/= :: WhichTest -> WhichTest -> Bool
/= :: WhichTest -> WhichTest -> Bool
Eq,Eq WhichTest
Eq WhichTest =>
(WhichTest -> WhichTest -> Ordering)
-> (WhichTest -> WhichTest -> Bool)
-> (WhichTest -> WhichTest -> Bool)
-> (WhichTest -> WhichTest -> Bool)
-> (WhichTest -> WhichTest -> Bool)
-> (WhichTest -> WhichTest -> WhichTest)
-> (WhichTest -> WhichTest -> WhichTest)
-> Ord WhichTest
WhichTest -> WhichTest -> Bool
WhichTest -> WhichTest -> Ordering
WhichTest -> WhichTest -> WhichTest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WhichTest -> WhichTest -> Ordering
compare :: WhichTest -> WhichTest -> Ordering
$c< :: WhichTest -> WhichTest -> Bool
< :: WhichTest -> WhichTest -> Bool
$c<= :: WhichTest -> WhichTest -> Bool
<= :: WhichTest -> WhichTest -> Bool
$c> :: WhichTest -> WhichTest -> Bool
> :: WhichTest -> WhichTest -> Bool
$c>= :: WhichTest -> WhichTest -> Bool
>= :: WhichTest -> WhichTest -> Bool
$cmax :: WhichTest -> WhichTest -> WhichTest
max :: WhichTest -> WhichTest -> WhichTest
$cmin :: WhichTest -> WhichTest -> WhichTest
min :: WhichTest -> WhichTest -> WhichTest
Ord,Int -> WhichTest
WhichTest -> Int
WhichTest -> [WhichTest]
WhichTest -> WhichTest
WhichTest -> WhichTest -> [WhichTest]
WhichTest -> WhichTest -> WhichTest -> [WhichTest]
(WhichTest -> WhichTest)
-> (WhichTest -> WhichTest)
-> (Int -> WhichTest)
-> (WhichTest -> Int)
-> (WhichTest -> [WhichTest])
-> (WhichTest -> WhichTest -> [WhichTest])
-> (WhichTest -> WhichTest -> [WhichTest])
-> (WhichTest -> WhichTest -> WhichTest -> [WhichTest])
-> Enum WhichTest
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: WhichTest -> WhichTest
succ :: WhichTest -> WhichTest
$cpred :: WhichTest -> WhichTest
pred :: WhichTest -> WhichTest
$ctoEnum :: Int -> WhichTest
toEnum :: Int -> WhichTest
$cfromEnum :: WhichTest -> Int
fromEnum :: WhichTest -> Int
$cenumFrom :: WhichTest -> [WhichTest]
enumFrom :: WhichTest -> [WhichTest]
$cenumFromThen :: WhichTest -> WhichTest -> [WhichTest]
enumFromThen :: WhichTest -> WhichTest -> [WhichTest]
$cenumFromTo :: WhichTest -> WhichTest -> [WhichTest]
enumFromTo :: WhichTest -> WhichTest -> [WhichTest]
$cenumFromThenTo :: WhichTest -> WhichTest -> WhichTest -> [WhichTest]
enumFromThenTo :: WhichTest -> WhichTest -> WhichTest -> [WhichTest]
Enum)

-- | The things that can be done with a Tag.  'TagTask' and
-- 'ResetGroupStopTask' are for tags with Maximize or Minimize OP
-- values.  'ResetOrbitTask' and 'EnterOrbitTask' and 'LeaveOrbitTask' are
-- for tags with Orbit OP value.
data TagTask = TagTask | ResetGroupStopTask | SetGroupStopTask
             | ResetOrbitTask | EnterOrbitTask | LeaveOrbitTask deriving (Int -> TagTask -> String -> String
[TagTask] -> String -> String
TagTask -> String
(Int -> TagTask -> String -> String)
-> (TagTask -> String)
-> ([TagTask] -> String -> String)
-> Show TagTask
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TagTask -> String -> String
showsPrec :: Int -> TagTask -> String -> String
$cshow :: TagTask -> String
show :: TagTask -> String
$cshowList :: [TagTask] -> String -> String
showList :: [TagTask] -> String -> String
Show,TagTask -> TagTask -> Bool
(TagTask -> TagTask -> Bool)
-> (TagTask -> TagTask -> Bool) -> Eq TagTask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagTask -> TagTask -> Bool
== :: TagTask -> TagTask -> Bool
$c/= :: TagTask -> TagTask -> Bool
/= :: TagTask -> TagTask -> Bool
Eq)

-- | Ordered list of tags and their associated Task.
type TagTasks = [(Tag,TagTask)]

-- | When attached to a QTrans the TagTask can be done before or after
-- accepting the character.
data TagUpdate = PreUpdate TagTask | PostUpdate TagTask deriving (Int -> TagUpdate -> String -> String
[TagUpdate] -> String -> String
TagUpdate -> String
(Int -> TagUpdate -> String -> String)
-> (TagUpdate -> String)
-> ([TagUpdate] -> String -> String)
-> Show TagUpdate
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TagUpdate -> String -> String
showsPrec :: Int -> TagUpdate -> String -> String
$cshow :: TagUpdate -> String
show :: TagUpdate -> String
$cshowList :: [TagUpdate] -> String -> String
showList :: [TagUpdate] -> String -> String
Show,TagUpdate -> TagUpdate -> Bool
(TagUpdate -> TagUpdate -> Bool)
-> (TagUpdate -> TagUpdate -> Bool) -> Eq TagUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagUpdate -> TagUpdate -> Bool
== :: TagUpdate -> TagUpdate -> Bool
$c/= :: TagUpdate -> TagUpdate -> Bool
/= :: TagUpdate -> TagUpdate -> Bool
Eq)

-- | Ordered list of tags and their associated update operation.
type TagList = [(Tag,TagUpdate)]

-- | A TagList and the location of the item in the original pattern
-- that is being accepted.
type TagCommand = (DoPa,TagList)

-- | Ordered list of tags and their associated update operation to
-- perform on an empty transition to the virtual winning state.
type WinTags = TagList

-- | Internal DFA node, identified by the Set of indices of the QNFA
-- nodes it represents.
data DFA = DFA { DFA -> SetIndex
d_id :: SetIndex, DFA -> DT
d_dt :: DT } deriving(Int -> DFA -> String -> String
[DFA] -> String -> String
DFA -> String
(Int -> DFA -> String -> String)
-> (DFA -> String) -> ([DFA] -> String -> String) -> Show DFA
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DFA -> String -> String
showsPrec :: Int -> DFA -> String -> String
$cshow :: DFA -> String
show :: DFA -> String
$cshowList :: [DFA] -> String -> String
showList :: [DFA] -> String -> String
Show)
data Transition = Transition { Transition -> DFA
trans_many :: DFA    -- ^ where to go (maximal), including respawning
                             , Transition -> DFA
trans_single :: DFA  -- ^ where to go, not including respawning
                             , Transition -> DTrans
trans_how :: DTrans    -- ^ how to go, including respawning
                             }
-- | Internal to the DFA node
data DT = Simple' { DT -> IntMap Instructions
dt_win :: IntMap {- Source Index -} Instructions -- ^ Actions to perform to win
                  , DT -> CharMap Transition
dt_trans :: CharMap Transition -- ^ Transition to accept Char
                  , DT -> Transition
dt_other :: Transition -- ^ default accepting transition
                  }
        | Testing' { DT -> WhichTest
dt_test :: WhichTest -- ^ The test to perform
                   , DT -> EnumSet DoPa
dt_dopas :: EnumSet DoPa -- ^ location(s) of the anchor(s) in the original regexp
                   , DT -> DT
dt_a,DT -> DT
dt_b :: DT      -- ^ use dt_a if test is True else use dt_b
                   }

-- | Internal type to represent the commands for the tagged transition.
-- The outer 'IntMap' is for the destination Index and the inner 'IntMap'
-- is for the Source Index.  This is convenient since all runtime data
-- going to the same destination must be compared to find the best.
--
-- A Destination 'IntMap' entry may have an empty Source 'IntMap' if and
-- only if the destination is the starting index and the NFA or DFA.
-- This instructs the matching engine to spawn a new entry starting at
-- the post-update position.
type DTrans = IntMap {- Index of Destination -} (IntMap {- Index of Source -} (DoPa,Instructions))
-- type DTrans = IntMap {- Index of Destination -} (IntMap {- Index of Source -} (DoPa,RunState ()))

-- | Internal convenience type for the text display code.
type DTrans' = [(Index, [(Index, (DoPa, ([(Tag, (Position,Bool))],[String])))])]

-- | Positions for which a @*@ was re-started while looping.  Need to
-- append locations at back but compare starting with front, so use
-- 'Seq' as a queue.  The initial position is saved in 'basePos' (and a
-- Maximize Tag), the middle positions in the 'Seq', and the final
-- position is NOT saved in the Orbits (only in a Maximize Tag).
data Orbits = Orbits
  { Orbits -> Bool
inOrbit :: !Bool        -- True if enterOrbit, False if LeaveOrbit
  , Orbits -> Int
basePos :: Position
  , Orbits -> Maybe Int
ordinal :: (Maybe Int)
  , Orbits -> Seq Int
getOrbits :: !(Seq Position)
  } deriving (Int -> Orbits -> String -> String
[Orbits] -> String -> String
Orbits -> String
(Int -> Orbits -> String -> String)
-> (Orbits -> String)
-> ([Orbits] -> String -> String)
-> Show Orbits
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Orbits -> String -> String
showsPrec :: Int -> Orbits -> String -> String
$cshow :: Orbits -> String
show :: Orbits -> String
$cshowList :: [Orbits] -> String -> String
showList :: [Orbits] -> String -> String
Show)

-- | The 'newPos' and 'newFlags' lists in Instructions are sorted by, and unique in, the Tag values
data Instructions = Instructions
  { Instructions -> [(Int, Action)]
newPos :: ![(Tag,Action)] -- False is preUpdate, True is postUpdate (there are no Orbit tags here) -- 2009 : Change to enum from bool?
  , Instructions -> Maybe (Int -> OrbitTransformer)
newOrbits :: !(Maybe (Position -> OrbitTransformer))
  }

instance Show Instructions where
  showsPrec :: Int -> Instructions -> String -> String
showsPrec Int
p (Instructions [(Int, Action)]
pos Maybe (Int -> OrbitTransformer)
_)
    = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String -> String -> String
showString String
"Instructions {" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> String -> String
showString String
"newPos = " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> [(Int, Action)] -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
0 [(Int, Action)]
pos (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> String -> String
showString String
", " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> String -> String
showString String
"newOrbits = " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> String -> String
showString String
"<function>" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> String -> String
showString String
"}"

data Action = SetPre | SetPost | SetVal Int deriving (Int -> Action -> String -> String
[Action] -> String -> String
Action -> String
(Int -> Action -> String -> String)
-> (Action -> String)
-> ([Action] -> String -> String)
-> Show Action
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Action -> String -> String
showsPrec :: Int -> Action -> String -> String
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> String -> String
showList :: [Action] -> String -> String
Show,Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
/= :: Action -> Action -> Bool
Eq)
type OrbitTransformer = OrbitLog -> OrbitLog
type OrbitLog = IntMap Orbits

instance Show QNFA where
  show :: QNFA -> String
show (QNFA {q_id :: QNFA -> Int
q_id = Int
i, q_qt :: QNFA -> QT
q_qt = QT
qt}) = String
"QNFA {q_id = "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n     ,q_qt = "String -> String -> String
forall a. [a] -> [a] -> [a]
++ QT -> String
forall a. Show a => a -> String
show QT
qt
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n}"

instance Show QT where
  show :: QT -> String
show = QT -> String
showQT

showQT :: QT -> String
showQT :: QT -> String
showQT (Simple WinTags
win CharMap QTrans
trans QTrans
other) = String
"{qt_win=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ WinTags -> String
forall a. Show a => a -> String
show WinTags
win
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n, qt_trans=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Key, [(Int, [TagCommand])])] -> String
forall a. Show a => a -> String
show (CharMap QTrans -> [(Key, [(Int, [TagCommand])])]
foo CharMap QTrans
trans)
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n, qt_other=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Int, [TagCommand])] -> String
forall a. Show a => a -> String
show (QTrans -> [(Int, [TagCommand])]
foo' QTrans
other) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
  where foo :: CharMap QTrans -> [(Char,[(Index,[TagCommand])])]
        foo :: CharMap QTrans -> [(Key, [(Int, [TagCommand])])]
foo = (QTrans -> [(Int, [TagCommand])])
-> [(Key, QTrans)] -> [(Key, [(Int, [TagCommand])])]
forall (f :: * -> *) t1 t2 t.
Functor f =>
(t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd QTrans -> [(Int, [TagCommand])]
foo' ([(Key, QTrans)] -> [(Key, [(Int, [TagCommand])])])
-> (CharMap QTrans -> [(Key, QTrans)])
-> CharMap QTrans
-> [(Key, [(Int, [TagCommand])])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharMap QTrans -> [(Key, QTrans)]
forall a. CharMap a -> [(Key, a)]
Map.toAscList
        foo' :: QTrans -> [(Index,[TagCommand])]
        foo' :: QTrans -> [(Int, [TagCommand])]
foo' = QTrans -> [(Int, [TagCommand])]
forall a. IntMap a -> [(Int, a)]
IMap.toList
showQT (Testing WhichTest
test EnumSet DoPa
dopas QT
a QT
b) = String
"{Testing "String -> String -> String
forall a. [a] -> [a] -> [a]
++WhichTest -> String
forall a. Show a => a -> String
show WhichTest
testString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++[DoPa] -> String
forall a. Show a => a -> String
show (EnumSet DoPa -> [DoPa]
forall e. Enum e => EnumSet e -> [e]
Set.toList EnumSet DoPa
dopas)
                              String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++QT -> String
indent' QT
a
                              String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++QT -> String
indent' QT
bString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}"
    where indent' :: QT -> String
indent' = String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String) -> (QT -> String) -> QT -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (QT -> [String]) -> QT -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
spacesString -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> (QT -> [String]) -> QT -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (QT -> String) -> QT -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QT -> String
showQT
          spaces :: String
spaces = Int -> Key -> String
forall a. Int -> a -> [a]
replicate Int
9 Key
' '

instance Show DT where show :: DT -> String
show = DT -> String
showDT

indent :: [String] -> String
indent :: [String] -> String
indent = [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> Key
' 'Key -> String -> String
forall a. a -> [a] -> [a]
:Key
' 'Key -> String -> String
forall a. a -> [a] -> [a]
:String
x)

showDT :: DT -> String
showDT :: DT -> String
showDT (Simple' IntMap Instructions
w CharMap Transition
t Transition
o) =
       String
"Simple' { dt_win = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
seeWin1
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n        , dt_trans = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
seeTrans1
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n        , dt_other = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Transition -> String
seeOther1 Transition
o
  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n        }"
 where
  seeWin1 :: String
seeWin1 | IntMap Instructions -> Bool
forall a. IntMap a -> Bool
IMap.null IntMap Instructions
w = String
"No win"
          | Bool
otherwise = [String] -> String
indent ([String] -> String)
-> (IntMap Instructions -> [String])
-> IntMap Instructions
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Instructions) -> String)
-> [(Int, Instructions)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Instructions) -> String
forall a. Show a => a -> String
show ([(Int, Instructions)] -> [String])
-> (IntMap Instructions -> [(Int, Instructions)])
-> IntMap Instructions
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Instructions -> [(Int, Instructions)]
forall a. IntMap a -> [(Int, a)]
IMap.assocs (IntMap Instructions -> String) -> IntMap Instructions -> String
forall a b. (a -> b) -> a -> b
$ IntMap Instructions
w

  seeTrans1 :: String
  seeTrans1 :: String
seeTrans1 | CharMap Transition -> Bool
forall a. CharMap a -> Bool
Map.null CharMap Transition
t = String
"No (Char,Transition)"
            | Bool
otherwise = (Key
'\n'Key -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
indent ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
     ((Key, Transition) -> String) -> [(Key, Transition)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key
char,Transition {trans_many :: Transition -> DFA
trans_many=DFA
dfa,trans_single :: Transition -> DFA
trans_single=DFA
dfa2,trans_how :: Transition -> DTrans
trans_how=DTrans
dtrans}) ->
                           [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"("
                                  ,Key -> String
forall a. Show a => a -> String
show Key
char
                                  ,String
", MANY "
                                  ,SetIndex -> String
forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa)
                                  ,String
", SINGLE "
                                  ,SetIndex -> String
forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa2)
                                  ,String
", \n"
                                  ,DTrans -> String
seeDTrans DTrans
dtrans
                                  ,String
")"]) (CharMap Transition -> [(Key, Transition)]
forall a. CharMap a -> [(Key, a)]
Map.assocs CharMap Transition
t)

  seeOther1 :: Transition -> String
seeOther1 (Transition {trans_many :: Transition -> DFA
trans_many=DFA
dfa,trans_single :: Transition -> DFA
trans_single=DFA
dfa2,trans_how :: Transition -> DTrans
trans_how=DTrans
dtrans}) =
    [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(MANY "
           ,SetIndex -> String
forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa)
           ,String
", SINGLE "
           ,SetIndex -> String
forall a. Show a => a -> String
show (DFA -> SetIndex
d_id DFA
dfa2)
           ,String
", \n"
           ,DTrans -> String
seeDTrans DTrans
dtrans
           ,String
")"]

showDT (Testing' WhichTest
wt EnumSet DoPa
d DT
a DT
b) = String
"Testing' { dt_test = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WhichTest -> String
forall a. Show a => a -> String
show WhichTest
wt
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n         , dt_dopas = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EnumSet DoPa -> String
forall a. Show a => a -> String
show EnumSet DoPa
d
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n         , dt_a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DT -> String
indent' DT
a
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n         , dt_b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DT -> String
indent' DT
b
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n         }"
 where indent' :: DT -> String
indent' = String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String) -> (DT -> String) -> DT -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (DT -> [String]) -> DT -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[String]
s -> case [String]
s of
                                           [] -> []
                                           (String
h:[String]
t) -> String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
spaces String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
t)) ([String] -> [String]) -> (DT -> [String]) -> DT -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (DT -> String) -> DT -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DT -> String
showDT
       spaces :: String
spaces = Int -> Key -> String
forall a. Int -> a -> [a]
replicate Int
10 Key
' '


seeDTrans :: DTrans -> String
--seeDTrans x = concatMap (\(dest,y) -> unlines . map (\(source,ins) -> show (dest,source,ins) ) . IMap.assocs $ y) (IMap.assocs x)
seeDTrans :: DTrans -> String
seeDTrans DTrans
x | DTrans -> Bool
forall a. IntMap a -> Bool
IMap.null DTrans
x = String
"No DTrans"
seeDTrans DTrans
x = ((Int, IntMap (DoPa, Instructions)) -> String)
-> [(Int, IntMap (DoPa, Instructions))] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, IntMap (DoPa, Instructions)) -> String
forall {a} {c}. (Show a, Show c) => (a, IntMap c) -> String
seeSource (DTrans -> [(Int, IntMap (DoPa, Instructions))]
forall a. IntMap a -> [(Int, a)]
IMap.assocs DTrans
x)
  where seeSource :: (a, IntMap c) -> String
seeSource (a
dest,IntMap c
srcMap) | IntMap c -> Bool
forall a. IntMap a -> Bool
IMap.null IntMap c
srcMap = [String] -> String
indent [(a, String) -> String
forall a. Show a => a -> String
show (a
dest,String
"SPAWN")]
                                | Bool
otherwise = [String] -> String
indent ([String] -> String)
-> (IntMap c -> [String]) -> IntMap c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, c) -> String) -> [(Int, c)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
source,c
ins) -> (a, Int, c) -> String
forall a. Show a => a -> String
show (a
dest,Int
source,c
ins) ) ([(Int, c)] -> [String])
-> (IntMap c -> [(Int, c)]) -> IntMap c -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap c -> [(Int, c)]
forall a. IntMap a -> [(Int, a)]
IMap.assocs (IntMap c -> String) -> IntMap c -> String
forall a b. (a -> b) -> a -> b
$ IntMap c
srcMap
--        spawnIns = Instructions { newPos = [(0,SetPost)], newOrbits = Nothing }


instance Eq QT where
  t1 :: QT
t1@(Testing {}) == :: QT -> QT -> Bool
== t2 :: QT
t2@(Testing {}) =
    (QT -> WhichTest
qt_test QT
t1) WhichTest -> WhichTest -> Bool
forall a. Eq a => a -> a -> Bool
== (QT -> WhichTest
qt_test QT
t2) Bool -> Bool -> Bool
&& (QT -> QT
qt_a QT
t1) QT -> QT -> Bool
forall a. Eq a => a -> a -> Bool
== (QT -> QT
qt_a QT
t2) Bool -> Bool -> Bool
&& (QT -> QT
qt_b QT
t1) QT -> QT -> Bool
forall a. Eq a => a -> a -> Bool
== (QT -> QT
qt_b QT
t2)
  (Simple WinTags
w1 (CharMap IntMap QTrans
t1) QTrans
o1) == (Simple WinTags
w2 (CharMap IntMap QTrans
t2) QTrans
o2) =
    WinTags
w1 WinTags -> WinTags -> Bool
forall a. Eq a => a -> a -> Bool
== WinTags
w2 Bool -> Bool -> Bool
&& Bool
eqTrans Bool -> Bool -> Bool
&& QTrans -> QTrans -> Bool
eqQTrans QTrans
o1 QTrans
o2
    where eqTrans :: Bool
          eqTrans :: Bool
eqTrans = (IntMap QTrans -> Int
forall a. IntMap a -> Int
IMap.size IntMap QTrans
t1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IntMap QTrans -> Int
forall a. IntMap a -> Int
IMap.size IntMap QTrans
t2)
                    Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (((Int, QTrans) -> (Int, QTrans) -> Bool)
-> [(Int, QTrans)] -> [(Int, QTrans)] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int, QTrans) -> (Int, QTrans) -> Bool
forall {a}. Eq a => (a, QTrans) -> (a, QTrans) -> Bool
together (IntMap QTrans -> [(Int, QTrans)]
forall a. IntMap a -> [(Int, a)]
IMap.toAscList IntMap QTrans
t1) (IntMap QTrans -> [(Int, QTrans)]
forall a. IntMap a -> [(Int, a)]
IMap.toAscList IntMap QTrans
t2))
            where together :: (a, QTrans) -> (a, QTrans) -> Bool
together (a
c1,QTrans
qtrans1) (a
c2,QTrans
qtrans2) = (a
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c2) Bool -> Bool -> Bool
&& QTrans -> QTrans -> Bool
eqQTrans QTrans
qtrans1 QTrans
qtrans2
          eqQTrans :: QTrans -> QTrans -> Bool
          eqQTrans :: QTrans -> QTrans -> Bool
eqQTrans = QTrans -> QTrans -> Bool
forall a. Eq a => a -> a -> Bool
(==)
  QT
_ == QT
_ = Bool
False