{- |
Module      : ./CMDL/Utils.hs
Description : utilitary functions used throughout the CMDL interface
Copyright   : uni-bremen and DFKI
License     : GPLv2 or higher, see LICENSE.txt
Maintainer  : r.pascanu@jacobs-university.de
Stability   : provisional
Portability : portable

CMDL.Utils contains different basic functions that are
used throughout the CMDL interface and could not be found in
Prelude

-}

module CMDL.Utils
  ( decomposeIntoGoals
  , obtainNodeList
  , createEdgeNames
  , obtainEdgeList
  , obtainGoalEdgeList
  , finishedNames
  , stripComments
  , lastChar
  , lastString
  , safeTail
  , fileFilter
  , fileExtend
  , prettyPrintErrList
  , edgeContainsGoals
  , isOpenConsEdge
  , checkIntString
  , delExtension
  , arrowLink
  ) where

import Data.List
import Data.Maybe
import Data.Char (isDigit)
import Data.Graph.Inductive.Graph (LNode, LEdge)

import System.Directory
import System.FilePath

import Static.DevGraph
import Static.DgUtils

import Common.Utils

{- removes the extension of the file find in the
   name of the prompter ( it delets everything
   after the last . and assumes a prompter length of 2 ) -}
delExtension :: String -> String
delExtension :: String -> String
delExtension str :: String
str = let rstr :: String
rstr = String -> String
forall a. [a] -> [a]
reverse String
str in
  String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
safeTail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.') String
rstr of
    "" -> String -> String
forall a. [a] -> [a]
safeTail String
rstr
    dstr :: String
dstr -> String
dstr

-- | Checks if a string represents a int or not
checkIntString :: String -> Bool
checkIntString :: String -> Bool
checkIntString = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)

localArr :: String
localArr :: String
localArr = "..>"

globalArr :: String
globalArr :: String
globalArr = "->"

padBlanks :: String -> String
padBlanks :: String -> String
padBlanks s :: String
s = ' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "

-- | Generates a string representing the type of link
arrowLink :: DGLinkLab -> String
arrowLink :: DGLinkLab -> String
arrowLink edgLab :: DGLinkLab
edgLab = String -> String
padBlanks (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ if DGLinkType -> Bool
isLocalEdge (DGLinkType -> Bool) -> DGLinkType -> Bool
forall a b. (a -> b) -> a -> b
$ DGLinkLab -> DGLinkType
dgl_type DGLinkLab
edgLab
    then String
localArr
    else String
globalArr

-- | Checks if the string starts with an arrow
checkArrowLink :: String -> Maybe (String, String)
checkArrowLink :: String -> Maybe (String, String)
checkArrowLink str :: String
str = case ((String, Bool) -> Bool)
-> [(String, Bool)] -> Maybe (String, Bool)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String, Bool) -> Bool
forall a b. (a, b) -> b
snd
  ([(String, Bool)] -> Maybe (String, Bool))
-> [(String, Bool)] -> Maybe (String, Bool)
forall a b. (a -> b) -> a -> b
$ (String -> (String, Bool)) -> [String] -> [(String, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\ s :: String
s -> (String
s, String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
s String
str)) [String
localArr, String
globalArr] of
  Nothing -> Maybe (String, String)
forall a. Maybe a
Nothing
  Just (a :: String
a, _) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String -> String
padBlanks String
a, Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) String
str)

{- | Given a string inserts spaces before and after an
   arrow -}
spacesAroundArrows :: String -> String
spacesAroundArrows :: String -> String
spacesAroundArrows s :: String
s = case String
s of
       [] -> []
       hd :: Char
hd : tl :: String
tl -> case String -> Maybe (String, String)
checkArrowLink (String -> Maybe (String, String))
-> String -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ String -> String
trimLeft String
s of
          Just (arr :: String
arr, rs :: String
rs) -> String
arr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
spacesAroundArrows String
rs
          Nothing -> Char
hd Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
spacesAroundArrows String
tl

{- | Given a string the function decomposes it into 4 lists,
   one for node goals, the other for edges, the third for
   numbered edges and the last for names that could not be
   processed due to errors -}
decomposeIntoGoals :: String -> ([String], [String], [String], [String])
decomposeIntoGoals :: String -> ([String], [String], [String], [String])
decomposeIntoGoals input :: String
input = let
    {- the new input where words and arrows are separated
       by exactly one space -}
    nwInput :: [String]
nwInput = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
spacesAroundArrows String
input
    {- function to parse the input and decompose it into
       the three goal list -}
    parse :: [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse info :: [String]
info nbOfArrows :: Integer
nbOfArrows word :: String
word sw :: Bool
sw listNode :: [String]
listNode listEdge :: [String]
listEdge listNbEdge :: [String]
listNbEdge listError :: [String]
listError =
       case [String]
info of
        [] -> case Integer
nbOfArrows :: Integer of
               0 -> (String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listNode, [String]
listEdge, [String]
listNbEdge, [String]
listError)
               1 -> ([String]
listNode, String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listEdge, [String]
listNbEdge, [String]
listError)
               2 -> ([String]
listNode, [String]
listEdge, String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listNbEdge, [String]
listError)
               _ -> ([String]
listNode, [String]
listEdge, [String]
listNbEdge, String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listError)
        x :: String
x : l :: [String]
l -> case String -> Maybe (String, String)
checkArrowLink String
x of
                Just (arr :: String
arr, _) ->
                  case String
word of
                   [] -> ([String]
listNode, [String]
listEdge, [String]
listNbEdge, String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listError)
                   _ -> [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
l (Integer
nbOfArrows Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1) (String
word String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arr) Bool
True
                           [String]
listNode [String]
listEdge [String]
listNbEdge [String]
listError
                Nothing ->
                  if Bool
sw
                   then [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
l Integer
nbOfArrows (String
word String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) Bool
False
                          [String]
listNode [String]
listEdge [String]
listNbEdge [String]
listError
                   else
                    case Integer
nbOfArrows of
                     0 -> [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
l 0 String
x Bool
False
                           (String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listNode) [String]
listEdge [String]
listNbEdge [String]
listError
                     1 -> [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
l 0 String
x Bool
False
                           [String]
listNode (String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listEdge) [String]
listNbEdge [String]
listError
                     2 -> [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
l 0 String
x Bool
False
                           [String]
listNode [String]
listEdge (String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listNbEdge) [String]
listError
                     _ -> [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
l 0 String
x Bool
False
                           [String]
listNode [String]
listEdge [String]
listNbEdge (String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
listError)
    (ns :: [String]
ns, es :: [String]
es, les :: [String]
les, errs :: [String]
errs) = [String]
-> Integer
-> String
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> ([String], [String], [String], [String])
parse [String]
nwInput 0 [] Bool
True [] [] [] []
    in ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
ns, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
es, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
les, [String] -> [String]
forall a. [a] -> [a]
reverse [String]
errs)

{- | mapAndSplit maps a function to a list. If the function can not
   be applied to an element it is stored in a different list for
   producing error message later on -}
mapAndSplit :: (a -> Maybe b) -> [a] -> ([a], [b])
mapAndSplit :: (a -> Maybe b) -> [a] -> ([a], [b])
mapAndSplit fn :: a -> Maybe b
fn ls :: [a]
ls =
  let ps :: [(a, Maybe b)]
ps = [a] -> [Maybe b] -> [(a, Maybe b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ls ([Maybe b] -> [(a, Maybe b)]) -> [Maybe b] -> [(a, Maybe b)]
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> [a] -> [Maybe b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe b
fn [a]
ls
      (oks :: [(a, Maybe b)]
oks, errs :: [(a, Maybe b)]
errs) = ((a, Maybe b) -> Bool)
-> [(a, Maybe b)] -> ([(a, Maybe b)], [(a, Maybe b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Maybe b -> Bool)
-> ((a, Maybe b) -> Maybe b) -> (a, Maybe b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Maybe b) -> Maybe b
forall a b. (a, b) -> b
snd) [(a, Maybe b)]
ps
  in (((a, Maybe b) -> a) -> [(a, Maybe b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Maybe b) -> a
forall a b. (a, b) -> a
fst [(a, Maybe b)]
errs, ((a, Maybe b) -> Maybe b) -> [(a, Maybe b)] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (a, Maybe b) -> Maybe b
forall a b. (a, b) -> b
snd [(a, Maybe b)]
oks)

{- | concatMapAndSplit is similar to mapAndSplit, just that it behaves
   in a similar manner to concatMap (i.e. sums up lists produced by
   the function -}
concatMapAndSplit :: (a -> [b]) -> [a] -> ([a], [b])
concatMapAndSplit :: (a -> [b]) -> [a] -> ([a], [b])
concatMapAndSplit fn :: a -> [b]
fn ls :: [a]
ls =
  let ps :: [(a, [b])]
ps = [a] -> [[b]] -> [(a, [b])]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ls ([[b]] -> [(a, [b])]) -> [[b]] -> [(a, [b])]
forall a b. (a -> b) -> a -> b
$ (a -> [b]) -> [a] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [b]
fn [a]
ls
      (errs :: [(a, [b])]
errs, oks :: [(a, [b])]
oks) = ((a, [b]) -> Bool) -> [(a, [b])] -> ([(a, [b])], [(a, [b])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([b] -> Bool) -> ((a, [b]) -> [b]) -> (a, [b]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [b]) -> [b]
forall a b. (a, b) -> b
snd) [(a, [b])]
ps
  in (((a, [b]) -> a) -> [(a, [b])] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, [b]) -> a
forall a b. (a, b) -> a
fst [(a, [b])]
errs, ((a, [b]) -> [b]) -> [(a, [b])] -> [b]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [b]) -> [b]
forall a b. (a, b) -> b
snd [(a, [b])]
oks)

{- | Given a list of node names and the list of all nodes
   the function returns all the nodes that have their name
   in the name list -}
obtainNodeList :: [String] -> [LNode DGNodeLab] -> ([String], [LNode DGNodeLab])
obtainNodeList :: [String] -> [LNode DGNodeLab] -> ([String], [LNode DGNodeLab])
obtainNodeList lN :: [String]
lN allNodes :: [LNode DGNodeLab]
allNodes = (String -> Maybe (LNode DGNodeLab))
-> [String] -> ([String], [LNode DGNodeLab])
forall a b. (a -> Maybe b) -> [a] -> ([a], [b])
mapAndSplit
    (\ x :: String
x -> (LNode DGNodeLab -> Bool)
-> [LNode DGNodeLab] -> Maybe (LNode DGNodeLab)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ (_, label :: DGNodeLab
label) -> DGNodeLab -> String
getDGNodeName DGNodeLab
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x) [LNode DGNodeLab]
allNodes) [String]
lN

-- | Given an edge decides if it contains goals or not
edgeContainsGoals :: LEdge DGLinkLab -> Bool
edgeContainsGoals :: LEdge DGLinkLab -> Bool
edgeContainsGoals (_, _, l :: DGLinkLab
l) = case DGLinkType -> Maybe ThmLinkStatus
thmLinkStatus (DGLinkType -> Maybe ThmLinkStatus)
-> DGLinkType -> Maybe ThmLinkStatus
forall a b. (a -> b) -> a -> b
$ DGLinkLab -> DGLinkType
dgl_type DGLinkLab
l of
     Just LeftOpen -> Bool
True
     _ -> Bool
False

-- | Given an edge: does it contain an open conservativity goal or not
isOpenConsEdge :: LEdge DGLinkLab -> Bool
isOpenConsEdge :: LEdge DGLinkLab -> Bool
isOpenConsEdge (_, _, l :: DGLinkLab
l) = Bool -> ConsStatus -> Bool
hasOpenConsStatus Bool
False (ConsStatus -> Bool) -> ConsStatus -> Bool
forall a b. (a -> b) -> a -> b
$ DGLinkLab -> ConsStatus
getEdgeConsStatus DGLinkLab
l

{- | Given a list of edges and the complete list of all
   edges computes not only the names of edges but also the
   numbered name of edges -}
createEdgeNames :: [LNode DGNodeLab] -> [LEdge DGLinkLab]
  -> [(String, LEdge DGLinkLab)]
createEdgeNames :: [LNode DGNodeLab]
-> [LEdge DGLinkLab] -> [(String, LEdge DGLinkLab)]
createEdgeNames lsN :: [LNode DGNodeLab]
lsN lsE :: [LEdge DGLinkLab]
lsE = let
  -- function that returns the name of a node given its number
   nameOf :: a -> [(a, DGNodeLab)] -> String
nameOf x :: a
x ls :: [(a, DGNodeLab)]
ls = case a -> [(a, DGNodeLab)] -> Maybe DGNodeLab
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, DGNodeLab)]
ls of
                  Nothing -> "Unknown node"
                  Just nlab :: DGNodeLab
nlab -> DGNodeLab -> String
getDGNodeName DGNodeLab
nlab
   ordFn :: (a, b, c) -> (a, b, c) -> Ordering
ordFn (x1 :: a
x1, x2 :: b
x2, _) (y1 :: a
y1, y2 :: b
y2, _) = (a, b) -> (a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a
x1, b
x2) (a
y1, b
y2)
   -- sorted and grouped list of edges
   edgs :: [[LEdge DGLinkLab]]
edgs = (LEdge DGLinkLab -> LEdge DGLinkLab -> Bool)
-> [LEdge DGLinkLab] -> [[LEdge DGLinkLab]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ( \ x :: LEdge DGLinkLab
x y :: LEdge DGLinkLab
y -> LEdge DGLinkLab -> LEdge DGLinkLab -> Ordering
forall a b c c.
(Ord a, Ord b) =>
(a, b, c) -> (a, b, c) -> Ordering
ordFn LEdge DGLinkLab
x LEdge DGLinkLab
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) ([LEdge DGLinkLab] -> [[LEdge DGLinkLab]])
-> [LEdge DGLinkLab] -> [[LEdge DGLinkLab]]
forall a b. (a -> b) -> a -> b
$ (LEdge DGLinkLab -> LEdge DGLinkLab -> Ordering)
-> [LEdge DGLinkLab] -> [LEdge DGLinkLab]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LEdge DGLinkLab -> LEdge DGLinkLab -> Ordering
forall a b c c.
(Ord a, Ord b) =>
(a, b, c) -> (a, b, c) -> Ordering
ordFn [LEdge DGLinkLab]
lsE
   in ([LEdge DGLinkLab] -> [(String, LEdge DGLinkLab)])
-> [[LEdge DGLinkLab]] -> [(String, LEdge DGLinkLab)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ l :: [LEdge DGLinkLab]
l -> case [LEdge DGLinkLab]
l of
                             [el :: LEdge DGLinkLab
el@(x :: Int
x, y :: Int
y, edgLab :: DGLinkLab
edgLab)] -> [(Int -> [LNode DGNodeLab] -> String
forall a. Eq a => a -> [(a, DGNodeLab)] -> String
nameOf Int
x [LNode DGNodeLab]
lsN String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                          DGLinkLab -> String
arrowLink DGLinkLab
edgLab String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                          Int -> [LNode DGNodeLab] -> String
forall a. Eq a => a -> [(a, DGNodeLab)] -> String
nameOf Int
y [LNode DGNodeLab]
lsN, LEdge DGLinkLab
el)]
                             _ -> (LEdge DGLinkLab -> (String, LEdge DGLinkLab))
-> [LEdge DGLinkLab] -> [(String, LEdge DGLinkLab)]
forall a b. (a -> b) -> [a] -> [b]
map (\ el :: LEdge DGLinkLab
el@(x :: Int
x, y :: Int
y, edgLab :: DGLinkLab
edgLab) ->
                                   (Int -> [LNode DGNodeLab] -> String
forall a. Eq a => a -> [(a, DGNodeLab)] -> String
nameOf Int
x [LNode DGNodeLab]
lsN String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   DGLinkLab -> String
arrowLink DGLinkLab
edgLab String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                     EdgeId -> String
showEdgeId (DGLinkLab -> EdgeId
dgl_id DGLinkLab
edgLab)
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ DGLinkLab -> String
arrowLink DGLinkLab
edgLab
                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [LNode DGNodeLab] -> String
forall a. Eq a => a -> [(a, DGNodeLab)] -> String
nameOf Int
y [LNode DGNodeLab]
lsN, LEdge DGLinkLab
el)) [LEdge DGLinkLab]
l) [[LEdge DGLinkLab]]
edgs

{- | Given a list of edge names and numbered edge names
   and the list of all nodes and edges the function
   identifies the edges that appear in the name lists -}
obtainEdgeList :: [String] -> [String] -> [LNode DGNodeLab]
  -> [LEdge DGLinkLab] -> ([String], [LEdge DGLinkLab])
obtainEdgeList :: [String]
-> [String]
-> [LNode DGNodeLab]
-> [LEdge DGLinkLab]
-> ([String], [LEdge DGLinkLab])
obtainEdgeList lsEdge :: [String]
lsEdge lsNbEdge :: [String]
lsNbEdge allNodes :: [LNode DGNodeLab]
allNodes allEdges :: [LEdge DGLinkLab]
allEdges = let
   {- function that searches through a list of nodes to
      find the node number for a given name. -}
       getNodeNb :: String -> t (a, DGNodeLab) -> Maybe a
getNodeNb s :: String
s ls :: t (a, DGNodeLab)
ls =
          case ((a, DGNodeLab) -> Bool)
-> t (a, DGNodeLab) -> Maybe (a, DGNodeLab)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ( \ (_, label :: DGNodeLab
label) ->
                        DGNodeLab -> String
getDGNodeName DGNodeLab
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) t (a, DGNodeLab)
ls of
           Nothing -> Maybe a
forall a. Maybe a
Nothing
           Just (nb :: a
nb, _) -> a -> Maybe a
forall a. a -> Maybe a
Just a
nb
        -- compute the list of all edges from source node to target
       l1 :: ([String], [LEdge DGLinkLab])
l1 = (String -> [LEdge DGLinkLab])
-> [String] -> ([String], [LEdge DGLinkLab])
forall a b. (a -> [b]) -> [a] -> ([a], [b])
concatMapAndSplit
            (\ nme :: String
nme -> case String -> [String]
words String
nme of
              [src :: String
src, _, tar :: String
tar] -> let
                node1 :: Maybe Int
node1 = String -> [LNode DGNodeLab] -> Maybe Int
forall (t :: * -> *) a.
Foldable t =>
String -> t (a, DGNodeLab) -> Maybe a
getNodeNb String
src [LNode DGNodeLab]
allNodes
                node2 :: Maybe Int
node2 = String -> [LNode DGNodeLab] -> Maybe Int
forall (t :: * -> *) a.
Foldable t =>
String -> t (a, DGNodeLab) -> Maybe a
getNodeNb String
tar [LNode DGNodeLab]
allNodes
                in case Maybe Int
node1 of
                Nothing -> []
                Just x :: Int
x ->
                 case Maybe Int
node2 of
                 Nothing -> []
                 Just y :: Int
y ->
                  (LEdge DGLinkLab -> Bool) -> [LEdge DGLinkLab] -> [LEdge DGLinkLab]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (x1 :: Int
x1, y1 :: Int
y1, _) -> Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1) [LEdge DGLinkLab]
allEdges
              _ -> String -> [LEdge DGLinkLab]
forall a. HasCallStack => String -> a
error "CMDL.Utils.obtainEdgeList1"
            ) [String]
lsEdge
        -- compute the list of all numbered edges
       l2 :: ([String], [LEdge DGLinkLab])
l2 = (String -> Maybe (LEdge DGLinkLab))
-> [String] -> ([String], [LEdge DGLinkLab])
forall a b. (a -> Maybe b) -> [a] -> ([a], [b])
mapAndSplit
           (\ nme :: String
nme -> case String -> [String]
words String
nme of
             [src :: String
src, _, numb :: String
numb, _, tar :: String
tar] -> let
               node1 :: Maybe Int
node1 = String -> [LNode DGNodeLab] -> Maybe Int
forall (t :: * -> *) a.
Foldable t =>
String -> t (a, DGNodeLab) -> Maybe a
getNodeNb String
src [LNode DGNodeLab]
allNodes
               node2 :: Maybe Int
node2 = String -> [LNode DGNodeLab] -> Maybe Int
forall (t :: * -> *) a.
Foldable t =>
String -> t (a, DGNodeLab) -> Maybe a
getNodeNb String
tar [LNode DGNodeLab]
allNodes
               mnb :: Maybe Int
mnb = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
numb
               in case Maybe Int
node1 of
               Nothing -> Maybe (LEdge DGLinkLab)
forall a. Maybe a
Nothing
               Just x :: Int
x -> case Maybe Int
node2 of
                Nothing -> Maybe (LEdge DGLinkLab)
forall a. Maybe a
Nothing
                Just y :: Int
y -> case Maybe Int
mnb of
                 Nothing -> Maybe (LEdge DGLinkLab)
forall a. Maybe a
Nothing
                 Just nb :: Int
nb -> let
                   ls :: [LEdge DGLinkLab]
ls = (LEdge DGLinkLab -> Bool) -> [LEdge DGLinkLab] -> [LEdge DGLinkLab]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (x1 :: Int
x1, y1 :: Int
y1, elab :: DGLinkLab
elab) -> Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1 Bool -> Bool -> Bool
&&
                                   DGLinkLab -> EdgeId
dgl_id DGLinkLab
elab EdgeId -> EdgeId -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> EdgeId
EdgeId Int
nb) [LEdge DGLinkLab]
allEdges
                   in case [LEdge DGLinkLab]
ls of
                     [] -> Maybe (LEdge DGLinkLab)
forall a. Maybe a
Nothing
                     els :: LEdge DGLinkLab
els : _ -> LEdge DGLinkLab -> Maybe (LEdge DGLinkLab)
forall a. a -> Maybe a
Just LEdge DGLinkLab
els
             _ -> String -> Maybe (LEdge DGLinkLab)
forall a. HasCallStack => String -> a
error "CMDL.Utils.obtainEdgeList2") [String]
lsNbEdge
   in (([String], [LEdge DGLinkLab]) -> [String]
forall a b. (a, b) -> a
fst ([String], [LEdge DGLinkLab])
l1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String], [LEdge DGLinkLab]) -> [String]
forall a b. (a, b) -> a
fst ([String], [LEdge DGLinkLab])
l2, ([String], [LEdge DGLinkLab]) -> [LEdge DGLinkLab]
forall a b. (a, b) -> b
snd ([String], [LEdge DGLinkLab])
l1 [LEdge DGLinkLab] -> [LEdge DGLinkLab] -> [LEdge DGLinkLab]
forall a. [a] -> [a] -> [a]
++ ([String], [LEdge DGLinkLab]) -> [LEdge DGLinkLab]
forall a b. (a, b) -> b
snd ([String], [LEdge DGLinkLab])
l2)

{- | Giben a listof edgenamesand numbered edge names and
   the list of all nodes and edges the function identifies
   the edges that appearin the name list and are also goals -}
obtainGoalEdgeList :: [String] -> [String] -> [LNode DGNodeLab]
                   -> [LEdge DGLinkLab] -> ([String], [LEdge DGLinkLab])
obtainGoalEdgeList :: [String]
-> [String]
-> [LNode DGNodeLab]
-> [LEdge DGLinkLab]
-> ([String], [LEdge DGLinkLab])
obtainGoalEdgeList ls1 :: [String]
ls1 ls2 :: [String]
ls2 ls3 :: [LNode DGNodeLab]
ls3 ls4 :: [LEdge DGLinkLab]
ls4 =
    let (l1 :: [String]
l1, l2 :: [LEdge DGLinkLab]
l2) = [String]
-> [String]
-> [LNode DGNodeLab]
-> [LEdge DGLinkLab]
-> ([String], [LEdge DGLinkLab])
obtainEdgeList [String]
ls1 [String]
ls2 [LNode DGNodeLab]
ls3 [LEdge DGLinkLab]
ls4
    in ([String]
l1, (LEdge DGLinkLab -> Bool) -> [LEdge DGLinkLab] -> [LEdge DGLinkLab]
forall a. (a -> Bool) -> [a] -> [a]
filter LEdge DGLinkLab -> Bool
edgeContainsGoals [LEdge DGLinkLab]
l2)

{- | Function that given a string removes comments contained
   in the string -}
stripComments :: String -> String
stripComments :: String -> String
stripComments input :: String
input =
    let fn :: String -> String
fn ls :: String
ls = case String
ls of
                '#' : _ -> []
                '%' : ll :: String
ll ->
                   case String
ll of
                    '%' : _ -> []
                    '{' : _ -> []
                    _ -> '%' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
fn String
ll
                [] -> []
                l :: Char
l : ll :: String
ll -> Char
l Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
fn String
ll
   in String -> String
trim (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
fn String
input

-- | check if edges are to be completed in the presence of nodes
finishedNames :: [String] -> String -> ([String], String)
finishedNames :: [String] -> String -> ([String], String)
finishedNames ns :: [String]
ns i :: String
i =
  let e :: ([String], String)
e@(fs :: [String]
fs, r :: String
r) = [String] -> String -> ([String], String)
fNames [String]
ns String
i in
  if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r) Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
r) [String
localArr, String
globalArr] then
    case [String] -> [String]
forall a. [a] -> [a]
reverse [String]
fs of
    lt :: String
lt : ei :: String
ei : ar :: String
ar : sr :: String
sr : fr :: [String]
fr | String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
ar [String
localArr, String
globalArr]
      -> ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
fr, [String] -> String
unwords [String
sr, String
ar, String
ei, String
lt, String
r])
    lt :: String
lt : fr :: [String]
fr -> ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
fr, [String] -> String
unwords [String
lt, String
r])
    _ -> ([String], String)
e
  else ([String], String)
e

fNames :: [String] -> String -> ([String], String)
fNames :: [String] -> String -> ([String], String)
fNames ns :: [String]
ns input :: String
input = let i :: String
i = String -> String
trimLeft String
input in
  case ((String, Maybe String) -> Bool)
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> ((String, Maybe String) -> Maybe String)
-> (String, Maybe String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Maybe String) -> Maybe String
forall a b. (a, b) -> b
snd) ([(String, Maybe String)] -> [(String, Maybe String)])
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ [String] -> [Maybe String] -> [(String, Maybe String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ns
    ([Maybe String] -> [(String, Maybe String)])
-> [Maybe String] -> [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` String
i) (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ " ")) [String]
ns of
    (n :: String
n, Just r :: String
r) : _ -> let (fs :: [String]
fs, s :: String
s) = [String] -> String -> ([String], String)
fNames [String]
ns String
r in (String
n String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
fs, String
s)
    _ -> ([], String
i)

{- | Given a list of files and folders the function filters
   only directory names and files ending in extenstion
   .casl or .het or .dol -}
fileFilter :: String -> [String] -> [String] -> IO [String]
fileFilter :: String -> [String] -> [String] -> IO [String]
fileFilter lPath :: String
lPath ls :: [String]
ls cons :: [String]
cons = case [String]
ls of
    [] -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
cons
    x :: String
x : l :: [String]
l -> do
         -- check if current element is a directory
         Bool
b <- String -> IO Bool
doesDirectoryExist (String
lPath String -> String -> String
</> String
x)
         String -> [String] -> [String] -> IO [String]
fileFilter String
lPath [String]
l ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ if Bool
b
           -- if it is,then add "/" to indicate is a folder
           then String -> String
addTrailingPathSeparator String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
cons
           {- if it is not a folder then it must be a file
              so check the extension -}
           else if String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> String
takeExtensions String
x) [".casl", ".het", ".dol" ]
                then String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
cons else [String]
cons

{- | Given a list of files and folders the function expands
   the list adding the content of all folders in the list -}
fileExtend :: String -> [String] -> [String] -> IO [String]
fileExtend :: String -> [String] -> [String] -> IO [String]
fileExtend lPath :: String
lPath ls :: [String]
ls cons :: [String]
cons = case [String]
ls of
    [] -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
cons
    x :: String
x : l :: [String]
l -> do
          -- check if current element is a directory
          let lPathx :: String
lPathx = String
lPath String -> String -> String
</> String
x
          Bool
b <- String -> IO Bool
doesDirectoryExist String
lPathx
          if Bool
b then
            -- if it is a folder add its content
            do [String]
ll <- String -> IO [String]
getDirectoryContents String
lPathx
               [String]
nll <- String -> [String] -> [String] -> IO [String]
fileFilter String
lPathx [String]
ll []
               let nll' :: [String]
nll' = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
x String -> String -> String
</>) [String]
nll
               String -> [String] -> [String] -> IO [String]
fileExtend String
lPath [String]
l ([String]
nll' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
cons)
            -- if it is not then leave the file alone
            else String -> [String] -> [String] -> IO [String]
fileExtend String
lPath [String]
l (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
cons)

{- | The function behaves exactly as tail just that
   in the case of empty list returns an empty list
   instead of an error -}
safeTail :: [a] -> [a]
safeTail :: [a] -> [a]
safeTail = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop 1

safeLast :: a -> [a] -> a
safeLast :: a -> [a] -> a
safeLast d :: a
d l :: [a]
l = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l then a
d else [a] -> a
forall a. [a] -> a
last [a]
l

{- | The function behaves exactly like last just that
   in case of an empty list returns the space
   character (it works only for lists of chars) -}
lastChar :: String -> Char
lastChar :: String -> Char
lastChar = Char -> String -> Char
forall a. a -> [a] -> a
safeLast ' '

{- | The function behaves exactly like last just that
   in case of an empty list returns the empty string
   (it is meant only for list of strings) -}
lastString :: [String] -> String
lastString :: [String] -> String
lastString = String -> [String] -> String
forall a. a -> [a] -> a
safeLast ""

-- | The function nicely outputs a list of errors
prettyPrintErrList :: [String] -> String
prettyPrintErrList :: [String] -> String
prettyPrintErrList = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n"
  ([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 (\ x :: String
x -> "Input " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " could not be processed")