Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 127 lines (91 sloc) 3.593 kB
8df94af @gregorycollins Blaaargh: first draft
authored
1 {-# LANGUAGE OverloadedStrings #-}
2
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
3 module Blaaargh.Internal.Util.Templates
4 ( TemplateDirectory
8df94af @gregorycollins Blaaargh: first draft
authored
5 , Template
6 , TemplateGroup
7 , readTemplateDir
8 , lookupDirgroup
9 )
10 where
11
12 ------------------------------------------------------------------------------
13 import Control.Exception
14 import Control.Monad
15 import Data.ByteString.Char8 (ByteString)
16 import qualified Data.ByteString.Char8 as B
17 import Data.List
18 import Data.Map (Map)
19 import qualified Data.Map as Map
20 import Prelude hiding (catch)
21 import System.Directory
22 import System.FilePath
23 import Text.StringTemplate
24
25 ------------------------------------------------------------------------------
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
26 import Blaaargh.Internal.Exception
27 import Blaaargh.Internal.Util.ExcludeList
8df94af @gregorycollins Blaaargh: first draft
authored
28
29 ------------------------------------------------------------------------------
30
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
31 {-|
8df94af @gregorycollins Blaaargh: first draft
authored
32
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
33 'TemplateDirectory' is a directory structure of 'StringTemplate's. 'Template's
34 are indexed by path from a root path \".\", e.g. \"./dir/foo\", and templates
35 can invoke other templates (from the same directory or a parent directory) by
36 name.
37
38 -}
39
40 data TemplateDirectory =
41 TemplateDirectory TemplateGroup (Map ByteString TemplateDirectory)
42
43
44 instance Show TemplateDirectory where
8df94af @gregorycollins Blaaargh: first draft
authored
45 show x = help 0 x
46 where
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
47 help n (TemplateDirectory _ s) =
8df94af @gregorycollins Blaaargh: first draft
authored
48 "{\n" ++ concatMap (sone n) assocs
49 ++ "\n"
50 ++ (replicate n '\t')
51 ++ "}\n"
52 where
53 assocs = Map.assocs s
54
55
56 sone n (k,v) = (replicate n '\t') ++
57 (B.unpack k) ++ " => " ++
58 (help (n+1) v)
59
60
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
61 -- | TemplateGroup is a type alias for a StringTemplate over ByteStrings.
62 type Template = StringTemplate B.ByteString
8df94af @gregorycollins Blaaargh: first draft
authored
63
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
64
65 -- | TemplateGroup is a type alias for a STGroup over ByteStrings.
8df94af @gregorycollins Blaaargh: first draft
authored
66 type TemplateGroup = STGroup B.ByteString
67
68
69 ------------------------------------------------------------------------------
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
70
71
72 -- | Given a directory on the filesystem, crawl it for ".st" files and
73 -- produce a TemplateDirectory.
74 readTemplateDir :: FilePath -> IO TemplateDirectory
8df94af @gregorycollins Blaaargh: first draft
authored
75 readTemplateDir d = do
76 mp <- help d
77 return $ fixup mp
78
79 where
80 help path = do
81 isDir <- doesDirectoryExist path
82
83 when (not isDir)
84 (throwIO $ BlaaarghException
85 $ "template directory '" ++ path ++ "' does not exist")
86
87 grp <- directoryGroup path
88
89 files <- getDirectoryContents path >>=
90 return .
91 filter (\x -> not ("." `isPrefixOf` x))
92
93 dirs <- filterM (\x -> doesDirectoryExist $ path </> x) files
94
95 subDirs <- mapM (\f -> do
96 t <- help (path </> f)
97 return (B.pack f,t))
98 dirs
99
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
100 return $ TemplateDirectory grp $ Map.fromList subDirs
8df94af @gregorycollins Blaaargh: first draft
authored
101
102
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
103 addGroup grp (TemplateDirectory g sub) =
104 TemplateDirectory (addSuperGroup g grp) sub
8df94af @gregorycollins Blaaargh: first draft
authored
105
106
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
107 fixup (TemplateDirectory grp sub) =
108 TemplateDirectory grp newsub
8df94af @gregorycollins Blaaargh: first draft
authored
109 where
110 sub' = fmap (addGroup grp) sub
111 newsub = fmap fixup sub'
112
113
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
114 lookupDirgroup :: FilePath -> TemplateDirectory -> Maybe TemplateGroup
8df94af @gregorycollins Blaaargh: first draft
authored
115 lookupDirgroup path t = help pl t
116 where
117 stripDot [] = []
118 stripDot (".":b) = b
119 stripDot l = l
120
121 pl = stripDot $ fromPath $ B.pack path
122
b2af34e @gregorycollins Reorganize code and give haddock some love
authored
123 help [] (TemplateDirectory grp _) = Just grp
124 help (a:b) (TemplateDirectory _ sub) = do
8df94af @gregorycollins Blaaargh: first draft
authored
125 td <- Map.lookup a sub
126 help b td
Something went wrong with that request. Please try again.