1 files changed, 108 insertions, 0 deletions
diff --git a/tlon.io/exercise.hs b/tlon.io/exercise.hs
new file mode 100755
index 0000000..f60c342
--- /dev/null
+++ b/tlon.io/exercise.hs
@@ -0,0 +1,108 @@
+#!/usr/bin/env stack
+-- stack --nix --resolver lts-11.7 script
+
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+import Data.List
+import Control.Monad
+import Control.Exception (assert)
+
+type Coords a = (a, a) -- ^ (line, column)
+
+
+-- Extend ordinal operations to both numbers
+instance {-# OVERLAPPING #-} Ord (Coords Int) where
+  a < b = (fst a) < (fst b) && (snd a) < (snd b)
+  a <= b = (fst a) <= (fst b) && (snd a) <= (snd b)
+  a > b = (fst a) > (fst b) && (snd a) > (snd b)
+  a >= b = (fst a) >= (fst b) && (snd a) >= (snd b)
+
+-- | A single stack trace element
+data St = St
+  { start :: Coords Int
+  , end :: Coords Int
+  } deriving (Eq, Show)
+
+
+-- | We have two types of operations on the stacktrace
+data OpType
+  = Jumppoint -- ^ It's a jump point if it moves outside the previous scope
+  | Descending -- ^ We are descending if the scope in th 'St' is narrowing
+  deriving (Show, Eq)
+
+-- | To detect the 'OpType', we need the current and next thing in the
+-- stacktrace.
+detect' :: St -> St -> (St, OpType)
+detect' a b
+  | (end a) == (end b) = (a, Descending)
+  | (start a) < (start b) && (end a) >= (end b) = (a, Descending) -- If a wraps around b, we are still descending
+  | otherwise = (a, Jumppoint)
+
+detect :: [St] -> [(St, OpType)]
+detect [] = error "empty list"
+detect [a] = error "not enough elements"
+detect [a, b] = [detect' a b]
+detect (a:b:rest) = detect' a b : (detect $ b:rest)
+
+prune :: [(St, OpType)] -> [(St, OpType)]
+prune ls = filter (\(_, opType) -> opType == Jumppoint) ls
+
+main = do
+  putStrLn $ assert ([(head ex2, Jumppoint)] == detect ex2) "Jumppoint test passes"
+  putStrLn $ assert ([(head ex3, Descending)] == detect ex3) "Descending test passes"
+  putStrLn "Pruning:"
+  print $ map show $ prune $ detect ex1
+
+
+-- Examples
+
+{- Example
+1 |
+2 |
+3 |main = do
+4 |  x <- someFunc 10
+5 |  y <- someOtherfunc 53
+6 |  putStrLn (show x <> show y)
+8 |
+9 |someFunc x = x
+10|
+11|someOtherfunc y = y
+12|
+13|
+-}
+ex1 :: [St]
+ex1 =
+    [ St { start = (3, 1),   end = (6, 29)  } -- Descending : main
+    , St { start = (3, 7),   end = (6, 29)  } -- Descending : do
+    , St { start = (4, 2),   end = (4, 18)  } -- Jumppoint  : x <- someFunc 10
+    , St { start = (9, 0),   end = (9, 14)  } -- Jumppoint  : someFunc 10
+    , St { start = (5, 2),   end = (5, 18)  } -- Jumppoint  : y <- someOtherfunc 53
+    , St { start = (11, 0),  end = (11, 19) } -- Jumppoint  : someOtherfunc 53
+    , St { start = (6, 2),   end = (6, 29)  } -- Descending : putStrLn
+    , St { start = (6, 11),  end = (6, 29)  } -- Descending : (show x <> show y)
+    , St { start = (6, 12),  end = (6, 18)  } -- Jumppoint  : show x
+    , St { start = (6, 22),  end = (6, 28)  } -- Jumppoint  : show y
+    ]
+
+{- Jumppoint example
+1 |(func1 arg)
+2 |
+3 |func1 a = undefined
+-}
+ex2 :: [St]
+ex2 =
+  [ St { start = (1, 0), end = (1, 10) }
+  , St { start = (3, 0), end = (3, 20) }
+  ]
+
+{- Descending example
+1|(func1
+2|  (func2 arg))
+3|
+-}
+ex3 :: [St]
+ex3 =
+  [ St { start = (1, 1), end = (2, 14) }
+  , St { start = (2, 3), end = (2, 14) }
+  ]