CMDLUtils.hs revision 17d4f8c5576d93f36cafe68161cdb960ec49ce7c
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseModule :$Header$
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcndDescription : utilitary function used throughout the CMDL interface
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcnd implementation
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcndCopyright : uni-bremen and DFKI
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseLicence : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcndMaintainer : r.pascanu@jacobs-university.de
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseStability : provisional
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcndPortability : portable
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcndPGIP.CMDLUtils contains different small function that are
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcndused throughout the CMDL interface
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcnd ( isWhiteSpace
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcnd , trimLeft
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcnd , trimRight
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcnd , decomposeIntoGoals
ce9621257ef9e54c1bbe5ad8a5f445a1f211c2dcnd , obtainNodeList
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , createEdgeNames
6ace32dacb8313226eb9019275d0e4fa45a15148rse , obtainEdgeList
70535d6421eb979ac79d8f49d31cd94d75dd8b2fjorton , obtainGoalEdgeList
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , unfinishedEdgeName
a943533fd4d91d114af622731a405407990c4fb1rse , stripComments
a943533fd4d91d114af622731a405407990c4fb1rse , lastChar
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , lastString
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , safeTail
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , fileFilter
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse , fileExtend
7933d4a963def02417113b6798d87a36395053b0rse , prettyPrintList
7933d4a963def02417113b6798d87a36395053b0rse , prettyPrintErrList
71c00f988beb28388702e14cb7fe06f08bd792bbdougm , nodeContainsGoals
71c00f988beb28388702e14cb7fe06f08bd792bbdougm , edgeContainsGoals
71c00f988beb28388702e14cb7fe06f08bd792bbdougm , checkIntString
7933d4a963def02417113b6798d87a36395053b0rseimport qualified Common.OrderedMap as OMap
0c44ed1cffad38b900b39e8c65996b9b9cff061djim-- | Checks if a string represents a int or not
0c44ed1cffad38b900b39e8c65996b9b9cff061djimcheckIntString :: String -> Bool
0c44ed1cffad38b900b39e8c65996b9b9cff061djimcheckIntString = not . any (not . isDigit)
0c44ed1cffad38b900b39e8c65996b9b9cff061djim-- | List of all characters considered white spaces
0c44ed1cffad38b900b39e8c65996b9b9cff061djimwhiteSpaces ::String
0c44ed1cffad38b900b39e8c65996b9b9cff061djimwhiteSpaces = " \t\n\r\v"
0c44ed1cffad38b900b39e8c65996b9b9cff061djim-- | Predicate that tells if a character is a white space
0c44ed1cffad38b900b39e8c65996b9b9cff061djimisWhiteSpace ::Char -> Bool
0c44ed1cffad38b900b39e8c65996b9b9cff061djimisWhiteSpace x = any (x==) whiteSpaces
0c44ed1cffad38b900b39e8c65996b9b9cff061djim-- | trims a string both on left and right hand side
0c44ed1cffad38b900b39e8c65996b9b9cff061djimtrim :: String -> String
0c44ed1cffad38b900b39e8c65996b9b9cff061djimtrim = reverse . dropWhile isWhiteSpace . reverse
0c44ed1cffad38b900b39e8c65996b9b9cff061djim . dropWhile isWhiteSpace
0c44ed1cffad38b900b39e8c65996b9b9cff061djim-- | trims a string only on the left side
0c44ed1cffad38b900b39e8c65996b9b9cff061djimtrimLeft :: String -> String
0c44ed1cffad38b900b39e8c65996b9b9cff061djimtrimLeft = dropWhile isWhiteSpace
d1bb6e2664788e0437acc18e877562c9a796d7cerse-- | trims a string only on the right side
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetrimRight :: String -> String
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsetrimRight = reverse . dropWhile isWhiteSpace . reverse
7933d4a963def02417113b6798d87a36395053b0rse-- | Given a string inserts spaces before and after an
71c00f988beb28388702e14cb7fe06f08bd792bbdougmspacesAroundArrows :: String -> String -> String
71c00f988beb28388702e14cb7fe06f08bd792bbdougmspacesAroundArrows s output
7933d4a963def02417113b6798d87a36395053b0rse --function to tell if in the string follows a arrow
7933d4a963def02417113b6798d87a36395053b0rse isArrow text = case take 2 $ trimLeft text of
53c239bee62c6d55b5ddfba5d99376d4c8de924ejwoolley "->" ->True
7933d4a963def02417113b6798d87a36395053b0rse in case s of
7933d4a963def02417113b6798d87a36395053b0rse [] -> output
7933d4a963def02417113b6798d87a36395053b0rse case isArrow s of
7933d4a963def02417113b6798d87a36395053b0rse True -> spacesAroundArrows (drop 2 $ trimLeft s)
7933d4a963def02417113b6798d87a36395053b0rse (output ++" -> ")
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse False -> spacesAroundArrows (safeTail s)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (output ++ [head s])
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Given a string the function decomposes it into 4 lists,
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe-- one for node goals, the other for edges, the third for
7933d4a963def02417113b6798d87a36395053b0rse-- numbered edges and the last for names that could not be
7933d4a963def02417113b6798d87a36395053b0rse-- processed due to errors
7933d4a963def02417113b6798d87a36395053b0rsedecomposeIntoGoals :: String -> ([String],[String],[String],[String])
7933d4a963def02417113b6798d87a36395053b0rsedecomposeIntoGoals input
7933d4a963def02417113b6798d87a36395053b0rse -- the new input where words and arrows are separated
7933d4a963def02417113b6798d87a36395053b0rse -- by exactly one space
7933d4a963def02417113b6798d87a36395053b0rse nwInput = words $ spacesAroundArrows input []
7933d4a963def02417113b6798d87a36395053b0rse -- funtion to parse the input and decompose it into
7933d4a963def02417113b6798d87a36395053b0rse -- the three goal list
7933d4a963def02417113b6798d87a36395053b0rse parse info nbOfArrows word sw listNode listEdge
7933d4a963def02417113b6798d87a36395053b0rse listNbEdge listError
7933d4a963def02417113b6798d87a36395053b0rse = case info of
7933d4a963def02417113b6798d87a36395053b0rse [] -> case nbOfArrows :: Integer of
7933d4a963def02417113b6798d87a36395053b0rse 0 -> ((word:listNode), listEdge, listNbEdge,listError)
7933d4a963def02417113b6798d87a36395053b0rse 1 -> (listNode, (word:listEdge), listNbEdge,listError)
7933d4a963def02417113b6798d87a36395053b0rse 2 -> (listNode, listEdge, (word:listNbEdge),listError)
7933d4a963def02417113b6798d87a36395053b0rse _ -> (listNode, listEdge, listNbEdge, (word:listError))
7933d4a963def02417113b6798d87a36395053b0rse "->":l -> case word of
7933d4a963def02417113b6798d87a36395053b0rse [] -> (listNode,listEdge,listNbEdge,
7933d4a963def02417113b6798d87a36395053b0rse (word:listError))
7933d4a963def02417113b6798d87a36395053b0rse _ -> parse l (nbOfArrows+1) (word++" -> ")
7933d4a963def02417113b6798d87a36395053b0rse True listNode listEdge listNbEdge listError
7933d4a963def02417113b6798d87a36395053b0rse x:l -> case sw of
7933d4a963def02417113b6798d87a36395053b0rse True -> parse l nbOfArrows (word++x) False
7933d4a963def02417113b6798d87a36395053b0rse listNode listEdge listNbEdge listError
7933d4a963def02417113b6798d87a36395053b0rse case nbOfArrows of
7933d4a963def02417113b6798d87a36395053b0rse 0 -> parse l 0 x False
7933d4a963def02417113b6798d87a36395053b0rse (word:listNode) listEdge listNbEdge listError
7933d4a963def02417113b6798d87a36395053b0rse 1 -> parse l 0 x False
7933d4a963def02417113b6798d87a36395053b0rse listNode (word:listEdge) listNbEdge listError
7933d4a963def02417113b6798d87a36395053b0rse 2 -> parse l 0 x False
7933d4a963def02417113b6798d87a36395053b0rse listNode listEdge (word:listNbEdge) listError
7933d4a963def02417113b6798d87a36395053b0rse _ -> parse l 0 x False
7933d4a963def02417113b6798d87a36395053b0rse listNode listEdge listNbEdge (word:listError)
7933d4a963def02417113b6798d87a36395053b0rse in parse nwInput 0 [] True [] [] [] []
7efe7de73c89c26518714a504359244d03cfbbc5jorton-- | mapAndSplit maps a function to a list. If the function can not
7efe7de73c89c26518714a504359244d03cfbbc5jorton-- be applied to an element it is stored in a different list for
f84d3d83a741c21154d42e0ebdec9b9b37efeedcjorton-- producing error message later on
f84d3d83a741c21154d42e0ebdec9b9b37efeedcjortonmapAndSplit :: (a -> Maybe b) -> [a] -> ([a],[b])
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsemapAndSplit fn ls
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse = let mapAndSplit' fn' ls' errs mapped =
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse case ls' of
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse [] -> (errs,mapped)
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm x:l -> case fn' x of
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm Just y -> mapAndSplit' fn' l errs (y:mapped)
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm Nothing-> mapAndSplit' fn' l (x:errs) mapped
7933d4a963def02417113b6798d87a36395053b0rse in mapAndSplit' fn ls [] []
7933d4a963def02417113b6798d87a36395053b0rse-- | concatMapAndSplit is similar to mapAndSplit, just that it behaves
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- in a similar manner to concatMap (i.e. sums up lists produced by
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- the function
8fdc55d1624c714391fe1f93ebafe98ace427f4adougmconcatMapAndSplit :: (a -> [b]) -> [a] -> ([a],[b])
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseconcatMapAndSplit fn ls
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse = let concatMapAndSplit' fn' ls' errs mapped =
7933d4a963def02417113b6798d87a36395053b0rse case ls' of
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse [] -> (errs, mapped)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse x:l -> case fn' x of
7933d4a963def02417113b6798d87a36395053b0rse [] -> concatMapAndSplit' fn' l (x:errs) mapped
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse l' -> concatMapAndSplit' fn' l errs (mapped++l')
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse in concatMapAndSplit' fn ls [] []
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Given a list of node names and the list of all nodes
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- the function returns all the nodes that have their name
a72de14bfdbf0be9d935be9bdc2df631ca5e032bdougm-- in the name list
a72de14bfdbf0be9d935be9bdc2df631ca5e032bdougmobtainNodeList :: [String] ->[LNode DGNodeLab]
a72de14bfdbf0be9d935be9bdc2df631ca5e032bdougm ->([String],[LNode DGNodeLab])
a72de14bfdbf0be9d935be9bdc2df631ca5e032bdougmobtainNodeList lN allNodes
a72de14bfdbf0be9d935be9bdc2df631ca5e032bdougm = mapAndSplit
a72de14bfdbf0be9d935be9bdc2df631ca5e032bdougm (\x -> find (\(_,label) -> getDGNodeName label == x) allNodes) lN
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Given a node decides if it contains goals or not
7933d4a963def02417113b6798d87a36395053b0rsenodeContainsGoals:: LNode DGNodeLab -> G_theory -> Bool
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrsenodeContainsGoals (_,l) th
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse = (not (isDGRef l)) &&
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse ((case th of
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse G_theory _ _ _ sens _ ->
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse (\s-> (not (isAxiom s)) && (not (isProvenSenStatus s))) sens
7933d4a963def02417113b6798d87a36395053b0rse ) || hasOpenConsStatus False l)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Given an edge decides if it contains goals or not
7933d4a963def02417113b6798d87a36395053b0rseedgeContainsGoals:: LEdge DGLinkLab -> Bool
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrseedgeContainsGoals (_,_,l)
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse = case thmLinkStatus $ dgl_type l of
7933d4a963def02417113b6798d87a36395053b0rse Just LeftOpen -> True
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- | Given a list of edges and the complete list of all
e6e65585927961caf45d4e9e932bb1f4e9e89ca1jerenkrantz-- edges computes not only the names of edges but also the
e6e65585927961caf45d4e9e932bb1f4e9e89ca1jerenkrantz-- numbered name of edges
e6e65585927961caf45d4e9e932bb1f4e9e89ca1jerenkrantzcreateEdgeNames:: [LNode DGNodeLab] -> [LEdge DGLinkLab]
e6e65585927961caf45d4e9e932bb1f4e9e89ca1jerenkrantz -> [LEdge DGLinkLab] -> [String]
e6e65585927961caf45d4e9e932bb1f4e9e89ca1jerenkrantzcreateEdgeNames lsN lsEC lsE
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse -- given the number of a node it returns its name
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse nameOf x ls = case find (\ (nb, _) -> nb == x) ls of
7933d4a963def02417113b6798d87a36395053b0rse Nothing -> "Unknown node"
7933d4a963def02417113b6798d87a36395053b0rse Just (_, nlab) -> showName $ dgn_name nlab
7933d4a963def02417113b6798d87a36395053b0rse -- list of all edge names with duplicates and edge
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe edgs = map(\l@(x,y,_) -> ((nameOf x lsN) ++
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe " -> "++(nameOf y lsN),l)) lsEC
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- list of uncounted edge names (i.e. n1->n2)
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe simpleEdgs = nub $ map (\(x,_)->x) edgs
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- list of counted edge name
239dd0cf663713025d4451ddd465685021007d82wrowe nbEdgs = concatMap
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- list of all occurances of the same name
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe let p = filter (\(y,_) -> x == y) edgs
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- first node name
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe n1= (words x) !! 0
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- second node name
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe n2= (words x) !! 2
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- given a number n, a function that
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- generates n edge names x->i->y with
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- i from 0 to n
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe sz= length p
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe fn n l h=case n of
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe 1 ->[(n1++" -> "++(show (sz-1))
239dd0cf663713025d4451ddd465685021007d82wrowe ++" -> "++n2 ,
239dd0cf663713025d4451ddd465685021007d82wrowe snd $ head h)]++l
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe _->fn (n-1)
239dd0cf663713025d4451ddd465685021007d82wrowe ([(n1++" -> "++(show (sz-n))
239dd0cf663713025d4451ddd465685021007d82wrowe ++" -> "++n2,
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe snd $ head h)]++l)
56bd16e394f49423a22aa82643eb27f26db2c748jorton -- a list of |p| edge names counted from
56bd16e394f49423a22aa82643eb27f26db2c748jorton -- 0 to |p|-1
56bd16e394f49423a22aa82643eb27f26db2c748jorton in fn sz [] p ) simpleEdgs
56bd16e394f49423a22aa82643eb27f26db2c748jorton -- compute list of numbered edges that needs to be
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- returned
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe filEdg = map (\(x',_) -> x') $
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe concatMap (\x -> filter (\(_,y)-> x==y) nbEdgs)
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- compute list of unnumbered edges that need to be
239dd0cf663713025d4451ddd465685021007d82wrowe -- returned
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe fSE=filter(\x->case find(\y->((words y)!!0 ==(words x)!!0)
d1bb6e2664788e0437acc18e877562c9a796d7cerse && ((words y)!!4 == (words x)!!2)
71c00f988beb28388702e14cb7fe06f08bd792bbdougm ) filEdg of
71c00f988beb28388702e14cb7fe06f08bd792bbdougm Nothing -> False
71c00f988beb28388702e14cb7fe06f08bd792bbdougm Just _ -> True) simpleEdgs
7933d4a963def02417113b6798d87a36395053b0rse fE=concatMap
b5451913a64155af2eab4f12ecbaf16e15acafc3wrowe ks=filter(\y->((words y)!!0==(words x)!!0)
b5451913a64155af2eab4f12ecbaf16e15acafc3wrowe &&((words y)!!4==(words x)!!2)) filEdg
8aced0b621ea45e8621c7073b0bfbe5ea91c2329wrowe in case length ks > 1 of
b5451913a64155af2eab4f12ecbaf16e15acafc3wrowe False -> [] ) simpleEdgs
93350a0dfa22a2c523cdcbad3357327013ecc145martin in fE ++ fSE
b5451913a64155af2eab4f12ecbaf16e15acafc3wrowe-- | Given a list of edge names and numbered edge names
239dd0cf663713025d4451ddd465685021007d82wrowe-- and the list of all nodes and edges the function
e13735ceb2025ea8ed0c530093e13fe57b62f1efwrowe-- identifies the edges that appear in the name lists
b5451913a64155af2eab4f12ecbaf16e15acafc3wroweobtainEdgeList :: [String] ->[String] ->[LNode DGNodeLab]
e13735ceb2025ea8ed0c530093e13fe57b62f1efwrowe -> [LEdge DGLinkLab]-> ([String],[LEdge DGLinkLab])
e13735ceb2025ea8ed0c530093e13fe57b62f1efwroweobtainEdgeList lsEdge lsNbEdge allNodes allEdges
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- function that searches through a list of nodes to
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe -- find the node number for a given name.
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe let getNodeNb s ls =
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe case find ( \(_,label) ->
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe getDGNodeName label == s) ls of
2b7078b0c4fd5b6054f6f2d4f626177844f5c6f7wrowe Nothing -> Nothing
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe Just (nb,_) -> Just nb
af5dd1c93d2185f7e37f8783c593b64fd35ea8a6wrowe -- converts a string to a number (for some reason I
8dc154408549195c828b823e9dc7396f107f2512jorton -- could not find such a function already implemented
8dc154408549195c828b823e9dc7396f107f2512jorton -- in the Prelude )
b79b480213d7452db127eec054e52eb2b4fa6153wrowe strToInt s val =
417f504d4d11631c0d062be85347f82a26c88677aaron [] -> Just val
7933d4a963def02417113b6798d87a36395053b0rse _ -> case isHexDigit $ last s of
7933d4a963def02417113b6798d87a36395053b0rse False -> Nothing
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm True -> strToInt (init s)
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm (val * 10 + (digitToInt $ last s))
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm l1=concatMapAndSplit
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm let allx = words nme
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm node1 = getNodeNb (allx!!0) allNodes
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm node2 = getNodeNb (allx!!2) allNodes
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm case node1 of
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm Nothing -> []
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm case node2 of
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm Nothing -> []
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm filter(\(x1,y1,_)->(x==x1)&&(y==y1)) allEdges
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm -- compute the list of all numbered edges
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm l2=mapAndSplit
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm let allx = words nme
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm node1= getNodeNb (allx!!0) allNodes
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm node2= getNodeNb (allx!!4) allNodes
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton nb = strToInt (allx!!2) 0
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton case node1 of
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm Nothing -> Nothing
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm case node2 of
cde1010d880fb6230f80c9d697842ea0b1cb79c7dougm Nothing -> Nothing
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm Nothing -> Nothing
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm Just nb' ->
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm let ls=filter(\(x1,y1,_)->(x==x1)&&(y==y1))allEdges
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm in case length ls < nb' of
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm True -> Nothing
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm False -> Just (ls!!nb') ) lsNbEdge
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm in ((fst l1)++(fst l2),(snd l1)++(snd l2))
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm-- | Giben a listof edgenamesand numbered edge names and
ccbf65bf19ac58a396133923aee4597e0870ec47bnicholes-- the list of all nodes and edges the function identifies
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm-- the edges that appearin the name list and are also goals
621bd763d2e4d32f19013ac8b76b375b5a01851fdougmobtainGoalEdgeList :: [String] -> [String] ->
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm [LNode DGNodeLab] -> [LEdge DGLinkLab]
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm -> ([String],[LEdge DGLinkLab])
621bd763d2e4d32f19013ac8b76b375b5a01851fdougmobtainGoalEdgeList ls1 ls2 ls3 ls4
621bd763d2e4d32f19013ac8b76b375b5a01851fdougm = let (l1,l2) = obtainEdgeList ls1 ls2 ls3 ls4
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm l2' = filter edgeContainsGoals l2
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm in (l1,l2')
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe-- | Function that given a string removes comments contained
7933d4a963def02417113b6798d87a36395053b0rse-- in the string
a943533fd4d91d114af622731a405407990c4fb1rsestripComments::String -> String
a943533fd4d91d114af622731a405407990c4fb1rsestripComments input
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm = let fn ls = case ls of
469549ac22c6f7b9ecdd9df2565925563e4df84djwoolley '#':_ -> []
a943533fd4d91d114af622731a405407990c4fb1rse case ll of
a943533fd4d91d114af622731a405407990c4fb1rse '%':_ ->[]
a943533fd4d91d114af622731a405407990c4fb1rse _ -> '%':(fn ll)
a943533fd4d91d114af622731a405407990c4fb1rse l:ll -> l:(fn ll)
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm in trim $ fn input
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm-- | The function obtain the unfinished edge name from the
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm-- last position of the input or list of possible unfinished
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm-- edge names
9cb81d96f6b556cec1aa456191f43f7932aabaaedougmunfinishedEdgeName :: String -> String
a943533fd4d91d114af622731a405407990c4fb1rseunfinishedEdgeName input
a943533fd4d91d114af622731a405407990c4fb1rse -- we need a penultimum (the one before the last) function
a943533fd4d91d114af622731a405407990c4fb1rse let prevLast s = lastString $ reverse $ safeTail
a943533fd4d91d114af622731a405407990c4fb1rse $ reverse s
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm -- and the one before the penultimum
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton prevPrevLast s = lastString $ reverse $ safeTail $
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton safeTail $ reverse s
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton prev2PrevLast s = lastString $ reverse $ safeTail $
e16695d440d82ec6f9a4b9af18ae38dbeaa19366jerenkrantz safeTail $ safeTail $ reverse s
71c00f988beb28388702e14cb7fe06f08bd792bbdougm prev3PrevLast s = lastString $ reverse $ safeTail $
a943533fd4d91d114af622731a405407990c4fb1rse safeTail$ safeTail$ safeTail $
a943533fd4d91d114af622731a405407990c4fb1rse -- is the last character an empty space?
6d7efb8c76b56eaebd6032096771c9e44b247f3fdougm case isWhiteSpace $ lastChar input of
f4c472b8dce3c2e559232dbb5b27ed2466922ea4jerenkrantz -- if so, then either the last word is an arrow, and
469549ac22c6f7b9ecdd9df2565925563e4df84djwoolley -- then we have the consider last two words, or it
469549ac22c6f7b9ecdd9df2565925563e4df84djwoolley -- is not an arrow and then we need to consider just
d0ba3b97557d47323bd055fb4002ed7692f703b9jerenkrantz -- the last word
71c00f988beb28388702e14cb7fe06f08bd792bbdougm case lastString $ words input of
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton "->" -> case prevPrevLast $ words input of
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton "->"->(prev2PrevLast $ words input) ++
e16695d440d82ec6f9a4b9af18ae38dbeaa19366jerenkrantz " -> " ++ (prevLast $ words input)
a943533fd4d91d114af622731a405407990c4fb1rse _ ->(prevLast $ words input) ++ " -> "
71c00f988beb28388702e14cb7fe06f08bd792bbdougm --anyhting else
a943533fd4d91d114af622731a405407990c4fb1rse _ -> case prevLast $ words input of
a943533fd4d91d114af622731a405407990c4fb1rse -- an entire edge name was just inserted
71c00f988beb28388702e14cb7fe06f08bd792bbdougm -- before and now we need a fresh new start
a943533fd4d91d114af622731a405407990c4fb1rse "->" -> []
d28d7091912b3d911bdbe18df2d37d315681054bdougm -- if just the first word of an edge was
a943533fd4d91d114af622731a405407990c4fb1rse -- inserted then return that
931b4fd1cc9dd3da096c45f4bf7ddcc14e0985c1dougm _ -> case lastString $ words input of
a943533fd4d91d114af622731a405407990c4fb1rse _ -> (lastString $ words input)++" "
a943533fd4d91d114af622731a405407990c4fb1rse -- then we could be in the middle of the first node
a943533fd4d91d114af622731a405407990c4fb1rse -- name, arrow or the second node name
a943533fd4d91d114af622731a405407990c4fb1rse case prevLast $ words input of
c947acd3d1a604a0acad6a53ef685312d4410fc5dougm -- in the middle of the last word
a943533fd4d91d114af622731a405407990c4fb1rse "->" -> case prev2PrevLast $ words input of
a943533fd4d91d114af622731a405407990c4fb1rse "->"->(prev3PrevLast $ words input) ++
a943533fd4d91d114af622731a405407990c4fb1rse " -> "++(prevPrevLast $ words
a943533fd4d91d114af622731a405407990c4fb1rse input)++" -> "++(lastString $
a943533fd4d91d114af622731a405407990c4fb1rse words input)
7933d4a963def02417113b6798d87a36395053b0rse _->(prevPrevLast $ words input) ++
7933d4a963def02417113b6798d87a36395053b0rse " -> " ++ (lastString $ words input)
7b6ba9c468f26bdb3492d5e8cb79628a3b04e8c8wrowe _ -> case prevPrevLast $ words input of
7933d4a963def02417113b6798d87a36395053b0rse -- in the middle of the first word
a943533fd4d91d114af622731a405407990c4fb1rse "->" -> lastString $ words input
a943533fd4d91d114af622731a405407990c4fb1rse -- in the middle of the arrow
2f32a3d146dc55d81b31660386e17c3b83ad61b8bnicholes _ -> case prevLast $ words input of
a943533fd4d91d114af622731a405407990c4fb1rse [] -> lastString $ words input
71c00f988beb28388702e14cb7fe06f08bd792bbdougm _ ->( (prevLast $ words input) ++
a943533fd4d91d114af622731a405407990c4fb1rse " " ++ (lastString $
a943533fd4d91d114af622731a405407990c4fb1rse words input) )
7933d4a963def02417113b6798d87a36395053b0rse-- | Given a list of files and folders the function filters
71c00f988beb28388702e14cb7fe06f08bd792bbdougm-- only directory names and files ending in extenstion
a943533fd4d91d114af622731a405407990c4fb1rsefileFilter::String ->[String]->[String] -> IO [String]
a943533fd4d91d114af622731a405407990c4fb1rsefileFilter lPath ls cons
2f32a3d146dc55d81b31660386e17c3b83ad61b8bnicholes = case ls of
a943533fd4d91d114af622731a405407990c4fb1rse [] -> return cons
a943533fd4d91d114af622731a405407990c4fb1rse -- check if current element is a directory
7933d4a963def02417113b6798d87a36395053b0rse b <- doesDirectoryExist (lPath++x)
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe -- if it is,then add "/" to indicate is a folder
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe True -> fileFilter lPath l ((x++"/"):cons)
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe -- if it is not a folder then it must be a file
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe -- so check the extension
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe False-> case isSuffixOf ".casl" x of
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe True -> fileFilter lPath l (x:cons)
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe False-> fileFilter lPath l cons
ccbf65bf19ac58a396133923aee4597e0870ec47bnicholes-- | Given a list of files and folders the function expands
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe-- the list adding the content of all folders in the list
e726f34f8da08c01ee8bc90904b26196b69c8587wrowefileExtend::String->[String]->[String]-> IO [String]
e726f34f8da08c01ee8bc90904b26196b69c8587wrowefileExtend lPath ls cons
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe = case ls of
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe [] -> return cons
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe -- check if current element is a directory
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe b<- doesDirectoryExist (lPath++x)
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe -- if it is not then leave the file alone
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe False -> fileExtend lPath l (x:cons)
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe -- if it is a folder add its content
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe ll <- getDirectoryContents (lPath++x)
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe nll<- fileFilter (lPath++x) ll []
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe let nll'=map (\y -> x++y) nll
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe fileExtend lPath l (nll' ++ cons)
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton-- | The function behaves exactly as tail just that
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton-- in the case of empty list returns an empty list
2261f694ce2fc09f9df6c65bd8e1f4230313696bjorton-- instead of an error
e726f34f8da08c01ee8bc90904b26196b69c8587wrowesafeTail::[a]->[a]
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe = case ls of
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe-- | The function behaves exactly like last just that
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe-- in case of an empty list returns the space
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe-- character (it works only for lists of chars)
ccbf65bf19ac58a396133923aee4597e0870ec47bnicholeslastChar::[Char]->Char
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe = case ls of
e726f34f8da08c01ee8bc90904b26196b69c8587wrowe _ -> last ls
7933d4a963def02417113b6798d87a36395053b0rse-- | The function behaves exactly like last just that
cc003103e52ff9d5fe9bed567ef9438613ab4fbfrse-- in case of an empty list returns the empty string
a943533fd4d91d114af622731a405407990c4fb1rse-- (it is meant only for list of strings)
7933d4a963def02417113b6798d87a36395053b0rselastString::[String]->String
7933d4a963def02417113b6798d87a36395053b0rselastString ls
a943533fd4d91d114af622731a405407990c4fb1rse = case ls of
a943533fd4d91d114af622731a405407990c4fb1rse _ -> last ls
7b6ba9c468f26bdb3492d5e8cb79628a3b04e8c8wrowe-- | The function nicely outputs a list of errors
a943533fd4d91d114af622731a405407990c4fb1rseprettyPrintErrList:: [String]->String
fa599e0e097d4d933c4dc378ffbfc3c045dd589ewroweprettyPrintErrList list
a943533fd4d91d114af622731a405407990c4fb1rse tmpPrint ls acc =
a943533fd4d91d114af622731a405407990c4fb1rse x:ll -> tmpPrint ll $ ("Input "++x++
0fce4eaa9fdf964f33fab19d0adac422a5305261dougm " could not be processed\n")++acc
13bac43a0f21d8c6401debc1baa76be984474074rbb in tmpPrint list []
dfaea9dfb7e6fd2c97b9d35a75d7bcab94af8ff8dougm-- | The function nicely ouputs a list of strings
7933d4a963def02417113b6798d87a36395053b0rseprettyPrintList ::[String]->String
9cb81d96f6b556cec1aa456191f43f7932aabaaedougmprettyPrintList ls
9cb81d96f6b556cec1aa456191f43f7932aabaaedougm = unlines ls