gdritter repos charter / e277512
Mostly-working, largely-undocumented commit of Charter Getty Ritter 6 years ago
7 changed file(s) with 456 addition(s) and 0 deletion(s). Collapse all Expand all
+20
-0
.gitignore less more
1 dist
2 dist-*
3 *~
4 cabal-dev
5 *.o
6 *.hi
7 *.chi
8 *.chs.h
9 *.dyn_o
10 *.dyn_hi
11 .hpc
12 .hsenv
13 .cabal-sandbox/
14 cabal.sandbox.config
15 *.prof
16 *.aux
17 *.hp
18 *.eventlog
19 cabal.project.local
20 .ghc.environment.*
+12
-0
LICENSE less more
1 Copyright (c) 2018, Getty Ritter
2 All rights reserved.
3
4 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
5
6 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
7
8 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
9
10 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
11
12 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+100
-0
charter/Main.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Main where
4
5 import qualified Data.Text as T
6 import Lens.Family
7 import qualified System.Console.GetOpt as Opt
8 import qualified System.Environment as Sys
9 import qualified System.Exit as Sys
10
11 import qualified Charter as C
12
13 data Option
14 = AddBinary T.Text
15 | SetCategory T.Text
16 | SetSynopsis T.Text
17 | SetDescription T.Text
18 | SetLicense T.Text
19 | SetRoot T.Text
20 | AddDep T.Text
21 | AddUsualDeps
22 deriving (Eq, Show)
23
24 options :: [Opt.OptDescr Option]
25 options =
26 [ Opt.Option ['b'] ["bin"]
27 (Opt.ReqArg (AddBinary . T.pack) "PROGRAM NAME")
28 "Add another binary target to this Cabal file"
29 , Opt.Option ['r'] ["root"]
30 (Opt.ReqArg (SetRoot . T.pack) "DIRECTORY")
31 "Set the root directory for this project"
32
33 , Opt.Option ['c'] ["category"]
34 (Opt.ReqArg (SetCategory . T.pack) "CATEGORY")
35 "Set the category for this project"
36 , Opt.Option ['s'] ["synopsis"]
37 (Opt.ReqArg (SetSynopsis . T.pack) "SYNOPSIS")
38 "Set the synopsis for this project"
39 , Opt.Option ['d'] ["description"]
40 (Opt.ReqArg (SetDescription . T.pack) "DESCRIPTION")
41 "Set the description for this project"
42 , Opt.Option ['l'] ["license"]
43 (Opt.ReqArg (SetLicense . T.pack) "LICENSE")
44 "Set the license for this project"
45
46 , Opt.Option ['a'] ["add-dep"]
47 (Opt.ReqArg (AddDep . T.pack) "PACKAGE")
48 "Add a dependency to this application"
49 , Opt.Option ['A'] ["add-usual-deps"]
50 (Opt.NoArg AddUsualDeps)
51 "Add the typical set of dependencies to this application"
52 ]
53
54
55 usageInfo :: String
56 usageInfo = Opt.usageInfo header options
57 where header = "Usage: charter (quick|executable|library) [name]"
58
59
60 process :: [Option] -> C.Project -> C.Project
61 process opts p = foldr ($) p (map go opts)
62 where
63 go (AddBinary n) proj =
64 proj & C.binDetails %~ (C.mkBinary n :)
65 go (SetCategory s) proj =
66 proj & C.projectDetails . C.projectCategory .~ Just s
67 go (SetSynopsis s) proj =
68 proj & C.projectDetails . C.projectSynopsis .~ Just s
69 go (SetDescription s) proj =
70 proj & C.projectDetails . C.projectDescription .~ Just s
71 go (SetLicense s) proj =
72 proj & C.projectDetails . C.projectLicense .~ Just s
73 go (SetRoot _) proj = proj
74
75 go (AddDep dep) proj =
76 proj & C.binDetails %~ fmap (& C.execDeps %~ (dep :))
77 & C.libDetails %~ fmap (& C.libDeps %~ (dep :))
78 go (AddUsualDeps) proj =
79 proj & C.binDetails %~ fmap (& C.execDeps %~ (C.usualDeps ++))
80 & C.libDetails %~ fmap (& C.libDeps %~ (C.usualDeps ++))
81
82 setupProject :: String -> String -> IO C.Project
83 setupProject typ name = do
84 details <- C.projectDefaults (T.pack name)
85 case typ of
86 "quick" -> return (C.quickBin details)
87 "executable" -> return (C.projectBin details)
88 "library" -> return (C.library details)
89 _ -> Sys.die ("unknown project type: " ++ typ ++ "\n" ++ usageInfo)
90
91 main :: IO ()
92 main = do
93 args <- Sys.getArgs
94 case Opt.getOpt Opt.Permute options args of
95 (os, [typ, name], []) -> do
96 proj <- process os <$> setupProject typ name
97 C.createProject proj
98 (_, _, errs) -> do
99 mapM_ putStrLn errs
100 Sys.die usageInfo
+38
-0
charter.cabal less more
1 name: charter
2 version: 0.1.0.0
3 -- synopsis:
4 -- description:
5 license: BSD3
6 license-file: LICENSE
7 author: Getty Ritter <gdritter@galois.com>
8 maintainer: Getty Ritter <gdritter@galois.com>
9 copyright: ©2018 Getty Ritter
10 -- category:
11 build-type: Simple
12 cabal-version: >= 1.14
13
14 library
15 exposed-modules: Charter
16 other-modules: Templates
17 , Types
18 hs-source-dirs: src
19 build-depends: base >=4.7 && <5
20 , directory
21 , filepath
22 , process
23 , text
24 , lens-family-core
25 , lens-family-th
26 default-language: Haskell2010
27 default-extensions: ScopedTypeVariables
28
29 executable charter
30 hs-source-dirs: charter
31 main-is: Main.hs
32 default-extensions: ScopedTypeVariables
33 ghc-options: -Wall
34 build-depends: base >=4.7 && <5
35 , charter
36 , text
37 , lens-family-core
38 default-language: Haskell2010
+142
-0
src/Charter.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2 {-# LANGUAGE OverloadedStrings #-}
3
4 module Charter
5 ( module Types
6 , projectBin
7 , quickBin
8 , library
9
10 , mkBinary
11 , projectDefaults
12 , createProject
13 , usualDeps
14 ) where
15
16 import Control.Monad (forM_)
17 import qualified Data.Char as Char
18 import Data.Monoid ((<>))
19 import qualified Data.Text as T
20 import qualified Data.Text.IO as T
21 import Lens.Family
22 import qualified System.Directory as Sys
23 import qualified System.Environment as Sys
24 import qualified System.FilePath as Sys
25 import qualified System.Process as Proc
26
27 import Types
28 import Templates
29
30
31 mkBinary :: T.Text -> ExecutableDetails
32 mkBinary n = ExecutableDetails
33 { _execName = n
34 , _execDir = n
35 , _execDeps = []
36 }
37
38 mkLibrary :: T.Text -> LibraryDetails
39 mkLibrary n = LibraryDetails
40 { _libExposedModules = [capitalize n]
41 , _libDeps = []
42 }
43
44 mkProject :: ProjectDetails -> Project
45 mkProject deets = Project
46 { _projectDetails = deets
47 , _libDetails = Nothing
48 , _binDetails = []
49 , _projectRoot = Nothing
50 }
51
52 quickBin :: ProjectDetails -> Project
53 quickBin deets =
54 mkProject deets & binDetails .~ [ bin ]
55 where bin = mkBinary (deets^.projectName)
56 & execDir .~ "src"
57
58 projectBin :: ProjectDetails -> Project
59 projectBin deets =
60 mkProject deets & binDetails .~ [ bin ]
61 & libDetails .~ Just lib
62 where bin = mkBinary name & execDeps .~ ["name"]
63 lib = mkLibrary name
64 name = deets^.projectName
65
66 usualDeps :: [T.Text]
67 usualDeps =
68 [ "text"
69 , "containers"
70 , "unordered-containers"
71 , "bytestring"
72 ]
73
74 library :: ProjectDetails -> Project
75 library deets =
76 mkProject deets & libDetails .~ Just lib
77 where
78 lib = mkLibrary (deets^.projectName)
79
80 mkdirBase :: T.Text -> [T.Text] -> IO ()
81 mkdirBase base fp = do
82 let path = T.unpack (T.intercalate "/" (base:fp))
83 Sys.createDirectoryIfMissing True path
84
85 writeBase :: T.Text -> [T.Text] -> T.Text -> IO ()
86 writeBase base fp contents = do
87 mkdirBase base (init fp)
88 let path = T.unpack (T.intercalate "/" (base:fp))
89 putStrLn ("- creating file `" <> path <> "'")
90 T.writeFile path contents
91
92 run :: String -> [String] -> IO T.Text
93 run x xs = (T.strip . T.pack) `fmap` Proc.readProcess x xs ""
94
95 projectDefaults :: T.Text -> IO ProjectDetails
96 projectDefaults _projectName = do
97 _projectAuthor <- run "git" ["config", "user.name"]
98 _projectEmail <- run "git" ["config", "user.email"]
99 _projectYear <- run "date" ["+%Y"]
100 let _projectCategory = Nothing
101 _projectSynopsis = Nothing
102 _projectDescription = Nothing
103 _projectLicense = Nothing
104 return ProjectDetails { .. }
105
106 -- | Capitalize just the first letter of a string
107 capitalize :: T.Text -> T.Text
108 capitalize t = case T.uncons t of
109 Nothing -> mempty
110 Just (x, xs) -> T.cons (Char.toUpper x) xs
111
112 -- | Actually build out the scaffolding for a project
113 createProject :: Project -> IO ()
114 createProject pr = do
115 let deets = pr^.projectDetails
116 let write = writeBase (deets^.projectName)
117
118 let cabalFile =
119 [ cabalHeader deets ] <>
120 maybe [] (pure . cabalLibrary) (pr^.libDetails) <>
121 map cabalExecutable (pr^.binDetails)
122
123 T.putStrLn ("Creating project `" <> deets^.projectName <> "'")
124
125 let cabalPath = [deets^.projectName <> ".cabal"]
126 write cabalPath (T.unlines cabalFile)
127
128 case (pr^.libDetails) of
129 Nothing -> return ()
130 Just lib -> do
131 forM_ (lib^.libExposedModules) $ \ m -> do
132 let modPath = "src" : T.splitOn "." (m <> ".hs")
133 write modPath (defaultLib m)
134
135 forM_ (pr^.binDetails) $ \e -> do
136 write [e^.execDir, "Main.hs"] defaultBin
137
138 let pr = (Proc.proc "git" ["init"])
139 { Proc.cwd = Just (T.unpack (deets^.projectName)) }
140 _ <- Proc.withCreateProcess pr (\_ _ _ -> Proc.waitForProcess)
141 write [".gitignore"] defaultGitignore
142 return ()
+104
-0
src/Templates.hs less more
1 {-# LANGUAGE RecordWildCards #-}
2 {-# LANGUAGE OverloadedStrings #-}
3
4 module Templates where
5
6 import Data.Monoid ((<>))
7 import qualified Data.Text as T
8 import Lens.Family
9
10 import Types
11
12 cabalHeader :: ProjectDetails -> T.Text
13 cabalHeader pr = T.unlines
14 [ "name: " <> pr^.projectName
15 , "version: 0.1.0.0"
16 , case pr^.projectSynopsis of
17 Just s -> "synopsis: " <> s
18 Nothing -> "-- synopsis:"
19 , case pr^.projectDescription of
20 Just s -> "description: " <> s
21 Nothing -> "-- description:"
22 , case pr^.projectLicense of
23 Nothing -> "license: BSD3"
24 Just l -> "license: " <> l
25 , "author: " <> pr^.projectAuthor <> " <" <> pr^.projectEmail <> ">"
26 , "maintainer: " <> pr^.projectAuthor <> " <" <> pr^.projectEmail <> ">"
27 , "copyright: @" <> pr^.projectYear <> " " <> pr^.projectAuthor
28 , case pr^.projectCategory of
29 Just c -> "category: " <> c
30 Nothing -> "-- category:"
31 , "build-type: Simple"
32 , "cabal-version: >=1.14"
33 ]
34
35 cabalLibrary :: LibraryDetails -> T.Text
36 cabalLibrary lib = T.unlines $
37 [ "library"
38 , " hs-source-dirs: src"
39 , " ghc-options: -Wall"
40 , " build-depends: base >=4.7 && <5"
41 , " default-language: Haskell2010"
42 , " default-extensions: ScopedTypeVariables"
43 ] <> mods
44 where
45 mods = case lib^.libExposedModules of
46 [] -> []
47 (x:xs) ->
48 (" exposed-modules: " <> x) :
49 [" , " <> m | m <- xs ]
50
51 cabalExecutable :: ExecutableDetails -> T.Text
52 cabalExecutable exe = T.unlines $
53 [ "executable " <> exe^.execName
54 , " hs-source-dirs: " <> exe^.execDir
55 , " main-is: Main.hs"
56 , " default-language: Haskell2010"
57 , " default-extensions: ScopedTypeVariables"
58 , " ghc-options: -Wall"
59 ] <> deps
60 where
61 baseDep = " build-depends: base >=4.7 && <5"
62 deps =
63 baseDep : [ " , " <> m
64 | m <- exe^.execDeps
65 ]
66
67 defaultBin :: T.Text
68 defaultBin = T.unlines $
69 [ "module Main where"
70 , ""
71 , "main :: IO ()"
72 , "main = return ()"
73 ]
74
75 defaultLib :: T.Text -> T.Text
76 defaultLib mod = T.unlines $
77 [ "module " <> mod
78 , "("
79 , ") where"
80 ]
81
82 defaultGitignore :: T.Text
83 defaultGitignore = T.unlines
84 [ "dist"
85 , "dist-*"
86 , "*~"
87 , "cabal-dev"
88 , "*.o"
89 , "*.hi"
90 , "*.chi"
91 , "*.chs.h"
92 , "*.dyn_o"
93 , "*.dyn_hi"
94 , ".hpc"
95 , ".hsenv"
96 , ".cabal-sandbox/"
97 , "cabal.sandbox.config"
98 , "*.prof"
99 , "*.aux"
100 , "*.hp"
101 , "*.eventlog"
102 , "cabal.project.local"
103 , ".ghc.environment.*"
104 ]
+40
-0
src/Types.hs less more
1 {-# LANGUAGE TemplateHaskell #-}
2
3 module Types where
4
5 import qualified Data.Text as T
6 import qualified Lens.Family.TH as Lens
7
8 data ProjectDetails = ProjectDetails
9 { _projectName :: T.Text
10 , _projectAuthor :: T.Text
11 , _projectEmail :: T.Text
12 , _projectYear :: T.Text
13 , _projectCategory :: Maybe T.Text
14 , _projectSynopsis :: Maybe T.Text
15 , _projectDescription :: Maybe T.Text
16 , _projectLicense :: Maybe T.Text
17 }
18
19 data LibraryDetails = LibraryDetails
20 { _libExposedModules :: [T.Text]
21 , _libDeps :: [T.Text]
22 }
23
24 data ExecutableDetails = ExecutableDetails
25 { _execName :: T.Text
26 , _execDir :: T.Text
27 , _execDeps :: [T.Text]
28 }
29
30 data Project = Project
31 { _projectDetails :: ProjectDetails
32 , _libDetails :: Maybe LibraryDetails
33 , _binDetails :: [ExecutableDetails]
34 , _projectRoot :: Maybe T.Text
35 }
36
37 Lens.makeLenses ''ProjectDetails
38 Lens.makeLenses ''LibraryDetails
39 Lens.makeLenses ''ExecutableDetails
40 Lens.makeLenses ''Project