content: {- |
  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 str = let rstr = reverse str in
    reverse $ safeTail $ case dropWhile (/= '.') rstr of
      "" -> safeTail rstr
      dstr -> dstr
  
  -- | Checks if a string represents a int or not
  checkIntString :: String -> Bool
  checkIntString = not . any (not . isDigit)
  
  localArr :: String
  localArr = "..>"
  
  globalArr :: String
  globalArr = "->"
  
  padBlanks :: String -> String
  padBlanks s = ' ' : s ++ " "
  
  -- | Generates a string representing the type of link
  arrowLink :: DGLinkLab -> String
  arrowLink edgLab = padBlanks $ if isLocalEdge $ dgl_type edgLab
      then localArr
      else globalArr
  
  -- | Checks if the string starts with an arrow
  checkArrowLink :: String -> Maybe (String, String)
  checkArrowLink str = case find snd
    $ map (\ s -> (s, isPrefixOf s str)) [localArr, globalArr] of
    Nothing -> Nothing
    Just (a, _) -> Just (padBlanks a, drop (length a) str)
  
  {- | Given a string inserts spaces before and after an
     arrow -}
  spacesAroundArrows :: String -> String
  spacesAroundArrows s = case s of
         [] -> []
         hd : tl -> case checkArrowLink $ trimLeft s of
            Just (arr, rs) -> arr ++ spacesAroundArrows rs
            Nothing -> hd : spacesAroundArrows 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 input = let
      {- the new input where words and arrows are separated
         by exactly one space -}
      nwInput = words $ spacesAroundArrows input
      {- function to parse the input and decompose it into
         the three goal list -}
      parse info nbOfArrows word sw listNode listEdge listNbEdge listError =
         case info of
          [] -> case nbOfArrows :: Integer of
                 0 -> (word : listNode, listEdge, listNbEdge, listError)
                 1 -> (listNode, word : listEdge, listNbEdge, listError)
                 2 -> (listNode, listEdge, word : listNbEdge, listError)
                 _ -> (listNode, listEdge, listNbEdge, word : listError)
          x : l -> case checkArrowLink x of
                  Just (arr, _) ->
                    case word of
                     [] -> (listNode, listEdge, listNbEdge, word : listError)
                     _ -> parse l (nbOfArrows + 1) (word ++ arr) True
                             listNode listEdge listNbEdge listError
                  Nothing ->
                    if sw
                     then parse l nbOfArrows (word ++ x) False
                            listNode listEdge listNbEdge listError
                     else
                      case nbOfArrows of
                       0 -> parse l 0 x False
                             (word : listNode) listEdge listNbEdge listError
                       1 -> parse l 0 x False
                             listNode (word : listEdge) listNbEdge listError
                       2 -> parse l 0 x False
                             listNode listEdge (word : listNbEdge) listError
                       _ -> parse l 0 x False
                             listNode listEdge listNbEdge (word : listError)
      (ns, es, les, errs) = parse nwInput 0 [] True [] [] [] []
      in (reverse ns, reverse es, reverse les, reverse 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 fn ls =
    let ps = zip ls $ map fn ls
        (oks, errs) = partition (isJust . snd) ps
    in (map fst errs, mapMaybe snd 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 fn ls =
    let ps = zip ls $ map fn ls
        (errs, oks) = partition (null . snd) ps
    in (map fst errs, concatMap snd 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 lN allNodes = mapAndSplit
      (\ x -> find (\ (_, label) -> getDGNodeName label == x) allNodes) lN
  
  -- | Given an edge decides if it contains goals or not
  edgeContainsGoals :: LEdge DGLinkLab -> Bool
  edgeContainsGoals (_, _, l) = case thmLinkStatus $ dgl_type l of
       Just LeftOpen -> True
       _ -> False
  
  -- | Given an edge: does it contain an open conservativity goal or not
  isOpenConsEdge :: LEdge DGLinkLab -> Bool
  isOpenConsEdge (_, _, l) = hasOpenConsStatus False $ getEdgeConsStatus 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 lsN lsE = let
    -- function that returns the name of a node given its number
     nameOf x ls = case lookup x ls of
                    Nothing -> "Unknown node"
                    Just nlab -> getDGNodeName nlab
     ordFn (x1, x2, _) (y1, y2, _) = compare (x1, x2) (y1, y2)
     -- sorted and grouped list of edges
     edgs = groupBy ( \ x y -> ordFn x y == EQ) $ sortBy ordFn lsE
     in concatMap (\ l -> case l of
                               [el@(x, y, edgLab)] -> [(nameOf x lsN ++
                                            arrowLink edgLab ++
                                            nameOf y lsN, el)]
                               _ -> map (\ el@(x, y, edgLab) ->
                                     (nameOf x lsN ++
                                     arrowLink edgLab ++
                                       showEdgeId (dgl_id edgLab)
                                       ++ arrowLink edgLab
                                       ++ nameOf y lsN, el)) l) 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 lsEdge lsNbEdge allNodes allEdges = let
     {- function that searches through a list of nodes to
        find the node number for a given name. -}
         getNodeNb s ls =
            case find ( \ (_, label) ->
                          getDGNodeName label == s) ls of
             Nothing -> Nothing
             Just (nb, _) -> Just nb
          -- compute the list of all edges from source node to target
         l1 = concatMapAndSplit
              (\ nme -> case words nme of
                [src, _, tar] -> let
                  node1 = getNodeNb src allNodes
                  node2 = getNodeNb tar allNodes
                  in case node1 of
                  Nothing -> []
                  Just x ->
                   case node2 of
                   Nothing -> []
                   Just y ->
                    filter (\ (x1, y1, _) -> x == x1 && y == y1) allEdges
                _ -> error "CMDL.Utils.obtainEdgeList1"
              ) lsEdge
          -- compute the list of all numbered edges
         l2 = mapAndSplit
             (\ nme -> case words nme of
               [src, _, numb, _, tar] -> let
                 node1 = getNodeNb src allNodes
                 node2 = getNodeNb tar allNodes
                 mnb = readMaybe numb
                 in case node1 of
                 Nothing -> Nothing
                 Just x -> case node2 of
                  Nothing -> Nothing
                  Just y -> case mnb of
                   Nothing -> Nothing
                   Just nb -> let
                     ls = filter (\ (x1, y1, elab) -> x == x1 && y == y1 &&
                                     dgl_id elab == EdgeId nb) allEdges
                     in case ls of
                       [] -> Nothing
                       els : _ -> Just els
               _ -> error "CMDL.Utils.obtainEdgeList2") lsNbEdge
     in (fst l1 ++ fst l2, snd l1 ++ snd 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 ls1 ls2 ls3 ls4 =
      let (l1, l2) = obtainEdgeList ls1 ls2 ls3 ls4
      in (l1, filter edgeContainsGoals l2)
  
  {- | Function that given a string removes comments contained
     in the string -}
  stripComments :: String -> String
  stripComments input =
      let fn ls = case ls of
                  '#' : _ -> []
                  '%' : ll ->
                     case ll of
                      '%' : _ -> []
                      '{' : _ -> []
                      _ -> '%' : fn ll
                  [] -> []
                  l : ll -> l : fn ll
     in trim $ fn input
  
  -- | check if edges are to be completed in the presence of nodes
  finishedNames :: [String] -> String -> ([String], String)
  finishedNames ns i =
    let e@(fs, r) = fNames ns i in
    if not (null r) && any (isPrefixOf r) [localArr, globalArr] then
      case reverse fs of
      lt : ei : ar : sr : fr | elem ar [localArr, globalArr]
        -> (reverse fr, unwords [sr, ar, ei, lt, r])
      lt : fr -> (reverse fr, unwords [lt, r])
      _ -> e
    else e
  
  fNames :: [String] -> String -> ([String], String)
  fNames ns input = let i = trimLeft input in
    case filter (isJust . snd) $ zip ns
      $ map ((`stripPrefix` i) . (++ " ")) ns of
      (n, Just r) : _ -> let (fs, s) = fNames ns r in (n : fs, s)
      _ -> ([], 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 lPath ls cons = case ls of
      [] -> return cons
      x : l -> do
           -- check if current element is a directory
           b <- doesDirectoryExist (lPath </> x)
           fileFilter lPath l $ if b
             -- if it is,then add "/" to indicate is a folder
             then addTrailingPathSeparator x : cons
             {- if it is not a folder then it must be a file
                so check the extension -}
             else if elem (takeExtensions x) [".casl", ".het", ".dol" ]
                  then x : cons else 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 lPath ls cons = case ls of
      [] -> return cons
      x : l -> do
            -- check if current element is a directory
            let lPathx = lPath </> x
            b <- doesDirectoryExist lPathx
            if b then
              -- if it is a folder add its content
              do ll <- getDirectoryContents lPathx
                 nll <- fileFilter lPathx ll []
                 let nll' = map (x </>) nll
                 fileExtend lPath l (nll' ++ cons)
              -- if it is not then leave the file alone
              else fileExtend lPath l (x : 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 = drop 1
  
  safeLast :: a -> [a] -> a
  safeLast d l = if null l then d else last 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 = 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 = safeLast ""
  
  -- | The function nicely outputs a list of errors
  prettyPrintErrList :: [String] -> String
  prettyPrintErrList = intercalate "\n"
    . map (\ x -> "Input " ++ x ++ " could not be processed")
  