-- |
--
-- = Considerations
--
-- One caveat you should always take into account when using this package is that without some data creation from the user, the use of this package is a bit restricted. This happens because the way it is built the package forbids you to use more than one type of information between states (or inside one), so to work around this, if you want to have multiple types of information inside states, do as follows:
--
-- @
--   data CustomData = Type1 String | Type2 Int deriving (Show,Eq)
-- @
-- 
-- dont forget about the deriving because otherwise it will conflict with the functions in the package.
  


module FSM.States (
    State,
    Tag,
    StateInfo,
    AutomataInfo,
        
    -- * Creating functions
    createStateInfo,
    fromlsStateInfo,
        
    -- * Accessing functions
    getStateInfo,
    getStatesWithInfo,
    getTagsInState,
    getInfoInState,
    
    -- * Editing functions
    alterStateInfo,
    unionStateInfo
    

) where

import qualified Data.Map as Map   
import qualified Data.List as L

type State = Int
type Tag = String


newtype StateInfo a = StateInfo {StateInfo a -> Map Tag a
tagMap :: Map.Map Tag a} deriving StateInfo a -> StateInfo a -> Bool
(StateInfo a -> StateInfo a -> Bool)
-> (StateInfo a -> StateInfo a -> Bool) -> Eq (StateInfo a)
forall a. Eq a => StateInfo a -> StateInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateInfo a -> StateInfo a -> Bool
$c/= :: forall a. Eq a => StateInfo a -> StateInfo a -> Bool
== :: StateInfo a -> StateInfo a -> Bool
$c== :: forall a. Eq a => StateInfo a -> StateInfo a -> Bool
Eq
newtype AutomataInfo a = AutomataInfo { AutomataInfo a -> Map State (StateInfo a)
toMap :: Map.Map State (StateInfo a)} deriving AutomataInfo a -> AutomataInfo a -> Bool
(AutomataInfo a -> AutomataInfo a -> Bool)
-> (AutomataInfo a -> AutomataInfo a -> Bool)
-> Eq (AutomataInfo a)
forall a. Eq a => AutomataInfo a -> AutomataInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutomataInfo a -> AutomataInfo a -> Bool
$c/= :: forall a. Eq a => AutomataInfo a -> AutomataInfo a -> Bool
== :: AutomataInfo a -> AutomataInfo a -> Bool
$c== :: forall a. Eq a => AutomataInfo a -> AutomataInfo a -> Bool
Eq

--data UserStateInfo = UserStateInfo { rate :: Float } deriving Show

verboseShowStateInfo :: Show a => Map.Map Tag a -> String
verboseShowStateInfo :: Map Tag a -> Tag
verboseShowStateInfo = ((Tag, a) -> Tag) -> [(Tag, a)] -> Tag
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Tag, a) -> Tag
forall a. Show a => (Tag, a) -> Tag
formatter ([(Tag, a)] -> Tag)
-> (Map Tag a -> [(Tag, a)]) -> Map Tag a -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Tag a -> [(Tag, a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
  where formatter :: (Tag, a) -> Tag
formatter (k :: Tag
k, v :: a
v) = [Tag] -> Tag
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["--> [tag] ",Tag
k, ": ","\n", a -> Tag
forall a. Show a => a -> Tag
show a
v, "\n"]
        
instance Show a => Show (StateInfo a) where
  show :: StateInfo a -> Tag
show = Map Tag a -> Tag
forall a. Show a => Map Tag a -> Tag
verboseShowStateInfo (Map Tag a -> Tag)
-> (StateInfo a -> Map Tag a) -> StateInfo a -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap        
  
verboseShow :: Show a => Map.Map State (StateInfo a) -> String
verboseShow :: Map State (StateInfo a) -> Tag
verboseShow = ((State, StateInfo a) -> Tag) -> [(State, StateInfo a)] -> Tag
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State, StateInfo a) -> Tag
forall a a. (Show a, Show a) => (a, StateInfo a) -> Tag
formatter ([(State, StateInfo a)] -> Tag)
-> (Map State (StateInfo a) -> [(State, StateInfo a)])
-> Map State (StateInfo a)
-> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map State (StateInfo a) -> [(State, StateInfo a)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
  where formatter :: (a, StateInfo a) -> Tag
formatter (s :: a
s, i :: StateInfo a
i) = [Tag] -> Tag
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["=> The elements in state ", a -> Tag
forall a. Show a => a -> Tag
show a
s, " are:\n", Map Tag a -> Tag
forall a. Show a => Map Tag a -> Tag
verboseShowStateInfo (StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap StateInfo a
i), "\n"]


instance Show a => Show (AutomataInfo a) where
  show :: AutomataInfo a -> Tag
show = Map State (StateInfo a) -> Tag
forall a. Show a => Map State (StateInfo a) -> Tag
verboseShow (Map State (StateInfo a) -> Tag)
-> (AutomataInfo a -> Map State (StateInfo a))
-> AutomataInfo a
-> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutomataInfo a -> Map State (StateInfo a)
forall a. AutomataInfo a -> Map State (StateInfo a)
toMap 

  
-- Creating functions ------------------------

-- | This function takes a State, a Tag and a value and creates an AutomataInfo object containing only the given State with the value and the tag associated to it.
-- E.g.:
--
-- > createStateInfo 4 "tag" 25
-- 
-- If you created your own data type, you can do as follows:
--
-- > my_info = createStateInfo 4 "tag" (Type2 25)
--
createStateInfo :: State -> Tag -> a -> AutomataInfo a
createStateInfo :: State -> Tag -> a -> AutomataInfo a
createStateInfo state :: State
state tag :: Tag
tag k :: a
k = AutomataInfo :: forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo {toMap :: Map State (StateInfo a)
toMap = State -> StateInfo a -> Map State (StateInfo a)
forall k a. k -> a -> Map k a
Map.singleton State
state (StateInfo :: forall a. Map Tag a -> StateInfo a
StateInfo {tagMap :: Map Tag a
tagMap = Tag -> a -> Map Tag a
forall k a. k -> a -> Map k a
Map.singleton Tag
tag a
k})}

-- | This function takes a State, a list of (Tag,value) and Maybe AutomataInfo and returns the AutomataInfo updated with the list of tags given. Please notice that if Nothing is given, it will return the created AutomataInfo while if a (Just AutomataInfo) object is given, it will update the tags in the given state.
-- E.g. (notice that we are using @my_info@ from the previous example)
--
-- > fromlsStateInfo 4 [("foo", Type1 "on"),("bar", Type2 0)] Nothing
-- > fromlsStateInfo 4 [("foo", Type1 "on"),("bar", Type2 0)] (Just my_info)
--
fromlsStateInfo :: Eq a => State -> [(Tag,a)] -> Maybe (AutomataInfo a) -> AutomataInfo a
fromlsStateInfo :: State -> [(Tag, a)] -> Maybe (AutomataInfo a) -> AutomataInfo a
fromlsStateInfo state :: State
state [] Nothing = AutomataInfo :: forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo {toMap :: Map State (StateInfo a)
toMap = Map State (StateInfo a)
forall k a. Map k a
Map.empty}
fromlsStateInfo state :: State
state (l :: (Tag, a)
l:ls :: [(Tag, a)]
ls) Nothing 
    | [(Tag, a)]
ls [(Tag, a)] -> [(Tag, a)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = State -> [(Tag, a)] -> Maybe (AutomataInfo a) -> AutomataInfo a
forall a.
Eq a =>
State -> [(Tag, a)] -> Maybe (AutomataInfo a) -> AutomataInfo a
fromlsStateInfo State
state [(Tag, a)]
ls (AutomataInfo a -> Maybe (AutomataInfo a)
forall a. a -> Maybe a
Just AutomataInfo a
first_info)
    | Bool
otherwise = AutomataInfo a
first_info
    where (tag :: Tag
tag,value :: a
value) = (Tag, a)
l
          first_info :: AutomataInfo a
first_info = State -> Tag -> a -> AutomataInfo a
forall a. State -> Tag -> a -> AutomataInfo a
createStateInfo State
state Tag
tag a
value
fromlsStateInfo state :: State
state [] (Just info :: AutomataInfo a
info) = AutomataInfo a
info
fromlsStateInfo state :: State
state (l :: (Tag, a)
l:ls :: [(Tag, a)]
ls) (Just (AutomataInfo info :: Map State (StateInfo a)
info)) 
    | [(Tag, a)]
ls [(Tag, a)] -> [(Tag, a)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = State -> [(Tag, a)] -> Maybe (AutomataInfo a) -> AutomataInfo a
forall a.
Eq a =>
State -> [(Tag, a)] -> Maybe (AutomataInfo a) -> AutomataInfo a
fromlsStateInfo State
state [(Tag, a)]
ls (AutomataInfo a -> Maybe (AutomataInfo a)
forall a. a -> Maybe a
Just AutomataInfo a
new_aut_info)
    | Bool
otherwise = AutomataInfo a
new_aut_info
    where (tag :: Tag
tag,value :: a
value) = (Tag, a)
l
          new_info :: AutomataInfo a
new_info = State -> Tag -> a -> AutomataInfo a
forall a. State -> Tag -> a -> AutomataInfo a
createStateInfo State
state Tag
tag a
value
          new_aut_info :: AutomataInfo a
new_aut_info = AutomataInfo a -> AutomataInfo a -> AutomataInfo a
forall a. AutomataInfo a -> AutomataInfo a -> AutomataInfo a
unionStateInfo AutomataInfo a
new_info (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info)
          
{-
-- quiero hacer una funcion que une la info con dos AutomataInfos (unión de conjuntos)
-- y otra funcion que a partir de un (State,[(Tag,a)]) crea el AutomataInfo
fromListAux :: Int -> [(State,[(Tag,a)])] -> AutomataInfo a
fromListAux 0 (l:ls) = 
    where (state,tag_list) = l
          


fromListStateInfo :: [(State,[(Tag,a)])] -> AutomataInfo a
fromListStateInfo ls = fromListAux 0 ls
-}

-- Accessing functions ------------------------

getStateInfo :: StateInfo a -> Map.Map Tag a
getStateInfo :: StateInfo a -> Map Tag a
getStateInfo (StateInfo k :: Map Tag a
k) = Map Tag a
k


-- | This function returns the states of the given AutomataInfo that currently contain some information
--
getStatesWithInfo :: AutomataInfo a -> [State]
getStatesWithInfo :: AutomataInfo a -> [State]
getStatesWithInfo (AutomataInfo k :: Map State (StateInfo a)
k) = Map State (StateInfo a) -> [State]
forall k a. Map k a -> [k]
Map.keys Map State (StateInfo a)
k

-- | This function returns the tags that a given state contains inside the AutomataInfo
--
getTagsInState :: AutomataInfo a -> State -> [Tag]
getTagsInState :: AutomataInfo a -> State -> [Tag]
getTagsInState (AutomataInfo k :: Map State (StateInfo a)
k) n :: State
n
    | Bool -> Bool
not (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
n (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
k))) =  Tag -> [Tag]
forall a. HasCallStack => Tag -> a
error ("This state does not contain info.")
    | Bool
otherwise = Map Tag a -> [Tag]
forall k a. Map k a -> [k]
Map.keys (StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap StateInfo a
state_map)
    where (Just state_map :: StateInfo a
state_map) = State -> Map State (StateInfo a) -> Maybe (StateInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup State
n Map State (StateInfo a)
k


-- | This function returns the information contained in the given state. If @Nothing@ is given, then it returns all the information in the state while if @Just tag@ is given, it will return only the information inside the given tag.
-- E.g:
-- 
-- > getInfoInState my_info 4 Nothing
-- > getInfoInState my_info 4 (Just "foo")
--
getInfoInState :: AutomataInfo a -> State -> (Maybe Tag) -> StateInfo a
getInfoInState :: AutomataInfo a -> State -> Maybe Tag -> StateInfo a
getInfoInState (AutomataInfo k :: Map State (StateInfo a)
k) n :: State
n Nothing
    | Bool -> Bool
not (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
n (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
k))) = Map Tag a -> StateInfo a
forall a. Map Tag a -> StateInfo a
StateInfo Map Tag a
forall k a. Map k a
Map.empty
        --error ("This state does not contain info.")
    | Bool
otherwise = StateInfo a
state_map
    where (Just state_map :: StateInfo a
state_map) = State -> Map State (StateInfo a) -> Maybe (StateInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup State
n Map State (StateInfo a)
k
getInfoInState (AutomataInfo k :: Map State (StateInfo a)
k) n :: State
n (Just tag :: Tag
tag)
    | Bool -> Bool
not (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
n (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
k))) = Map Tag a -> StateInfo a
forall a. Map Tag a -> StateInfo a
StateInfo Map Tag a
forall k a. Map k a
Map.empty
       -- error ("This state does not contain info.")
    | Bool -> Bool
not (Tag -> [Tag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Tag
tag (AutomataInfo a -> State -> [Tag]
forall a. AutomataInfo a -> State -> [Tag]
getTagsInState (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
k) State
n)) = Map Tag a -> StateInfo a
forall a. Map Tag a -> StateInfo a
StateInfo Map Tag a
forall k a. Map k a
Map.empty
        --error ("This state does not contain the given tag.")
    | Bool
otherwise = StateInfo a
output
    where (Just state_map :: StateInfo a
state_map) = State -> Map State (StateInfo a) -> Maybe (StateInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup State
n Map State (StateInfo a)
k
          tag_map :: Map Tag a
tag_map = StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap StateInfo a
state_map
          Just tag_info :: a
tag_info = Tag -> Map Tag a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Tag
tag Map Tag a
tag_map
          output :: StateInfo a
output = StateInfo :: forall a. Map Tag a -> StateInfo a
StateInfo {tagMap :: Map Tag a
tagMap = Tag -> a -> Map Tag a
forall k a. k -> a -> Map k a
Map.singleton Tag
tag a
tag_info}

-- Editing functions ---------------

-- | This function takes a State, Maybe Tag, a value and an AutomataInfo object and updates the value of the Tag in the given State. Please note that if if Nothing is given, it will delete the State.
-- E.g:
--
-- > alterStateInfo 3 (Just "foo") (Type2 45) my_info
--
alterStateInfo :: State -> Maybe Tag -> a -> AutomataInfo a -> AutomataInfo a
alterStateInfo :: State -> Maybe Tag -> a -> AutomataInfo a -> AutomataInfo a
alterStateInfo state :: State
state Nothing _ (AutomataInfo info :: Map State (StateInfo a)
info)
    | Bool -> Bool
not (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
state (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info))) = (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info)
        --error ("This state does not contain info.")
    | Bool
otherwise = AutomataInfo :: forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo {toMap :: Map State (StateInfo a)
toMap = State -> Map State (StateInfo a) -> Map State (StateInfo a)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete State
state Map State (StateInfo a)
info}
alterStateInfo state :: State
state (Just tag :: Tag
tag) sinf :: a
sinf (AutomataInfo info :: Map State (StateInfo a)
info) 
    | State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
state (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info)) = 
        let f :: p -> Maybe a
f _ = a -> Maybe a
forall a. a -> Maybe a
Just a
sinf
            (Just state_map :: StateInfo a
state_map) = State -> Map State (StateInfo a) -> Maybe (StateInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup State
state Map State (StateInfo a)
info
            tag_map :: Map Tag a
tag_map = StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap StateInfo a
state_map
            new_tag_map :: Map Tag a
new_tag_map = (Maybe a -> Maybe a) -> Tag -> Map Tag a -> Map Tag a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe a -> Maybe a
forall p. p -> Maybe a
f Tag
tag Map Tag a
tag_map
            g :: p -> Maybe (StateInfo a)
g _ = StateInfo a -> Maybe (StateInfo a)
forall a. a -> Maybe a
Just (StateInfo :: forall a. Map Tag a -> StateInfo a
StateInfo {tagMap :: Map Tag a
tagMap = Map Tag a
new_tag_map})
            new_state_map :: Map State (StateInfo a)
new_state_map = (Maybe (StateInfo a) -> Maybe (StateInfo a))
-> State -> Map State (StateInfo a) -> Map State (StateInfo a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (StateInfo a) -> Maybe (StateInfo a)
forall p. p -> Maybe (StateInfo a)
g State
state Map State (StateInfo a)
info
        in AutomataInfo :: forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo {toMap :: Map State (StateInfo a)
toMap = Map State (StateInfo a)
new_state_map}
    | Bool
otherwise = 
        let new_tag_map :: StateInfo a
new_tag_map = StateInfo :: forall a. Map Tag a -> StateInfo a
StateInfo {tagMap :: Map Tag a
tagMap = Tag -> a -> Map Tag a
forall k a. k -> a -> Map k a
Map.singleton Tag
tag a
sinf}
            g :: p -> Maybe (StateInfo a)
g _ = StateInfo a -> Maybe (StateInfo a)
forall a. a -> Maybe a
Just StateInfo a
new_tag_map
            new_state_map :: Map State (StateInfo a)
new_state_map = (Maybe (StateInfo a) -> Maybe (StateInfo a))
-> State -> Map State (StateInfo a) -> Map State (StateInfo a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (StateInfo a) -> Maybe (StateInfo a)
forall p. p -> Maybe (StateInfo a)
g State
state Map State (StateInfo a)
info
        in AutomataInfo :: forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo {toMap :: Map State (StateInfo a)
toMap = Map State (StateInfo a)
new_state_map}

{-
emptyState :: State -> AutomataInfo a
emptyState state = AutomataInfo {toMap = Map.singleton state output}
        where output = StateInfo {tagMap = Map.empty}-}

-- unionStateAux :: AutomataInfo a -> AutomataInfo a -> AutomataInfo a -> [State] -> AutomataInfo a
-- unionStateAux (AutomataInfo info1) (AutomataInfo info2) (AutomataInfo output) [l] 
--     | (elem l (getStatesWithInfo (AutomataInfo info1))) && (not (elem l (getStatesWithInfo (AutomataInfo info2)))) = (AutomataInfo output)
--     | (not (elem l (getStatesWithInfo (AutomataInfo info1)))) && (elem l (getStatesWithInfo (AutomataInfo info2))) = 
--         let tag_map2 = tagMap (getInfoInState (AutomataInfo info2) l Nothing)
--             tag_output = StateInfo {tagMap = tag_map2}
--             state_output = Map.singleton l tag_output
--         in (AutomataInfo (Map.union state_output output))
--     | otherwise = 
--         let tag_map1 = tagMap (getInfoInState (AutomataInfo info1) l Nothing)
--             tag_map2 = tagMap (getInfoInState (AutomataInfo info2) l Nothing)
--             tag_output = StateInfo {tagMap = Map.union tag_map1 tag_map2}
--             state_output = Map.singleton l tag_output
--         in (AutomataInfo (Map.union state_output output))
unionStateAux :: AutomataInfo a
-> AutomataInfo a -> AutomataInfo a -> [State] -> AutomataInfo a
unionStateAux (AutomataInfo info1 :: Map State (StateInfo a)
info1) (AutomataInfo info2 :: Map State (StateInfo a)
info2) (AutomataInfo output :: Map State (StateInfo a)
output) [] = (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
output)
unionStateAux (AutomataInfo info1 :: Map State (StateInfo a)
info1) (AutomataInfo info2 :: Map State (StateInfo a)
info2) (AutomataInfo output :: Map State (StateInfo a)
output) (l :: State
l:ls :: [State]
ls)
    | (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
l (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info1))) Bool -> Bool -> Bool
&& (Bool -> Bool
not (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
l (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2)))) = AutomataInfo a
-> AutomataInfo a -> AutomataInfo a -> [State] -> AutomataInfo a
unionStateAux (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info1) (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2) (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
output) [State]
ls
    | (Bool -> Bool
not (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
l (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info1)))) Bool -> Bool -> Bool
&& (State -> [State] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem State
l (AutomataInfo a -> [State]
forall a. AutomataInfo a -> [State]
getStatesWithInfo (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2))) = 
        let tag_map2 :: Map Tag a
tag_map2 = StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap (AutomataInfo a -> State -> Maybe Tag -> StateInfo a
forall a. AutomataInfo a -> State -> Maybe Tag -> StateInfo a
getInfoInState (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2) State
l Maybe Tag
forall a. Maybe a
Nothing)
            tag_output :: StateInfo a
tag_output = StateInfo :: forall a. Map Tag a -> StateInfo a
StateInfo {tagMap :: Map Tag a
tagMap = Map Tag a
tag_map2}
            state_output :: Map State (StateInfo a)
state_output = State -> StateInfo a -> Map State (StateInfo a)
forall k a. k -> a -> Map k a
Map.singleton State
l StateInfo a
tag_output
        in AutomataInfo a
-> AutomataInfo a -> AutomataInfo a -> [State] -> AutomataInfo a
unionStateAux (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info1) (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2) (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo (Map State (StateInfo a)
-> Map State (StateInfo a) -> Map State (StateInfo a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map State (StateInfo a)
state_output Map State (StateInfo a)
output)) [State]
ls
    | Bool
otherwise = 
        let tag_map1 :: Map Tag a
tag_map1 = StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap (AutomataInfo a -> State -> Maybe Tag -> StateInfo a
forall a. AutomataInfo a -> State -> Maybe Tag -> StateInfo a
getInfoInState (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info1) State
l Maybe Tag
forall a. Maybe a
Nothing)
            tag_map2 :: Map Tag a
tag_map2 = StateInfo a -> Map Tag a
forall a. StateInfo a -> Map Tag a
tagMap (AutomataInfo a -> State -> Maybe Tag -> StateInfo a
forall a. AutomataInfo a -> State -> Maybe Tag -> StateInfo a
getInfoInState (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2) State
l Maybe Tag
forall a. Maybe a
Nothing)
            tag_output :: StateInfo a
tag_output = StateInfo :: forall a. Map Tag a -> StateInfo a
StateInfo {tagMap :: Map Tag a
tagMap = Map Tag a -> Map Tag a -> Map Tag a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Tag a
tag_map1 Map Tag a
tag_map2}
            state_output :: Map State (StateInfo a)
state_output = State -> StateInfo a -> Map State (StateInfo a)
forall k a. k -> a -> Map k a
Map.singleton State
l StateInfo a
tag_output
        in AutomataInfo a
-> AutomataInfo a -> AutomataInfo a -> [State] -> AutomataInfo a
unionStateAux (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info1) (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo Map State (StateInfo a)
info2) (Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo (Map State (StateInfo a)
-> Map State (StateInfo a) -> Map State (StateInfo a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map State (StateInfo a)
state_output Map State (StateInfo a)
output)) [State]
ls
            
-- | This function takes the left-biased union of t1 and t2. It prefers t1 when duplicate keys are encountered. Works similarly to <http://hackage.haskell.org/package/containers-0.6.2.1/docs/Data-Map-Strict.html#g:12 Data.Map.union>.
--
{-unionStateInfo :: AutomataInfo a -> AutomataInfo a -> AutomataInfo a
unionStateInfo (AutomataInfo info1) (AutomataInfo info2) = unionStateAux (AutomataInfo info1) (AutomataInfo info2) (AutomataInfo info1) ls
    where ls = L.union (getStatesWithInfo (AutomataInfo info1)) (getStatesWithInfo (AutomataInfo info2))-} 
          
unionStateInfo :: AutomataInfo a -> AutomataInfo a -> AutomataInfo a
unionStateInfo :: AutomataInfo a -> AutomataInfo a -> AutomataInfo a
unionStateInfo (AutomataInfo info1 :: Map State (StateInfo a)
info1) (AutomataInfo info2 :: Map State (StateInfo a)
info2) =
  Map State (StateInfo a) -> AutomataInfo a
forall a. Map State (StateInfo a) -> AutomataInfo a
AutomataInfo ((StateInfo a -> StateInfo a -> StateInfo a)
-> Map State (StateInfo a)
-> Map State (StateInfo a)
-> Map State (StateInfo a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\ (StateInfo sti1 :: Map Tag a
sti1) (StateInfo sti2 :: Map Tag a
sti2) ->
                                 (Map Tag a -> StateInfo a
forall a. Map Tag a -> StateInfo a
StateInfo (Map Tag a -> Map Tag a -> Map Tag a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Tag a
sti1 Map Tag a
sti2)))
                Map State (StateInfo a)
info1 Map State (StateInfo a)
info2)