fix x-partial errors

src/Modelling/StateDiagram/Generate.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-error=x-partial -Wno-error=deprecations #-}
+{-# OPTIONS_GHC -Wno-error=deprecations #-}
 {-# LANGUAGE LambdaCase, RecordWildCards #-}
 
 module Modelling.StateDiagram.Generate (randomSD) where
@@ -70,10 +70,10 @@ checkParallelRegion [_] _ _ = True
 checkParallelRegion _ [_] _ = True
 checkParallelRegion [_,_] _ _ = True
 checkParallelRegion _ [_,_] _ = True
-checkParallelRegion (x:xs) (y:ys) subs
-  = case (x == y, all (isNotCD x) subs) of
-     (True, True) -> checkParallelRegion xs ys (getSubstates x subs)
-     (True, False) -> head xs == head ys && checkParallelRegion xs ys (getSubstates x subs)
+checkParallelRegion (x1:x2:xs) (y1:y2:ys) subs
+  = case (x1 == y1, all (isNotCD x1) subs) of
+     (True, True) -> checkParallelRegion (x2:xs) (y2:ys) (getSubstates x1 subs)
+     (True, False) -> x2 == y2 && checkParallelRegion (x2:xs) (y2:ys) (getSubstates x1 subs)
      (False, _) -> True
 
 --haveForkOrJoin:: StateDiagram n Int [Connection Int] -> Bool
@@ -239,8 +239,8 @@ randomSD' outermost c cdMaxNum leastTwoLevels ns alphabet (l,nm,mustCD) exclude
     start
 
 randomInnerSD :: Int -> Int -> [Int] -> [String] -> (Int,NodeType,[String],Bool) -> [String]-> Gen (StateDiagram String Int [Connection Int])
-randomInnerSD counter cdMaxNum ns alphabet (l,t,s,mustCD) exclude = do
-  let nm = head s
+randomInnerSD _ _ _ _ (_,_,[],_) _ = error "randomInnerSD: empty name list"
+randomInnerSD counter cdMaxNum ns alphabet (l,t,s@(nm:_),mustCD) exclude = do
   case t of
        Hist  -> frequency [(1,return (History l Shallow)),(1,return (History l Deep))]
        End   -> return (EndState l)

src/Modelling/StateDiagram/Instance.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -Wno-error=x-partial -Wwarn=incomplete-patterns #-}
+{-# OPTIONS_GHC -Wwarn=incomplete-patterns #-}
 module Modelling.StateDiagram.Instance (
   parseInstance,
   failWith
@@ -158,7 +158,10 @@ Get path to element in the forest. Assumes there is just one such element.
 Fails if the element does not exist within the forest.
 -}
 getPathTo :: Eq a => Forest (a, b) -> a -> b
-getPathTo x = head . catMaybes . getPathsTo x
+getPathTo x y =
+  case catMaybes (getPathsTo x y) of
+    (p:_) -> p
+    []    -> error "getPathTo: element not found in forest"
 
 getPathsTo :: Eq a => Forest (a, b) -> a -> [Maybe b]
 getPathsTo []        _ = []
@@ -197,19 +200,12 @@ forestToStateDiagram
   -> StateDiagram String Int ()
 forestToStateDiagram getName getStart ts = StateDiagram {
   label = 1,
-  substates = treeToStateDiagram getName (stail . getStart) <$> ts,
+  substates = treeToStateDiagram getName (drop 1 . getStart) <$> ts,
   name = "",
   connections = (), -- TODO
   startState = getStart Nothing
   }
 
-{-|
-Like 'tail', but never trying to shorten the empty list.
--}
-stail :: [a] -> [a]
-stail [] = []
-stail xs = tail xs
-
 treeToStateDiagram
   :: (Node -> String)
   -> (Maybe Node -> [Int])
@@ -243,7 +239,7 @@ treeToStateDiagram getName getStart n = case node of
     l = last $ snd root
     root = rootLabel n
     node = fst root
-    fromTree = treeToStateDiagram getName (stail . getStart)
+    fromTree = treeToStateDiagram getName (drop 1 . getStart)
 
 {-|
 Transforms a mapping of containments into a tree structure.

src/Modelling/StateDiagram/Layout.hs

@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -Wno-error=x-partial #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Modelling.StateDiagram.Layout
@@ -12,7 +11,9 @@ import Diagrams.Backend.SVG.CmdLine
 import qualified Data.Map as Map
 import Data.Graph
 import Data.Tree
+import Data.List (find)
 import Data.List.Index
+import Data.Maybe (fromMaybe)
 import Modelling.StateDiagram.Arrows
 import Modelling.StateDiagram.Support
 import Modelling.StateDiagram.Style (Styling(..))
@@ -122,12 +123,19 @@ drawWrapper _ a (Transition b c l rightType layouts) = appendEdges
   layouts # named (a ++ [b])
   where
     x = drawText c black
-drawWrapper style a s@AndDecomposition {} = appendEdges (roundedRect (width f) (height f) 0.1 # lc (hashToColour style (head (dropWhile null (map strings (component s)) ++ [""])))
-  <> f) (lengthXY s) (rightC s) (outerLayout s) # named (a ++
-  [key s])
+drawWrapper style a s@AndDecomposition {} =
+  appendEdges
+    (roundedRect (width f) (height f) 0.1
+      # lc (hashToColour style (fromMaybe "" (find (not . null) (map strings (component s)))))
+      <> f)
+    (lengthXY s) (rightC s) (outerLayout s) # named (a ++ [key s])
   where
-    w = maximum (fmap (width . drawWrapper style (a ++ [key s])) (component s))
-    h = maximum (fmap (height . drawWrapper style (a ++ [key s])) (component s))
+    w = case fmap (width . drawWrapper style (a ++ [key s])) (component s) of
+          [] -> error "drawWrapper AndDecomposition: empty component"
+          xs -> maximum xs
+    h = case fmap (height . drawWrapper style (a ++ [key s])) (component s) of
+          [] -> error "drawWrapper AndDecomposition: empty component"
+          xs -> maximum xs
     d = (vcat . fmap alignL) (drawSwimlane False (fmap (drawWrapper' style (a ++ [key
       s])) (component s)) w) # centerXY
     e = (hcat . fmap alignT) (drawSwimlane True (fmap (drawWrapper' style (a ++ [key
@@ -230,7 +238,9 @@ toWrapper s@StateDiagram {} = OrDecomposition toWrapper' (label s) (name s)
     newConnection = if null (startState s) then connections s
       else Connection [-1] (startState s) "" : connections s
     convertedConnection = changeConnectionType newConnection toWrapper' []
-    maxKey = maximum (Map.keys $ mapWithLabel $ substates s)
+    maxKey = case Map.keys (mapWithLabel $ substates s) of
+      [] -> error "toWrapper: empty substates"
+      ks -> maximum ks
 
 createGraph :: Map.Map Int [Int] -> [StateDiagram String Int [Connection Int]] -> [(StateDiagram String Int [Connection Int],
   Int, [Int])] -> (Graph, Vertex -> (StateDiagram String Int [Connection Int], Int, [Int]), Int -> Maybe
@@ -265,7 +275,9 @@ placeStartState [[a]] _ = [StartS (-1) 0 NoConnection Unspecified] : [[a]]
 placeStartState originalW ss =  modifyAt layerToInsert (++ [StartS (-1) 0
   NoConnection Unspecified]) originalW
   where
-    ssLayer = findLayer (head ss) originalW 0
+    ssLayer = case ss of
+      h:_ -> findLayer h originalW 0
+      []  -> error "placeStartState: empty startState list"
     layerToInsert = if ssLayer == (length originalW -1) then ssLayer - 1 else
       ssLayer + 1
 
@@ -302,12 +314,13 @@ addD :: ConnectionType -> Int -> [Int] -> [[Wrapper]] -> ConnectWithType ->
 addD a maxKey [_, _] withDummy c@ConnectWithType {} withConnect = (withDummy,
   maxKey, withConnect ++ [ConnectWithType (Connection [maxKey] (pointTo $
   connecting c) (transition $ connecting c)) a])
-addD a maxKey (_:xs) withDummy c@ConnectWithType {} [] =
-  addD a (maxKey + 1) xs (modifyAt (head xs) (\ x -> x ++ [Dummy (maxKey + 1)
+addD a maxKey (_:x1:xs) withDummy c@ConnectWithType {} [] =
+  addD a (maxKey + 1) (x1:xs) (modifyAt x1 (\ x -> x ++ [Dummy (maxKey + 1)
   Unspecified 0.1]) withDummy) c [ConnectWithType (Connection (pointFrom
   $ connecting c) [maxKey + 1] "") (betweenConnection a)]
-addD a maxKey (_:xs) withDummy c@ConnectWithType {} withConnect =
-  addD a (maxKey + 1) xs (modifyAt (head xs) (\ x -> x ++ [Dummy (maxKey + 1)
+addD _ _ [_] _ _ _ = error "addD: single element list - insufficient layers"
+addD a maxKey (_:x1:xs) withDummy c@ConnectWithType {} withConnect =
+  addD a (maxKey + 1) (x1:xs) (modifyAt x1 (\ x -> x ++ [Dummy (maxKey + 1)
   Unspecified 0.1]) withDummy) c (withConnect ++ [ConnectWithType (
   Connection [maxKey] [maxKey + 1] "") (betweenConnection a)])
 addD _ _ _ _ _ _ = ([], 0, [])
@@ -380,8 +393,12 @@ addTransitionStates maxKey transitionLayer originalLayer (x:xs) newConnection =
           addTransitionStates k (modifyAt endLayer addState transitionLayer)
           originalLayer xs (newConnection ++ type2)
   where
-    startLayer = findLayer (head $ pointFrom $ connecting x) originalLayer 0
-    endLayer = findLayer (head $ pointTo $ connecting x) originalLayer 0
+    startLayer = case pointFrom (connecting x) of
+      h:_ -> findLayer h originalLayer 0
+      []  -> error "addTransitionStates: empty pointFrom"
+    endLayer = case pointTo (connecting x) of
+      h:_ -> findLayer h originalLayer 0
+      []  -> error "addTransitionStates: empty pointTo"
     startLabel = pointFrom $ connecting x
     endLabel = pointTo $ connecting x
     connectName = transition (connecting x)
@@ -417,16 +434,18 @@ connectionsByLayers (x:xs) layers connectionLayers =
 startStateFirst :: StateDiagram String Int [Connection Int] -> [Int] -> StateDiagram String Int [Connection Int]
 startStateFirst a [] = a
 startStateFirst a@StateDiagram {} (x:xs) =
-  StateDiagram (loopOrder : tail newOrder) (label a) (name a) (connections a)
-  (startState a)
-  where
-    newOrder = moveToFirst (substates a) x []
-    loopOrder = startStateFirst (head newOrder) xs
+  case moveToFirst (substates a) x [] of
+    h:ts ->
+      let loopOrder = startStateFirst h xs
+      in StateDiagram (loopOrder : ts) (label a) (name a) (connections a)
+        (startState a)
+    [] -> error "startStateFirst: target startState not found"
 startStateFirst a@CombineDiagram {} (x:xs) =
-  CombineDiagram (loopOrder : tail newOrder) (label a)
-  where
-    newOrder = moveToFirst (substates a) x []
-    loopOrder = startStateFirst (head newOrder) xs
+  case moveToFirst (substates a) x [] of
+    h:ts ->
+      let loopOrder = startStateFirst h xs
+      in CombineDiagram (loopOrder : ts) (label a)
+    [] -> error "startStateFirst: target startState not found"
 startStateFirst a _ = a
 
 rearrangeSubstates :: StateDiagram String Int [Connection Int] -> StateDiagram String Int [Connection Int]
@@ -581,8 +600,12 @@ addCrossSuperStateDummy a b = case (pointFrom $ connecting b, pointTo $
          ForwardWH startPoint [ConnectWithType (Connection pointFromLabel
          pointToLabel connectionName) SelfCL] a)
   where
-    startLayer = findLayer (head $ pointFrom $ connecting b) (layered a) 0
-    endLayer = findLayer (head $ pointTo $ connecting b) (layered a) 0
+    startLayer = case pointFrom (connecting b) of
+      h:_ -> findLayer h (layered a) 0
+      []  -> error "addCrossSuperStateDummy: empty pointFrom"
+    endLayer = case pointTo (connecting b) of
+      h:_ -> findLayer h (layered a) 0
+      []  -> error "addCrossSuperStateDummy: empty pointTo"
     startPoint = pointFrom $ connecting b
     endPoint = pointTo $ connecting b
     connectionName = transition $ connecting b
@@ -678,23 +701,35 @@ csdWidth :: Double
 csdWidth = 0.05
 
 insertDummyLeft :: Wrapper  -> [[Wrapper]]
-insertDummyLeft a = if all checkWrapperLayer (head $ layered a) then
-  (CrossStateDummy (maxLabel a + 1) csdWidth : head (layered a)) : tail (layered a)
-  else [CrossStateDummy (maxLabel a + 1) csdWidth] : layered a
+insertDummyLeft a = case layered a of
+  first:rest ->
+    if all checkWrapperLayer first
+    then (CrossStateDummy (maxLabel a + 1) csdWidth : first) : rest
+    else [CrossStateDummy (maxLabel a + 1) csdWidth] : layered a
+  [] -> error "insertDummyLeft: layered is empty"
 
 insertDummyRight :: Wrapper -> [[Wrapper]]
-insertDummyRight a = if all checkWrapperLayer (last $ layered a) then init (
-  layered a) ++ [last (layered a) ++ [CrossStateDummy (maxLabel a + 1) csdWidth]] else
-  layered a ++ [[CrossStateDummy (maxLabel a + 1) csdWidth]]
+insertDummyRight a = case reverse (layered a) of
+  lastPart:restRev ->
+    let initPart = reverse restRev
+        dummy = CrossStateDummy (maxLabel a + 1) csdWidth
+    in if all checkWrapperLayer lastPart
+         then initPart ++ [lastPart ++ [dummy]]
+         else reverse (lastPart:restRev) ++ [[dummy]]
+  [] -> error "insertDummyRight: layered is empty"
 
 changeConnectionType :: [Connection Int] -> [[Wrapper]] -> [ConnectWithType]
   -> [ConnectWithType]
 changeConnectionType [] _ withType = withType
 changeConnectionType (x:xs) layers withType = changeConnectionType xs layers
   (withType ++ [ConnectWithType x decideType])
   where
-    startLayer = findLayer (head $ pointFrom x) layers 0
-    endLayer = findLayer (head $ pointTo x) layers 0
+    startLayer = case pointFrom x of
+      h:_ -> findLayer h layers 0
+      []  -> error "changeConnectionType: empty pointFrom"
+    endLayer = case pointTo x of
+      h:_ -> findLayer h layers 0
+      []  -> error "changeConnectionType: empty pointTo"
     decideType = decideConnectionType startLayer endLayer
 
 changeRightConnection :: Wrapper -> RightConnect -> Wrapper
@@ -744,8 +779,12 @@ markRightConnection a b = OrDecomposition (layered afterChange) (key a) (strings
   (typedConnections a ++ [ConnectWithType (connecting b) decideConnectType]) (layout
   a) (maxLabel a) (lengthXY a) (rightC a) (outerLayout a)
   where
-    startLayer = findLayer (head (pointFrom $ connecting b)) (layered a) 0
-    endLayer = findLayer (head (pointTo $ connecting b)) (layered a) 0
+    startLayer = case pointFrom (connecting b) of
+      h:_ -> findLayer h (layered a) 0
+      []  -> error "markRightConnection: empty pointFrom"
+    endLayer = case pointTo (connecting b) of
+      h:_ -> findLayer h (layered a) 0
+      []  -> error "markRightConnection: empty pointTo"
     stateToModify = if startLayer < endLayer then pointFrom $ connecting b else
       pointTo $ connecting b
     afterChange = changeRightConnections stateToModify (key a) (if connectType

src/Modelling/StateDiagram/Support.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-error=x-partial #-}
-
 module Modelling.StateDiagram.Support where
 import Modelling.StateDiagram.Datatype
 import Data.Graph
@@ -16,14 +14,14 @@ betweenConnection _ = ForwardH
 
 buildEmptyWrapperByLayer :: [[Wrapper]] -> [[Wrapper]] -> [[Wrapper]]
 buildEmptyWrapperByLayer [_, _] list = list ++ [[]]
-buildEmptyWrapperByLayer xs list = buildEmptyWrapperByLayer (tail xs)
-  (list ++ [[]])
+buildEmptyWrapperByLayer (_:xs) list = buildEmptyWrapperByLayer xs (list ++ [[]])
+buildEmptyWrapperByLayer [] _ = error "buildEmptyWrapperByLayer: insufficient layers"
 
 buildEmptyConnectionByLayer :: [[Wrapper]] -> [[ConnectWithType]] ->
   [[ConnectWithType]]
 buildEmptyConnectionByLayer [_, _] list = list ++ [[]]
-buildEmptyConnectionByLayer xs list = buildEmptyConnectionByLayer (tail xs)
-  (list ++ [[]])
+buildEmptyConnectionByLayer (_:xs) list = buildEmptyConnectionByLayer xs (list ++ [[]])
+buildEmptyConnectionByLayer [] _ = error "buildEmptyConnectionByLayer: insufficient layers"
 
 checkWrapperLayer :: Wrapper -> Bool
 checkWrapperLayer StartS {} = True
@@ -88,9 +86,11 @@ findLayer num (x:xs) layer
 
 getCompareList :: Bool -> Wrapper -> [[Int]]
 getCompareList checkType wrapper = case wrapper of
-  OrDecomposition {} -> if checkType then fmap ((\ a -> key wrapper : [a]) . key)
-    (head $ layered wrapper) else fmap ((\ a -> key wrapper : [a]) . key)
-    (last $ layered wrapper)
+  OrDecomposition {} -> case layered wrapper of
+    [] -> error "getCompareList: empty layered"
+    layers@(l:_) ->
+      let pick = if checkType then l else last layers
+      in fmap ((\ a -> key wrapper : [a]) . key) pick
   AndDecomposition {} -> fmap (key wrapper :) (concatMap (getCompareList checkType)
     (component wrapper))
   _ -> []
@@ -103,13 +103,16 @@ getConnection a = fmap (\ (ConnectWithType x y) -> ((a ++ pointFrom x, a ++
 getConnectionWithLayerBefore2 :: Wrapper -> [ConnectWithType] -> [[Int]] -> [[Int]]
 getConnectionWithLayerBefore2 _ [] connected = connected
 getConnectionWithLayerBefore2 wrapper (x:xs) connected
-  | head (pointFrom y) == key wrapper = getConnectionWithLayerBefore2 wrapper xs
+  | startsWithWrapper (pointFrom y) = getConnectionWithLayerBefore2 wrapper xs
       (connected ++ [pointTo y])
-  | head (pointTo y) == key wrapper = getConnectionWithLayerBefore2 wrapper xs
+  | startsWithWrapper (pointTo y) = getConnectionWithLayerBefore2 wrapper xs
       (connected ++ [pointFrom y])
   | otherwise = getConnectionWithLayerBefore2 wrapper xs connected
   where
     y = connecting x
+    startsWithWrapper z = case z of
+      h:_ -> h == key wrapper
+      []  -> error "getConnectionWithLayerBefore2: empty point list"
 
 getConnectionWithLayerBefore3 :: [Int] -> [ConnectWithType] -> [[Int]] -> [[Int]]
 getConnectionWithLayerBefore3 _ [] connected = connected
@@ -143,14 +146,18 @@ getDeeperLevelL ([a], [b]) commonValue layersBef = higherIndex (a, b) (fmap key
   newLayerBef)
   where
       newState = returnState layersBef commonValue
-      newLayerBef = last $ layered newState
+      newLayerBef = case layered newState of
+        [] -> error "getDeeperLevelL: empty layered"
+        xs -> last xs
 getDeeperLevelL ([a, as], [b, bs]) commonValue layersBef = if a /= b then
   higherIndex (a, b) (fmap key (component newState)) else higherIndex (as, bs)
   newAndLayerBef
   where
     newState = returnState layersBef commonValue
     newState' = returnState (component newState) a
-    newAndLayerBef = fmap key (last (layered newState'))
+    newAndLayerBef = case layered newState' of
+      [] -> error "getDeeperLevelL: empty layered (nested)"
+      xs -> fmap key (last xs)
 getDeeperLevelL _ _ _ = 0
 -- jscpd:ignore-end
 
@@ -159,14 +166,18 @@ getDeeperLevelR ([a], [b]) commonValue layersBef = higherIndex (a, b) (fmap key
   newLayerBef)
   where
       newState = returnState layersBef commonValue
-      newLayerBef = head $ layered newState
+      newLayerBef = case layered newState of
+        [] -> error "getDeeperLevelR: empty layered"
+        (x:_) -> x
 getDeeperLevelR ([a, as], [b, bs]) commonValue layersBef = if a /= b then
   higherIndex (a, b) (fmap key (component newState)) else higherIndex (as, bs)
   newAndLayerBef
   where
     newState = returnState layersBef commonValue
     newState' = returnState (component newState) a
-    newAndLayerBef = fmap key (head (layered newState'))
+    newAndLayerBef = case layered newState' of
+      [] -> error "getDeeperLevelR: empty layered (nested)"
+      (x:_) -> fmap key x
 getDeeperLevelR _ _ _ = 0
 
 getFirstFromTuple3 :: (a, b, c) -> a
@@ -213,8 +224,9 @@ mapWithLabel a = Map.fromList (fmap (\ x -> (label x, x)) a)
 
 mapWithConnection :: Ord a => [Connection a] -> Map.Map a [a]
 mapWithConnection
-  = foldl (\ a x -> Map.insertWith (++) (head (pointFrom x)) (pointTo x) a)
-    Map.empty
+  = foldl (\ a x -> case pointFrom x of
+                      h:_ -> Map.insertWith (++) h (pointTo x) a
+                      []  -> error "mapWithConnection: empty pointFrom") Map.empty
 
 mapWithConnection' :: [StateDiagram n Int [Connection Int]] -> Map.Map Int [Int] -> Map.Map Int
   [Int]