-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
100 lines (88 loc) · 2.61 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
{-
resolver: nightly
packages:
- bytestring
- file-embed
- process
- yaml
-}
{-# LANGUAGE ImplicitParams, OverloadedStrings, TemplateHaskell #-}
module Main (main) where
import Control.Monad (void)
import Data.ByteString.Char8 (pack)
import Data.FileEmbed (embedStringFile)
import Data.Foldable (fold, toList)
import Data.Yaml (Value, decodeThrow, parseMaybe, withObject, (.:), (.:?))
import GHC.Exception (CallStack)
import System.Environment (getArgs)
import System.Exit (exitWith)
import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)
import System.Process (CreateProcess, createProcess, proc, waitForProcess)
data RunSpec = RunSpec
{ file :: FilePath
, resolver :: String
, packages :: [String]
}
spec :: FilePath -> IO RunSpec
spec path = do
let readHeader =
decodeThrow . pack
. unlines
. snd . break (/= "{-")
. fst . break (== "-}")
. fmap (filter (/= '\r'))
. lines
header <- readHeader =<< readFile path
(resolver, packages) <-
maybe (help "spec") pure
. flip parseMaybe header
. withObject "header"
$ \hdr -> do
resolver <- hdr .: "resolver"
packages <- fmap fold $ hdr .:? "packages"
return (resolver, packages)
return (RunSpec path resolver packages)
stackArgs :: RunSpec -> [String]
stackArgs spec =
["--resolver", resolver spec]
<> (packages spec >>= \package -> ["--package", package])
<> [file spec]
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
args <- getArgs
case args of
"watch":file:_ -> watch =<< spec file
"repl":file:_ -> repl =<< spec file
"compile":file:_ -> compile =<< spec file
"script":file:args' -> script args' =<< spec file
_ -> help "main"
go :: CreateProcess -> IO ()
go process = do
(_, _, _, h) <- createProcess process
code <- waitForProcess h
exitWith code
watch :: RunSpec -> IO ()
watch spec = go $
proc "stack"
[ "exec"
, "--resolver"
, resolver spec
, "ghcid"
, "--"
, "--command"
, unwords $ "stack" : "repl" : stackArgs spec
]
repl :: RunSpec -> IO ()
repl spec = go $
proc "stack" ("repl" : stackArgs spec)
compile :: RunSpec -> IO ()
compile spec = go $
proc "stack" ("ghc" : stackArgs spec)
script :: [String] -> RunSpec -> IO ()
script args spec = go $
proc "stack" ("runhaskell" : stackArgs spec <> args)
help :: (?loc :: CallStack) => String -> IO a
help trace = do
putStrLn $(embedStringFile "README.md")
fail (trace <> ": " <> show ?loc)