fork download
  1. data ZipList a = ZL [a] a [a] deriving (Eq, Show)
  2.  
  3. test :: ZipList Int
  4. test = ZL [3,2,1] 4 [5,6,7]
  5.  
  6. -- Create a new empty list and make e the default item that is
  7. newZipList :: a -> ZipList a
  8. newZipList x = ZL [] x []
  9.  
  10. -- Returns true if only one item present
  11. -- i.e. the left and right lists are empty
  12. isSingleton :: ZipList a -> Bool
  13. isSingleton (ZL [] _ []) = True
  14. isSingleton _ = False
  15.  
  16. -- Move the current item one place forwards in the list
  17. after :: ZipList a -> ZipList a
  18. after (ZL ls x []) = ZL ls x [] -- Can't go any further right
  19. after (ZL ls x (r:rs)) = ZL (x:ls) r rs
  20.  
  21. -- Move the current item one place backwards in the list
  22. before :: ZipList a -> ZipList a
  23. before (ZL [] x rs) = ZL [] x rs -- Can't go any further left
  24. before (ZL (l:ls) x rs) = ZL ls l (x:rs)
  25.  
  26. -- Get the current item
  27. get :: ZipList a -> a
  28. get (ZL _ x _) = x
  29.  
  30. -- Replace the current item
  31. set :: a -> ZipList a -> ZipList a
  32. set y (ZL ls x rs) = ZL ls y rs
  33.  
  34. -- Inserts an item after the current item and makes it the current item
  35. insertAfter :: a -> ZipList a -> ZipList a
  36. insertAfter y (ZL ls x rs) = ZL (x:ls) y rs
  37.  
  38. -- Inserts an item before the current item and makes it the current item
  39. insertBefore :: a -> ZipList a -> ZipList a
  40. insertBefore y (ZL ls x rs) = ZL ls y (x:rs)
  41.  
  42. -- Delete the current item and make its successor the current item.
  43. -- If deleteToAfter is called while there is only one item left,
  44. -- keep the zip list the same (there must always be at least one item).
  45. -- If deleteToAfter is called while there are no successors, but there
  46. -- is at least one predecessor, delete the current item and make the
  47. -- predecessor the current item.
  48. deleteToAfter :: ZipList a -> ZipList a
  49. deleteToAfter (ZL [] x []) = ZL [] x [] -- Not allowed to delete last element, must have at least one
  50. deleteToAfter (ZL (l:ls) x []) = ZL ls l []
  51. deleteToAfter (ZL ls x (r:rs)) = ZL ls r rs
  52.  
  53. -- Delete the current item and make its predecessor the current item.
  54. -- If deleteToBefore is called while there is only one item left,
  55. -- keep the zip list the same (there must always be at least one item).
  56. -- If deleteToAfter is called while there are no predecessors, but there
  57. -- is at least one successor, delete the current item and make the
  58. -- successor the current item.
  59. deleteToBefore :: ZipList a -> ZipList a
  60. deleteToBefore (ZL [] x []) = ZL [] x [] -- Not allowed to delete last element, must have at least one
  61. deleteToBefore (ZL (l:ls) x rs) = ZL ls l rs
  62. deleteToBefore (ZL [] x (r:rs)) = ZL [] r rs
  63.  
  64. -- Set the current item to the first item
  65. firstZ :: ZipList a -> ZipList a
  66. firstZ (ZL [] x rs) = ZL [] x rs
  67. firstZ (ZL (l:ls) x rs) = firstZ (ZL ls l (x:rs))
  68.  
  69. -- Set the current item to the last item
  70. lastZ :: ZipList a -> ZipList a
  71. lastZ (ZL ls x []) = ZL ls x []
  72. lastZ (ZL ls x (r:rs)) = lastZ (ZL (x:ls) r rs)
  73.  
  74. -- Pretty printing
  75.  
  76. data ZipElem a = Focus a | NotFocus a
  77.  
  78. instance Show a => Show (ZipElem a) where
  79. show (Focus x) = "(" ++ show x ++ ")"
  80. show (NotFocus x) = " " ++ show x ++ " "
  81.  
  82. pretty :: Show a => ZipList a -> String
  83. pretty (ZL ls x rs) = show $ map NotFocus (reverse ls) ++ [Focus x] ++ map NotFocus rs
  84.  
  85. prettyPrint :: Show a => ZipList a -> IO ()
  86. prettyPrint = putStrLn . pretty
Compilation error #stdin compilation error #stdout 0s 0KB
stdin
Standard input is empty
compilation info
prog.c:1:1: error: unknown type name ‘data’
 data ZipList a = ZL [a] a [a] deriving (Eq, Show)
 ^~~~
prog.c:1:14: error: expected ‘=’, ‘,’, ‘;’, ‘asm’ or ‘__attribute__’ before ‘a’
 data ZipList a = ZL [a] a [a] deriving (Eq, Show)
              ^
prog.c:18:43: warning: missing terminating ' character
 after (ZL ls x [])     = ZL ls x [] -- Can't go any further right
                                           ^
prog.c:18:43: error: missing terminating ' character
 after (ZL ls x [])     = ZL ls x [] -- Can't go any further right
                                           ^~~~~~~~~~~~~~~~~~~~~~~
prog.c:23:44: warning: missing terminating ' character
 before (ZL [] x rs)     = ZL [] x rs -- Can't go any further left
                                            ^
prog.c:23:44: error: missing terminating ' character
 before (ZL [] x rs)     = ZL [] x rs -- Can't go any further left
                                            ^~~~~~~~~~~~~~~~~~~~~~
stdout
Standard output is empty