~ubuntu-branches/ubuntu/wily/agda/wily-proposed

« back to all changes in this revision

Viewing changes to src/full/Agda/Interaction/Highlighting/Vim.hs

  • Committer: Package Import Robot
  • Author(s): Iain Lane, d5cf60f
  • Date: 2015-05-20 13:08:33 UTC
  • mfrom: (1.1.7)
  • Revision ID: package-import@ubuntu.com-20150520130833-cdcmhagwsouna237
Tags: 2.4.2.2-2
[d5cf60f] Depend on ${shlibs:Depends}, to get libc (& maybe other) deps

Show diffs side-by-side

added added

removed removed

Lines of Context:
22
22
vimFile :: FilePath -> FilePath
23
23
vimFile file =
24
24
    case splitFileName file of
25
 
        (path, name) -> path </> "" <.> name <.> "vim"
 
25
        (path, name) -> path </> "" <.> name <.> "vim"
26
26
 
27
27
escape :: String -> String
28
28
escape = concatMap esc
29
29
    where
30
 
        escchars = "$\\^.*~[]"
31
 
        esc c   | c `elem` escchars = ['\\',c]
32
 
                | otherwise         = [c]
 
30
        escchars = "$\\^.*~[]"
 
31
        esc c   | c `elem` escchars = ['\\',c]
 
32
                | otherwise         = [c]
33
33
 
34
34
wordBounded :: String -> String
35
35
wordBounded s0 = concat ["\\<", s0, "\\>"]
36
36
 
37
37
keyword :: String -> [String] -> String
38
38
keyword _ [] = ""
39
 
keyword cat ws  = "syn keyword " ++ unwords (cat : ws)
 
39
keyword cat ws  = "syn keyword " ++ unwords (cat : ws)
40
40
 
41
41
match :: String -> [String] -> String
42
42
match _ [] = ""
43
 
match cat ws    = "syn match " ++ cat ++ " \"" ++
44
 
                    concat (List.intersperse "\\|" $ map (wordBounded . escape) ws) ++ "\""
 
43
match cat ws    = "syn match " ++ cat ++ " \"" ++
 
44
                    concat (List.intersperse "\\|" $ map (wordBounded . escape) ws) ++ "\""
45
45
 
46
46
matches :: [String] -> [String] -> [String] -> [String] -> [String] -> [String] -> [String]
47
47
matches cons icons defs idefs flds iflds =
49
49
    $ List.sortBy (compare `on` fst)
50
50
    $ cons' ++ defs' ++ icons' ++ idefs'
51
51
    where
52
 
        cons'  = foo "agdaConstructor"      $ classify length cons
53
 
        icons' = foo "agdaInfixConstructor" $ classify length icons
54
 
        defs'  = foo "agdaFunction"         $ classify length defs
55
 
        idefs' = foo "agdaInfixFunction"    $ classify length idefs
56
 
        flds'  = foo "agdaProjection"       $ classify length flds
57
 
        iflds' = foo "agdaInfixProjection"  $ classify length iflds
58
 
 
59
 
        classify f = List.groupBy ((==) `on` f)
60
 
                     . List.sortBy (compare `on` f)
61
 
 
62
 
        foo :: String -> [[String]] -> [(Int, String)]
63
 
        foo cat = map (length . head /\ match cat)
 
52
        cons'  = foo "agdaConstructor"      $ classify length cons
 
53
        icons' = foo "agdaInfixConstructor" $ classify length icons
 
54
        defs'  = foo "agdaFunction"         $ classify length defs
 
55
        idefs' = foo "agdaInfixFunction"    $ classify length idefs
 
56
        flds'  = foo "agdaProjection"       $ classify length flds
 
57
        iflds' = foo "agdaInfixProjection"  $ classify length iflds
 
58
 
 
59
        classify f = List.groupBy ((==) `on` f)
 
60
                     . List.sortBy (compare `on` f)
 
61
 
 
62
        foo :: String -> [[String]] -> [(Int, String)]
 
63
        foo cat = map (length . head /\ match cat)
64
64
 
65
65
toVim :: NamesInScope -> String
66
66
toVim ns = unlines $ matches mcons micons mdefs midefs mflds miflds
67
67
    where
68
 
        cons = [ x | (x, def:_) <- Map.toList ns, anameKind def == ConName ]
69
 
        defs = [ x | (x, def:_) <- Map.toList ns, anameKind def == DefName ]
70
 
        flds = [ x | (x, fld:_) <- Map.toList ns, anameKind fld == FldName ]
71
 
 
72
 
        mcons = map show cons
73
 
        mdefs = map show defs
74
 
        mflds = map show flds
75
 
 
76
 
        micons = concatMap parts cons
77
 
        midefs = concatMap parts defs
78
 
        miflds = concatMap parts flds
79
 
 
80
 
        parts (NoName _ _) = []
81
 
        parts (Name _ [_]) = []
82
 
        parts (Name _ ps)  = [ rawNameToString x | Id x <- ps ]
 
68
        cons = [ x | (x, def:_) <- Map.toList ns, anameKind def == ConName ]
 
69
        defs = [ x | (x, def:_) <- Map.toList ns, anameKind def == DefName ]
 
70
        flds = [ x | (x, fld:_) <- Map.toList ns, anameKind fld == FldName ]
 
71
 
 
72
        mcons = map show cons
 
73
        mdefs = map show defs
 
74
        mflds = map show flds
 
75
 
 
76
        micons = concatMap parts cons
 
77
        midefs = concatMap parts defs
 
78
        miflds = concatMap parts flds
 
79
 
 
80
        parts (NoName _ _) = []
 
81
        parts (Name _ [_]) = []
 
82
        parts (Name _ ps)  = [ rawNameToString x | Id x <- ps ]
83
83
 
84
84
generateVimFile :: FilePath -> TCM ()
85
85
generateVimFile file = do
86
86
    scope <- getScope
87
87
    liftIO $ UTF8.writeFile (vimFile file) $ toVim $ names scope
88
88
    where
89
 
        names = nsNames . everythingInScope
 
89
        names = nsNames . everythingInScope