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