:{
annotate :: [String] -> Int -> Int -> Int -> String
annotate content row startcol endcol =
    let
        (toDrop, toTake) = calcRows row
        startRows = drop toDrop content
        markFile = map ("> " ++)
        rows = markFile (take toTake startRows) ++ ["% " ++ annotateRow] ++ markFile (take 1 (drop toTake startRows))
    in unlines rows
  where
    calcRows 1 = (0, 1)
    calcRows c = (c-2, 2)
    annotateRow
      | startcol == endcol = replicate (startcol - 1) ' ' ++ "^"
      | otherwise = replicate (startcol - 1) ' ' ++ "^" ++ replicate (endcol - startcol - 1) '~' ++ "^"

annotateFile :: [(String, [String])] -> String -> String
annotateFile fileStore args = do
  case words args of
    [filename,row,startcol,_,endcol] ->
        let
            file = snd . head . filter ((filename ==) . fst) $ fileStore
        in annotate file (read row) (read startcol) (read endcol)
    _ -> "malformed args"
:}

t1 <- readFile "T16804a.hs"
t2 <- readFile "T16804b.hs"
t3 <- readFile "T16804c.hs"

let fileStore = [("T16804a.hs", lines t1), ("T16804b.hs", lines t2), ("T16804c.hs", lines t3)]

:{
custom c s e =
    let
        cmd = c ++ " " ++ s ++ maybe "" (" " ++) e
    in do
          putStrLn ""
          putStrLn ("% executing: \"" ++ cmd ++ "\"")
          putStrLn ("% file snippet:")
          putStr (annotateFile fileStore s)
          putStrLn "% output:"
          return cmd
:}

let tp s = custom ":type-at" s (Just "undefined")
let up s = custom ":uses" s Nothing

:def tp tp
:def up up

:set +c
:l T16804a.hs T16804b.hs T16804c.hs

:tp T16804a.hs  1  8  1 14
:up T16804a.hs  1  8  1 14

:tp T16804a.hs  3  8  3 11
:tp T16804a.hs  3  8  3 18
:tp T16804a.hs  3 13  3 18

:up T16804a.hs  3  8  3 11
:up T16804a.hs  3  8  3 18
:up T16804a.hs  3 13  3 18

:tp T16804a.hs  5  6  5  9
:tp T16804a.hs  5 13  5 13
:tp T16804a.hs  5 15  5 15
:tp T16804a.hs  5 17  5 17
:tp T16804a.hs  6 13  6 16

:up T16804a.hs  5  6  5  9
:up T16804a.hs  5 13  5 13
:up T16804a.hs  5 15  5 15
:up T16804a.hs  5 17  5 17
:up T16804a.hs  6 13  6 16

:tp T16804a.hs  7 10  7 15 
:tp T16804a.hs  7 17  7 20
:tp T16804a.hs  7 10  7 20
:tp T16804a.hs  8  3  8  8
:tp T16804a.hs  8 12  8 12

:up T16804a.hs  7 10  7 15 
:up T16804a.hs  7 17  7 20
:up T16804a.hs  7 10  7 20
:up T16804a.hs  8  3  8  8
:up T16804a.hs  8 12  8 12

:tp T16804a.hs 12  1 12 12
:tp T16804a.hs 13  1 13 12
:tp T16804a.hs 13 14 13 14
:tp T16804a.hs 13 16 13 16
:tp T16804a.hs 15 16 15 16
:tp T16804a.hs 15 20 15 24

:up T16804a.hs 12  1 12 12
:up T16804a.hs 13  1 13 12
:up T16804a.hs 13 14 13 14
:up T16804a.hs 13 16 13 16
:up T16804a.hs 15 16 15 16
:up T16804a.hs 15 20 15 24

:tp T16804a.hs 18 15 18 18
:tp T16804a.hs 18 22 18 22

:up T16804a.hs 18 15 18 18
:up T16804a.hs 18 22 18 22

:tp T16804a.hs 22 13 22 18
:tp T16804a.hs 22 21 22 23
:tp T16804a.hs 22 25 22 25
:tp T16804a.hs 22 21 22 25
:tp T16804a.hs 22 27 22 28

:up T16804a.hs 22 13 22 18
:up T16804a.hs 22 21 22 23
:up T16804a.hs 22 25 22 25
:up T16804a.hs 22 21 22 25
:up T16804a.hs 22 27 22 28

:tp T16804a.hs 25 14 25 14
:tp T16804a.hs 25 16 25 17
:tp T16804a.hs 25 39 25 44

:up T16804a.hs 25 14 25 14
:up T16804a.hs 25 16 25 17
:up T16804a.hs 25 39 25 44

:tp T16804a.hs 28  3 28  3
:tp T16804a.hs 28  5 28  6
:tp T16804a.hs 28  8 28 10
:tp T16804a.hs 28 14 28 16
:tp T16804a.hs 29  3 29  3
:tp T16804a.hs 29  5 29  6
:tp T16804a.hs 29  8 29  8
:tp T16804a.hs 29 14 29 14

:up T16804a.hs 28  3 28  3
:up T16804a.hs 28  5 28  6
:up T16804a.hs 28  8 28 10
:up T16804a.hs 28 14 28 16
:up T16804a.hs 29  3 29  3
:up T16804a.hs 29  5 29  6
:up T16804a.hs 29  8 29  8
:up T16804a.hs 29 14 29 14

:tp T16804b.hs 7 10 7 21
:tp T16804b.hs 7 10 7 23
:tp T16804b.hs 7 10 7 25
:tp T16804b.hs 7 23 7 23

:up T16804b.hs 7 10 7 21
:up T16804b.hs 7 10 7 25
:up T16804b.hs 7 23 7 23

:tp T16804b.hs 8 10 8 22
:tp T16804b.hs 8 10 8 27

:tp T16804b.hs 10 9 10 17
:up T16804b.hs 10 9 10 17

:up T16804c.hs 5 1 5 1
:up T16804c.hs 6 1 6 1

:up T16804c.hs 9 12 9 14
:up T16804c.hs 9 31 9 31
:up T16804c.hs 9 33 9 35

:up T16804c.hs 12 13 12 13
:up T16804c.hs 12 32 12 32

:up T16804c.hs 15 13 15 13
:up T16804c.hs 15 30 15 30