0 | module Pack.Runner.New
  1 |
  2 | import Data.List1
  3 | import Data.Maybe
  4 | import Data.String
  5 | import Idris.Package.Types
  6 | import Pack.Config
  7 | import Pack.Core
  8 | import Pack.Database.Types
  9 | import Core.Name.Namespace
 10 | import Libraries.Text.PrettyPrint.Prettyprinter
 11 | import Libraries.Text.PrettyPrint.Prettyprinter.Doc
 12 | import Libraries.Text.PrettyPrint.Prettyprinter.Util
 13 | import Libraries.Text.PrettyPrint.Prettyprinter.Render.String
 14 |
 15 | %default total
 16 |
 17 | newPkgDesc : (name : Body) -> (mod : Body) -> (user: Maybe String) -> PkgDesc
 18 | newPkgDesc name mod user =
 19 |   let modName := (nsAsModuleIdent $ mkNamespace "\{mod}", "")
 20 |    in { authors := user
 21 |       , version := Just (MkPkgVersion (0 ::: [1, 0]))
 22 |       , mainmod := toMaybe (mod == "Main") modName
 23 |       , executable := toMaybe (mod == "Main") "\{name}"
 24 |       , modules := guard (mod /= "Main") *> [modName]
 25 |       , sourcedir := Just "src"
 26 |       } (initPkgDesc "\{name}")
 27 |
 28 | newTestPkgDesc : (name : Body) -> (user: Maybe String) -> PkgDesc
 29 | newTestPkgDesc name user =
 30 |    { authors    := user
 31 |    , version    := Just (MkPkgVersion (0 ::: [1, 0]))
 32 |    , mainmod    := Just (nsAsModuleIdent $ mkNamespace "Main", "")
 33 |    , executable := Just "\{name}-test"
 34 |    , depends    := [MkDepends "\{name}" anyBounds]
 35 |    , sourcedir  := Just "src"
 36 |    } (initPkgDesc "\{name}-test")
 37 |
 38 | toModuleName : List Char -> List Char
 39 | toModuleName [] = []
 40 | toModuleName (h :: t) = toUpper h :: map adjHyphen t
 41 |
 42 |   where
 43 |     adjHyphen : Char -> Char
 44 |     adjHyphen '-' = '_'
 45 |     adjHyphen c   = c
 46 |
 47 | -- Helper to capitalize the first letter of a Body
 48 | -- and replace hyphens with underscores
 49 | capitalize : Body -> Body
 50 | capitalize b@(MkBody xs prf) = fromMaybe b $ fromChars (toModuleName xs)
 51 |
 52 | mainModFile : String
 53 | mainModFile =
 54 |   """
 55 |   module Main
 56 |
 57 |   main : IO ()
 58 |   main = putStrLn "Hello from Idris2!"
 59 |
 60 |   """
 61 |
 62 | testFile : String
 63 | testFile =
 64 |   """
 65 |   module Main
 66 |
 67 |   main : IO ()
 68 |   main = putStrLn "Test successful!"
 69 |
 70 |   """
 71 |
 72 | libModFile : Body -> String
 73 | libModFile name =
 74 |   """
 75 |   module \{name}
 76 |
 77 |   test : String
 78 |   test = "Hello from Idris2!"
 79 |
 80 |   """
 81 |
 82 | packTomlContent : Body -> String
 83 | packTomlContent name =
 84 |   """
 85 |   [custom.all.\{name}]
 86 |   type = "local"
 87 |   path = "."
 88 |   ipkg = "\{name}.ipkg"
 89 |   test = "test/test.ipkg"
 90 |
 91 |   [custom.all.\{name}-test]
 92 |   type = "local"
 93 |   path = "test"
 94 |   ipkg = "test.ipkg"
 95 |   """
 96 |
 97 | -- Returns module name and module file
 98 | getModFile : PkgType -> Body -> (Body, String)
 99 | getModFile PLib pkgName = let mod = capitalize pkgName in (mod, libModFile mod)
100 | getModFile PApp pkgName = ("Main", mainModFile)
101 |
102 | gitIgnoreFile : String
103 | gitIgnoreFile =
104 |   """
105 |   build/
106 |   *.*~
107 |
108 |   """
109 |
110 | ||| Create a new package at current location
111 | export covering
112 | new :
113 |      {auto _ : HasIO io}
114 |   -> (curdir : CurDir)
115 |   -> PkgType
116 |   -> (pkgName : Body)
117 |   -> IdrisEnv
118 |   -> EitherT PackErr io ()
119 | new (CD curdir) pty pkgName e = do
120 |     debug "Creating new \{pty} package named \{pkgName}..."
121 |     debug "Getting author name from git config"
122 |     user <- Just <$> trim <$> sysRun ["git", "config", "user.name"]
123 |             `catchE` (const $ right Nothing)
124 |     debug "Creating PkgDesc"
125 |     let (mod, modFile) = getModFile pty pkgName
126 |
127 |     let pkgRootDir := curdir /> pkgName
128 |         srcDir     := pkgRootDir </> "src"
129 |         testDir    := pkgRootDir </> "test"
130 |         ipkg       := newPkgDesc pkgName mod user
131 |         test       := newTestPkgDesc pkgName user
132 |
133 |     debug "Creating parent and src directories"
134 |
135 |     mkDir (srcDir)
136 |
137 |     when (e.env.config.gitInit) $ do
138 |       debug "Initializing git repo"
139 |       eitherT
140 |         (\err => warn "Git repo creation failed: \{printErr err}")
141 |         (\_ => write (pkgRootDir </> ".gitignore") gitIgnoreFile)
142 |         (sysAndLog Info ["git", "init", pkgRootDir])
143 |
144 |     debug "Writing ipkg file"
145 |     write
146 |       (pkgRootDir  /> (pkgName <+> ".ipkg"))
147 |       (renderString (layoutUnbounded $ pretty ipkg) ++ "\n")
148 |
149 |     debug "Writing test.ipkg file"
150 |     write
151 |       (testDir  </> "test.ipkg")
152 |       (renderString (layoutUnbounded $ pretty test) ++ "\n")
153 |
154 |     debug "Writing test Main.idr file"
155 |     write (testDir  </> "src" </> "Main.idr") testFile
156 |
157 |     debug "Writing pack.toml"
158 |     write (MkF pkgRootDir packToml) (packTomlContent pkgName)
159 |
160 |     debug "Writing module file"
161 |     write (MkF srcDir $ mod <+> ".idr") modFile
162 |     info "Created \{pty} package '\{pkgName}'"
163 |