4 module Main (main) where
5 import Control.Applicative
7 import Data.Ascii (Ascii)
10 import Data.Convertible.Base
11 import Data.Convertible.Utils
13 import Language.Haskell.TH.PprLib
14 import Language.Haskell.TH.Syntax
15 import Network.HTTP.Lucu.ETag
16 import Network.HTTP.Lucu.Implant
17 import Network.HTTP.Lucu.Implant.PrettyPrint
18 import Network.HTTP.Lucu.MIMEType
19 import Prelude.Unicode
20 import System.Console.GetOpt
21 import System.Environment
34 options ∷ [OptDescr CmdOpt]
35 options = [ Option "o" ["output"]
36 (ReqArg OptOutput "FILE")
39 , Option "m" ["module"]
40 (ReqArg OptModName "MODULE")
41 "Specify the resulting module name. (required)"
43 , Option "s" ["symbol"]
44 (ReqArg OptSymName "SYMBOL")
45 "Specify the resulting symbol name."
47 , Option "t" ["mime-type"]
48 (ReqArg OptMIMEType "TYPE")
49 "Specify the MIME Type of the file."
52 (ReqArg OptETag "TAG")
53 "Specify the ETag of the file."
61 printUsage = do mapM_ putStrLn msg
62 putStr $ usageInfo "Options:" options
67 , concat [ " lucu-implant-file is an utility that generates "
68 , "Haskell code containing an arbitrary file to "
69 , "compile it directly into programs and serve it "
70 , "statically with the Lucu HTTP server."
74 , " lucu-implant-file [OPTIONS...] FILE"
79 main = do (opts, sources, errors) ← getOpt Permute options <$> getArgs
82 $ do mapM_ putStr errors
83 exitWith $ ExitFailure 1
85 when (any (≡ OptHelp) opts)
91 exitWith $ ExitFailure 1
93 when (length sources ≥ 2)
94 $ fail "too many input files."
96 generateHaskellSource opts (head sources)
98 getMIMEType ∷ [CmdOpt] → Maybe MIMEType
100 = case mimeTypeOpts of
103 → case convertAttemptVia ((⊥) ∷ Ascii) ty of
105 Failure e → error (show e)
106 _ → error "too many --mime-type options."
108 mimeTypeOpts ∷ [CmdOpt]
110 = filter (\ x → case x of
114 getETag ∷ [CmdOpt] → Maybe ETag
118 OptETag str:[] → Just $ strToETag str
119 _ → error "too many --etag options."
122 eTagOpts = filter (\ x → case x of
126 strToETag ∷ String → ETag
129 Success a → strongETag a
130 Failure e → error (show e)
132 openOutput ∷ [CmdOpt] → IO Handle
136 OptOutput fpath:[] → do h ← openFile fpath WriteMode
139 _ → fail "two many --output options."
141 outputOpts ∷ [CmdOpt]
142 outputOpts = filter (\ x → case x of
146 getModuleName ∷ [CmdOpt] → ModName
148 = case modNameOpts of
149 [] → error "a module name must be given."
150 OptModName name:[] → mkModName name
151 _ → error "too many --module options."
153 modNameOpts ∷ [CmdOpt]
154 modNameOpts = filter (\ x → case x of
158 getSymbolName ∷ [CmdOpt] → Maybe Name
160 = case symNameOpts of
162 OptSymName name:[] → Just $ mkName name
163 _ → fail "too many --symbol options."
165 symNameOpts ∷ [CmdOpt]
166 symNameOpts = filter (\ x → case x of
170 defaultSymName ∷ ModName → Name
171 defaultSymName = headToLower ∘ getLastComp
173 headToLower ∷ String → Name
174 headToLower [] = error "module name must not be empty"
175 headToLower (x:xs) = mkName (toLower x:xs)
177 getLastComp ∷ ModName → String
178 getLastComp = reverse ∘ fst ∘ break (≡ '.') ∘ reverse ∘ modString
180 generateHaskellSource ∷ [CmdOpt] → FilePath → IO ()
181 generateHaskellSource opts srcFile
182 = do i ← openInput srcFile (getMIMEType opts) (getETag opts)
184 doc ← pprInput i modName symName
185 hPutStrLn o ∘ show $ to_HPJ_Doc doc
189 modName = getModuleName opts
192 symName = fromMaybe (defaultSymName modName)