module Text.Regex.TDFA.Common where
import Text.Show.Functions()
import Control.Monad.State(State)
import Data.Array.IArray(Array)
import Data.IntSet.EnumSet(EnumSet)
import Data.IntMap as IMap (IntMap,findWithDefault,assocs)
import Data.IntSet(IntSet)
import Data.IntMap.CharMap as Map (CharMap,assocs)
import Data.Sequence(Seq)
look :: Int -> IntMap a -> a
look key imap = IMap.findWithDefault (common_error "Text.Regex.DFA.Common" ("key "++show key++" not found in look")) key imap
common_error :: String -> String -> a
common_error moduleName message =
error ("Explict error in module "++moduleName++" : "++message)
on :: (t1 -> t1 -> t2) -> (t -> t1) -> t -> t -> t2
f `on` g = (\x y -> (g x) `f` (g y))
norep :: (Eq a) => [a]->[a]
norep [] = []
norep x@[_] = x
norep (a:bs@(c:cs)) | a==c = norep (a:cs)
| otherwise = a:norep bs
norepBy :: (a -> a -> Bool) -> [a] -> [a]
norepBy _ [] = []
norepBy _ x@[_] = x
norepBy eqF (a:bs@(c:cs)) | a `eqF` c = norepBy eqF (a:cs)
| otherwise = a:norepBy eqF bs
mapFst :: (Functor f) => (t -> t2) -> f (t, t1) -> f (t2, t1)
mapFst f = fmap (\ (a,b) -> (f a,b))
mapSnd :: (Functor f) => (t1 -> t2) -> f (t, t1) -> f (t, t2)
mapSnd f = fmap (\ (a,b) -> (a,f b))
fst3 :: (a,b,c) -> a
fst3 (x,_,_) = x
snd3 :: (a,b,c) -> b
snd3 (_,x,_) = x
thd3 :: (a,b,c) -> c
thd3 (_,_,x) = x
flipOrder :: Ordering -> Ordering
flipOrder GT = LT
flipOrder LT = GT
flipOrder EQ = EQ
noWin :: WinTags -> Bool
noWin = null
newtype DoPa = DoPa {dopaIndex :: Int} deriving (Eq,Ord)
instance Enum DoPa where
toEnum = DoPa
fromEnum = dopaIndex
instance Show DoPa where
showsPrec p (DoPa {dopaIndex=i}) = ('#':) . showsPrec p i
data CompOption = CompOption { caseSensitive :: Bool
, multiline :: Bool
, rightAssoc :: Bool
, lastStarGreedy :: Bool
} deriving (Read,Show)
data ExecOption = ExecOption { captureGroups :: Bool
, testMatch :: Bool
} deriving (Read,Show)
type Tag = Int
data OP = Maximize | Minimize | Orbit deriving (Eq,Show)
type Index = Int
type SetIndex = IntSet
type Position = Int
type GroupIndex = Int
data GroupInfo = GroupInfo {thisIndex,parentIndex::GroupIndex
,startTag,stopTag::Tag
} deriving Show
data Regex = Regex {regex_dfa::DFA
,regex_init::Index
,regex_tags::Array Tag OP
,regex_groups::Array GroupIndex [GroupInfo]
,regex_compOptions::CompOption
,regex_execOptions::ExecOption}
data QNFA = QNFA {q_id :: Index
,q_qt :: QT}
data QT = Simple {qt_win :: WinTags
,qt_trans :: CharMap QTrans
,qt_other :: QTrans
}
| Testing {qt_test :: WhichTest
,qt_dopas :: EnumSet DoPa
,qt_a,qt_b :: QT
}
type QTrans = IntMap [TagCommand]
data WhichTest = Test_BOL | Test_EOL deriving (Show,Eq,Ord,Enum)
data TagTask = TagTask | ResetGroupStopTask
| ResetOrbitTask | EnterOrbitTask | LeaveOrbitTask deriving (Show,Eq)
type TagTasks = [(Tag,TagTask)]
data TagUpdate = PreUpdate TagTask | PostUpdate TagTask deriving (Show,Eq)
type TagList = [(Tag,TagUpdate)]
type TagCommand = (DoPa,TagList)
type WinTags = TagList
data DFA = DFA { d_id :: SetIndex, d_dt :: DT} deriving(Show)
data DT = Simple' { dt_win :: IntMap Instructions
, dt_trans :: CharMap (DFA,DTrans)
, dt_other :: Maybe (DFA,DTrans)
}
| Testing' { dt_test :: WhichTest
, dt_dopas :: EnumSet DoPa
, dt_a,dt_b :: DT
}
instance Show DT where show = showDT
showDT :: DT -> String
showDT (Simple' w t o) = "Simple' { dt_win = " ++ (unlines . map show . IMap.assocs $ w)
++ "\n , dt_trans = " ++ (unlines . map (\(char,(dfa,dtrans)) -> "("++show char++", "++show (d_id dfa)++", "
++ seeDTrans dtrans ++")") . Map.assocs $ t)
++ "\n , dt_other = " ++ maybe "None" (\(dfa,dtrans) -> "("++show (d_id dfa)++", "++ seeDTrans dtrans++")") o
++ "\n }"
showDT (Testing' wt d a b) = "Testing' { dt_test = " ++ show wt
++ "\n , dt_dopas = " ++ show d
++ "\n , dt_a = " ++ indent a
++ "\n , dt_b = " ++ indent b
++ "\n }"
where indent = init . unlines . (\(h:t) -> h : (map (spaces ++) t)) . lines . showDT
spaces = replicate 10 ' '
seeDTrans :: DTrans -> String
seeDTrans x = concatMap (\(dest,y) -> unlines . map (\(source,ins) -> show (dest,source,ins) ) . IMap.assocs $ y) (IMap.assocs x)
type DTrans = IntMap (IntMap (DoPa,Instructions))
type DTrans' = [(Index, [(Index, (DoPa, ([(Tag, (Position,Bool))],[String])))])]
data Orbits = Orbits
{ inOrbit :: !Bool
, getOrbits :: !(Seq Position)
} deriving (Show)
data Instructions = Instructions
{ newPos :: ![(Tag,Bool)]
, newFlags :: ![(Tag,Bool)]
, newOrbits :: !(Maybe (Position -> OrbitTransformer))
} deriving (Show)
type OrbitLog = IntMap Orbits
type OrbitTransformer = OrbitLog -> OrbitLog
type CompileInstructions a = State
( IntMap Bool
, IntMap Bool
, IntMap AlterOrbit
) a
data AlterOrbit = AlterReset
| AlterLeave
| AlterModify { newInOrbit :: Bool
, freshOrbit :: Bool}
deriving (Show)