<|start_filename|>Inigo/Package/ExtraDep.idr<|end_filename|>
module Inigo.Package.ExtraDep

import Data.List1
import Data.String
import Extra.String
import Inigo.Package.ParseHelpers
import Inigo.Paths
import System.Path
import Toml

-- TODO: Other methods?
public export
data Download
    = Git
    | SubDir

public export
DownloadInfo : Download -> Type
DownloadInfo Git = String -- commit
DownloadInfo SubDir = ()

public export
record ExtraDep where
    constructor MkExtraDep
    download : Download
    downloadInfo : DownloadInfo download
    url : String
    subDirs : List String

export
Show ExtraDep where
    show (MkExtraDep Git commit url subDirs) =
        "MkExtraDep{download=git, download-info=\"\{commit}\", url=\"\{url}\", subDirs=\{show subDirs}}"
    show (MkExtraDep SubDir () url subDirs) =
        "MkExtraDep{download=folder, url=\"\{url}\", subDirs=\{show subDirs}}"


export
Eq ExtraDep where
    MkExtraDep Git commit0 url0 subDirs0 == MkExtraDep Git commit1 url1 subDirs1 =
        commit0 == commit1 && url0 == url1 && subDirs0 == subDirs1
    MkExtraDep SubDir _ url0 subDirs0 == MkExtraDep SubDir _ url1 subDirs1 =
        url0 == url1 && subDirs0 == subDirs1
    _ == _ = False

export
eqIgnoreSubDirs : ExtraDep -> ExtraDep -> Bool
MkExtraDep Git commit0 url0 _ `eqIgnoreSubDirs` MkExtraDep Git commit1 url1 _ =
    commit0 == commit1 && url0 == url1
MkExtraDep SubDir _ url0 _ `eqIgnoreSubDirs` MkExtraDep SubDir _ url1 _ =
    url0 == url1
_ `eqIgnoreSubDirs` _ = False

export
toToml : List ExtraDep -> Toml
toToml deps = [(["extra-dep"], ArrTab $ depToToml <$> deps)]
  where
    depToToml : ExtraDep -> Toml
    depToToml (MkExtraDep Git commit url subDirs) =
        [ (["download"], Str "git")
        , (["commit"], Str commit)
        , (["url"], Str url)
        , (["sub-folders"], Lst (Str <$> subDirs))
        ]
    depToToml (MkExtraDep SubDir () url subDirs) =
        [ (["download"], Str "folder")
        , (["url"], Str url)
        , (["sub-folders"], Lst (Str <$> subDirs))
        ]

export
parseDownload : Toml -> Either String Download
parseDownload toml = case get ["download"] toml of
    Just (Str "git") => Right Git
    Just (Str "folder") => Right SubDir
    Just (Str val) => Left "Invalid download method: \{val}"
    Just val => Left "Inavlid value for field download: \{show val}"
    Nothing => Left "Missing field download"


export
parseExtraDeps : Toml -> Either String (List ExtraDep)
parseExtraDeps toml = case get ["extra-dep"] toml of
    Nothing => Right []
    Just (ArrTab deps) => foldlM extraDep [] deps
    Just val => Left "Invalid extra dependency found: \{show val}"
  where
    sanitiseCommit : String -> Either String String
    sanitiseCommit str =
        let len = length str
            allHex = all isHexDigit $ unpack str
        in if len == 7 || len == 40 && allHex
            then Right str
            else Left "Invalid commit: \"\{str}\""

    extraDep : List ExtraDep -> Toml -> Either String (List ExtraDep)
    extraDep deps toml = do
        url <- string ["url"] toml
        subDirs <- withDefault [""] $ listStr ["sub-folders"] toml
        download <- parseDownload toml
        case download of
            Git => do
                commit <- string ["commit"] toml >>= sanitiseCommit
                pure $ MkExtraDep Git commit url subDirs :: deps
            SubDir => do
                pure $ MkExtraDep SubDir () url subDirs :: deps

genFolder : String -> String
genFolder = concat . map escapeChar . unpack
  where
    escapeChar : Char -> String
    escapeChar c = if isAlphaNum c || c == '@'
        then cast c
        else "_" ++ show (ord c)

export
getExtraDepDir : ExtraDep -> String
getExtraDepDir (MkExtraDep Git commit url _) = inigoDepDir </> genFolder "\{url}@\{commit}"
getExtraDepDir (MkExtraDep SubDir _ url _) = url


<|start_filename|>Inigo/Package/CodeGen.idr<|end_filename|>
module Inigo.Package.CodeGen

import Data.List.Elem
import Extra.List

-- TODO: When we support external backends use idris2's `CG` for this.
public export
data CodeGen : Type where
  Chez : CodeGen
  ChezSep : CodeGen
  Racket : CodeGen
  Gambit : CodeGen
  Node : CodeGen
  Javascript : CodeGen
  RefC : CodeGen

export
toString : CodeGen -> String
toString Chez = "chez"
toString ChezSep = "chez-sep"
toString Racket = "racket"
toString Gambit = "gambit"
toString Node = "node"
toString Javascript = "javascript"
toString RefC = "refc"

export
getCodeGen : String -> Maybe CodeGen
getCodeGen "chez" = Just Chez
getCodeGen "chez-sep" = Just ChezSep
getCodeGen "racket" = Just Racket
getCodeGen "gambit" = Just Gambit
getCodeGen "node" = Just Node
getCodeGen "javascript" = Just Javascript
getCodeGen "refc" = Just RefC
getCodeGen _ = Nothing

export
cmdArgs : CodeGen -> String -> (String, List String)
cmdArgs Node target = ("node", [target])
cmdArgs Javascript target = ("node", [target])
cmdArgs _ target = (target, [])


<|start_filename|>Inigo/Async/Git.idr<|end_filename|>
module Inigo.Async.Git

import Inigo.Async.Base
import Inigo.Async.Promise
import Inigo.Async.FS
import System.Path

||| Download a git repository optionally specifying the commit, then remove the .git folder
||| Returns `True` iff the file already exists.
export
git_downloadTo : (url : String) -> (commit : Maybe String) -> (dest : String) -> Promise Bool
git_downloadTo url commit dest = do
    case !(fs_exists dest) of
        False => do
            ignore $ system "git" ["clone", "-q", "--progress", "--recurse-submodules", url, dest] Nothing False False
            maybe
                (pure ())
                (\com => ignore $ system "git" ["checkout", "-q", com] (Just dest) False False)
                commit
            fs_rmdir True (dest </> ".git")
            pure False
        True => pure True


<|start_filename|>Client/Action/Test.idr<|end_filename|>
module Client.Action.Test

import Client.Action.Build as Build
import Fmt
import Inigo.Async.Base
import Inigo.Async.Promise
import Inigo.Package.CodeGen as CodeGen
import Inigo.Package.Package

-- TODO: Consider moving this out from Inigo into toml config
export
test : CodeGen -> Promise ()
test codeGen =
  do
    pkg <- Build.writeIPkgFile
    log (fmt "Running tests...")
    ignore $ system "idris2" ["--find-ipkg", "Test/Suite.idr", "--cg", CodeGen.toString codeGen, "-x", "suite"] Nothing True True


<|start_filename|>Base/SemVar/Test/Suite.idr<|end_filename|>
module Test.Suite

import IdrTest.Test

import Test.SemVar.DataTest
import Test.SemVar.LexerTest
import Test.SemVar.ParserTest
import Test.SemVar.SatTest

suite : IO ()
suite = do
  runSuites
    [ Test.SemVar.LexerTest.suite
    , Test.SemVar.ParserTest.suite
    , Test.SemVar.DataTest.suite
    , Test.SemVar.SatTest.suite
    ]


<|start_filename|>Base/Markdown/Markdown/Parser.idr<|end_filename|>
module Markdown.Parser

import Markdown.Lexer
import Markdown.Data
import Text.Parser
import Text.Token
import Data.List
import Data.List1

import public Markdown.Tokens

-- Note: this is currently infinitely recursive
-- %default total

mutual
  private
  markdown : Grammar _ MarkdownToken False Markdown
  markdown =
    do
      els <- many (
              (map Just header)
          <|> (map Just paragraph)
          <|> (map (const Nothing) $ newLine)
        )
      pure $ Doc (mapMaybe id els)

  private
  inline : Grammar _ MarkdownToken True Inline
  inline =
    (
          text
      <|> pre
      <|> codeBlock
      <|> bold
      <|> italics
      <|> image
      <|> link
      <|> html
      <|> parts
    )

  -- TODO: Handle other incomplete parts
  parts : Grammar _ MarkdownToken True Inline
  parts =
    map (const $ Text "!") (match ImageSym)

  wrapInline : MarkdownTokenKind -> (List Inline -> a) -> Grammar _ MarkdownToken True a
  wrapInline sym tok =
    do
      ignore $ match sym
      contents <- some inline
      ignore $ match sym
      pure $ tok (forget contents)

  private
  header : Grammar _ MarkdownToken True Block
  header =
    do
      level <- match HeadingSym
      commit -- TODO: Should we commit here?
      contents <- many inline
      blockTerminal
      pure $ Header level contents

  blockTerminal : Grammar _ MarkdownToken False ()
  blockTerminal =
    (map (const ()) $ (some newLine)) <|>
    eof

  private
  newLine : Grammar _ MarkdownToken True ()
  newLine =
    map (const ()) (match NewLine)

  private
  paragraph : Grammar _ MarkdownToken True Block
  paragraph =
    do
      contents <- some inline
      blockTerminal
      pure $ Paragraph (forget contents)

  private
  text : Grammar _ MarkdownToken True Inline
  text =
    map Text (match MdText)

  private
  pre : Grammar _ MarkdownToken True Inline
  pre =
    map Pre (match MdPre)

  private
  codeBlock : Grammar _ MarkdownToken True Inline
  codeBlock =
    map (uncurry CodeBlock) (match MdCodeBlock)

  private
  bold : Grammar _ MarkdownToken True Inline
  bold =
    wrapInline BoldSym Bold

  private
  italics : Grammar _ MarkdownToken True Inline
  italics =
    wrapInline ItalicsSym Italics

  private
  image : Grammar _ MarkdownToken True Inline
  image =
    do
      match ImageSym
      r <- match MdLink
      buildImage r

  private
  buildImage : (String, String) -> Grammar _ MarkdownToken False Inline
  buildImage (alt, src) =
    pure $ Image alt src

  private
  link : Grammar _ MarkdownToken True Inline
  link =
    map (\(href, desc) => Link href desc) (match MdLink)

  private
  html : Grammar _ MarkdownToken True Inline
  html =
    do
      openTag <- match HtmlOpenTag
      contents <- many inline
      closer openTag -- TODO: Is this inefficient?
      pure $ Html openTag contents

  private
  closer : String -> Grammar _ MarkdownToken True ()
  closer tag =
    do
      closeTag <- match HtmlCloseTag
      checkTag closeTag tag

  private
  checkTag : String -> String -> Grammar _ MarkdownToken False ()
  checkTag x y =
    if x == y
      then pure ()
      else fail "tag mismatch"

export
parseMarkdown : List (WithBounds MarkdownToken) -> Maybe Markdown
parseMarkdown toks = case parse markdown toks of
                      Right (j, []) => Just j
                      _ => Nothing


<|start_filename|>Base/Markdown/Markdown/Tokens.idr<|end_filename|>
module Markdown.Tokens

import Data.String
import Markdown.String
import Extra.String
import public Text.Token

safeSub : Nat -> Nat -> Nat
safeSub _ Z = Z
safeSub Z v = v
safeSub (S n) (S k) = safeSub n k

getLinkDesc : String -> (String, String)
getLinkDesc text =
  let
    (linkPart, descPart) = break (== ']') text
    linkLenFinal = safeSub 1 (length linkPart)
    descLenFinal = safeSub 3 (length descPart)
  in
    (
      substr 1 linkLenFinal linkPart,
      substr 2 descLenFinal descPart
    )

public export
data MarkdownTokenKind
  = HeadingSym
  | MdText
  | MdPre
  | MdCodeBlock
  | NewLine
  | ItalicsSym
  | BoldSym
  | ImageSym
  | MdLink
  | HtmlOpenTag
  | HtmlCloseTag

public export
Eq MarkdownTokenKind where
  (==) HeadingSym HeadingSym = True
  (==) MdText MdText = True
  (==) MdPre MdPre = True
  (==) MdCodeBlock MdCodeBlock = True
  (==) NewLine NewLine = True
  (==) ItalicsSym ItalicsSym = True
  (==) BoldSym BoldSym = True
  (==) ImageSym ImageSym = True
  (==) MdLink MdLink = True
  (==) HtmlOpenTag HtmlOpenTag = True
  (==) HtmlCloseTag HtmlCloseTag = True
  (==) _ _ = False

public export
MarkdownToken : Type
MarkdownToken = Token MarkdownTokenKind

dropEnds : Int -> String -> String
dropEnds n str =
  let
    len : Int
    len = cast $ length str
  in
    strSubstr n (len - 2 * n) str

public export
TokenKind MarkdownTokenKind where
  TokType HeadingSym = Nat
  TokType MdText = String
  TokType MdPre = String
  TokType MdCodeBlock = (String, Maybe String)
  TokType NewLine = ()
  TokType ItalicsSym = ()
  TokType BoldSym = ()
  TokType ImageSym = ()
  TokType MdLink = (String, String)
  TokType HtmlOpenTag = String
  TokType HtmlCloseTag = String

  tokValue HeadingSym x = length x
  tokValue MdText txt = txt
  tokValue MdPre txt = dropEnds 1 txt
  tokValue MdCodeBlock txt =
    case Extra.String.split '\n' (dropEnds 3 txt) of
      [] =>
        ("", Nothing)

      ("\n" :: x) =>
        (join "\n" x, Nothing)

      hd :: x =>
        (join "\n" x, Just hd)

  tokValue NewLine _ = ()
  tokValue ItalicsSym _ = ()
  tokValue BoldSym _ = ()
  tokValue ImageSym _ = ()
  tokValue MdLink text = getLinkDesc text
  tokValue HtmlOpenTag tag = (filter isAlphaNum tag) -- TODO: Improve quality
  tokValue HtmlCloseTag tag = (filter isAlphaNum tag) -- how to do this?

export
Show MarkdownToken where
  show (Tok HeadingSym l) = "HeadingSym " ++ (show l)
  show (Tok MdText txt) = "MdText " ++ (quote txt)
  show (Tok MdPre txt) = "MdPre " ++ (quote txt)
  show (Tok MdCodeBlock txt) = "MdCodeBlock " ++ (quote txt)
  show (Tok NewLine _) = "NewLine"
  show (Tok ItalicsSym _) = "ItalicsSym"
  show (Tok BoldSym _) = "BoldSym"
  show (Tok ImageSym _) = "ImageSym"
  show (Tok MdLink txt) = "MdLink " ++ (quote txt)
  show (Tok HtmlOpenTag tag) = "StartTag " ++ quote tag
  show (Tok HtmlCloseTag tag) = "EndTag " ++ quote tag

export
Eq MarkdownToken where
  (Tok HeadingSym l0) == (Tok HeadingSym l1) = l0 == l1
  (Tok MdText txt0) == (Tok MdText txt1) = txt0 == txt1
  (Tok MdPre txt0) == (Tok MdPre txt1) = txt0 == txt1
  (Tok MdCodeBlock txt0) == (Tok MdCodeBlock txt1) = txt0 == txt1
  (Tok NewLine _) == (Tok NewLine _) = True
  (Tok ItalicsSym _) == (Tok ItalicsSym _) = True
  (Tok BoldSym _) == (Tok BoldSym _) = True
  (Tok ImageSym _) == (Tok ImageSym _) = True
  (Tok MdLink txt0) == (Tok MdLink txt1) = txt0 == txt1
  (Tok HtmlOpenTag tag0) == (Tok HtmlOpenTag tag1) = tag0 == tag1
  (Tok HtmlCloseTag tag0) == (Tok HtmlCloseTag tag1) = tag0 == tag1
  _ == _ = False


<|start_filename|>Inigo/Async/SubtleCrypto/SubtleCrypto.idr<|end_filename|>
module Inigo.Async.SubtleCrypto.SubtleCrypto

import Inigo.Async.Base
import Inigo.Async.Promise
import Inigo.Async.Util

public export
data Usage : Type where
  Sign : Usage
  Verify : Usage
  (<&>) : Usage -> Usage -> Usage

infixr 5 <&>

usageArray : Usage -> List String
usageArray Sign = ["sign"]
usageArray Verify = ["verify"]
usageArray (u0 <&> u1) = (usageArray u0) ++ (usageArray u1)

interface Encodable a where
  toAnyPtr : a -> AnyPtr

public export
data EllipticCurve : Type where
  P256 : EllipticCurve
  P384 : EllipticCurve
  P512 : EllipticCurve

encodeCurve : EllipticCurve -> String
encodeCurve P256 = "P-256"
encodeCurve P384 = "P-384"
encodeCurve P512 = "P-512"

public export
data KeyAlgorithm : Type where
  KeyECDSA : EllipticCurve -> KeyAlgorithm
  KeyECDH : EllipticCurve -> KeyAlgorithm

public export
data SHA : Type where
  Sha256 : SHA
  Sha384 : SHA
  Sha512 : SHA

public export
Eq SHA where
  Sha256 == Sha256 = True
  Sha384 == Sha384 = True
  Sha512 == Sha512 = True
  _ == _ = False

export
encodeSha : SHA -> String
encodeSha Sha256 = "SHA-256"
encodeSha Sha384 = "SHA-384"
encodeSha Sha512 = "SHA-512"

export
decodeSha : String -> Maybe SHA
decodeSha "SHA-256" = Just Sha256
decodeSha "SHA-384" = Just Sha384
decodeSha "SHA-512" = Just Sha512
decodeSha _ = Nothing

public export
data Algorithm : Type where
  ECDSA : SHA -> Algorithm
  PBKDF2 : SHA -> String -> Int -> Algorithm

public export
Eq Algorithm where
  (ECDSA sha0) == (ECDSA sha1) = sha0 == sha1
  (PBKDF2 sha0 salt0 iterations0) == (PBKDF2 sha1 salt1 iterations1) = sha0 == sha1 && salt0 == salt1 && iterations0 == iterations1
  _ == _ = False

Key : Type
Key = AnyPtr
-- data Key : Type where
--   Key : AnyPtr -> Key

-- Encodable Key where
--   toAnyPtr (Key ptr) = ptr

data EncAlgo : Type where
  MkEncAlgo : AnyPtr -> EncAlgo

Encodable EncAlgo where
  toAnyPtr (MkEncAlgo ptr) = ptr

data EncKeyAlgo : Type where
  MkEncKeyAlgo : AnyPtr -> EncKeyAlgo

Encodable EncKeyAlgo where
  toAnyPtr (MkEncKeyAlgo ptr) = ptr

Signature : Type
Signature = String

inspect : String -> String
inspect str = "(function(){let inspect=(r,msg)=>{console.log(msg, r); return r;};return " ++ str ++ "})()"

arrayBufferEnc64 : String -> String
arrayBufferEnc64 str = "(function(){let arrayBufferEnc64=(buf)=>{let string = ''; (new Uint8Array(buf)).forEach((byte) => { string += String.fromCharCode(byte) }); return btoa(string);};return " ++ str ++ "})()"

arrayBufferDec64 : String -> String
arrayBufferDec64 str = "(function(){let arrayBufferDec64=(string)=>{string = atob(string); const length = string.length, buf = new ArrayBuffer(length), bufView = new Uint8Array(buf); for (var i = 0; i < length; i++) { bufView[i] = string.charCodeAt(i) } return buf;};return " ++ str ++ "})()"

%foreign "node:lambda:" ++ (arrayBufferDec64 "(name, hash, salt, iterations) => ({name, hash, salt: salt ? arrayBufferDec64(salt) : null, iterations: iterations ? iterations : null})")
encodeAlgorithm__prim : String -> String -> String -> Int -> PrimIO AnyPtr

%foreign "node:lambda:(name, namedCurve) => ({name, namedCurve})"
encodeKeyAlgorithm__prim : String -> String -> PrimIO AnyPtr

%foreign (promisifyPrim (toArray "(algo, usage, encKey) => crypto.subtle.importKey(\"jwk\", JSON.parse(encKey), algo, false, toArray(usage))"))
importKey__prim : AnyPtr -> List String -> String -> promise Key

%foreign (promisifyPrim "(key) => crypto.subtle.exportKey(\"jwk\", key).then((e) => JSON.stringify(e))")
exportKey__prim : Key -> promise String

%foreign (promisifyPrim (toArray "(algo, usage) => crypto.subtle.generateKey(algo, true, toArray(usage)).then((k) => [k.publicKey, k.privateKey]).then(__prim_js2idris_array)"))
generateKey__prim : AnyPtr -> List String -> promise (List AnyPtr)

%foreign (promisifyPrim (arrayBufferEnc64 "(algo, key, data) => crypto.subtle.sign(algo, key, new TextEncoder().encode(data)).then(arrayBufferEnc64)"))
sign__prim : AnyPtr -> AnyPtr -> String -> promise String

%foreign (promisifyPrim (arrayBufferDec64 "(algo, key, signature, data) => crypto.subtle.verify(algo, key, arrayBufferDec64(signature), new TextEncoder().encode(data)).then((res) => res ? 1 : 0)"))
verify__prim : AnyPtr -> AnyPtr -> String -> String -> promise Int

%foreign ("node:lambda:" ++ (arrayBufferEnc64 "(len) => arrayBufferEnc64(crypto.getRandomValues(new Uint8Array(len)))"))
getRand__prim : Int -> PrimIO String

%foreign (promisifyPrim (inspect (arrayBufferEnc64 "(algo, password) => crypto.subtle.importKey('raw', new TextEncoder().encode(password), algo, false, ['deriveBits', 'deriveKey']).then((km) => crypto.subtle.deriveKey(algo, km, {name:'AES-CBC','length':256}, true, ['encrypt', 'decrypt']).then((k) => crypto.subtle.exportKey('raw', k).then(arrayBufferEnc64)))")))
hash__prim : AnyPtr -> String -> promise String

encodeAlgorithm : Algorithm -> Promise EncAlgo
encodeAlgorithm (ECDSA sha) =
  map MkEncAlgo $ liftIO $ primIO (encodeAlgorithm__prim "ECDSA" (encodeSha sha) "" 0)

encodeAlgorithm (PBKDF2 sha salt iterations) =
  map MkEncAlgo $ liftIO $ primIO (encodeAlgorithm__prim "PBKDF2" (encodeSha sha) salt iterations)

encodeKeyAlgorithm : KeyAlgorithm -> Promise EncKeyAlgo
encodeKeyAlgorithm (KeyECDSA curve) =
  map MkEncKeyAlgo $ liftIO $ primIO (encodeKeyAlgorithm__prim "ECDSA" (encodeCurve curve))

encodeKeyAlgorithm (KeyECDH curve) =
  map MkEncKeyAlgo $ liftIO $ primIO (encodeKeyAlgorithm__prim "ECDH" (encodeCurve curve))

export
generateKey : KeyAlgorithm -> Usage -> Promise (Key, Key)
generateKey algo usage =
  do
    algoEnc <- encodeKeyAlgorithm algo
    (pub :: priv :: []) <- promisify (generateKey__prim (toAnyPtr algoEnc) (usageArray usage))
      | _ => reject "Invalid key generated"
    pure (pub, priv)

export
exportKey : Key -> Promise String
exportKey key =
  promisify (exportKey__prim key)

export
importKey : KeyAlgorithm -> Usage -> String -> Promise Key
importKey algo usage encKey =
  do
    algoEnc <- encodeKeyAlgorithm algo
    promisify (importKey__prim (toAnyPtr algoEnc) (usageArray usage) encKey)

export
sign : Algorithm -> Key -> String -> Promise String
sign algo key target =
  do
    algoEnc <- encodeAlgorithm algo
    promisify (sign__prim (toAnyPtr algoEnc) key target)    

export
verify : Algorithm -> Key -> String -> String -> Promise Bool
verify algo key sig target =
  do
    algoEnc <- encodeAlgorithm algo
    intToBool <$> promisify (verify__prim (toAnyPtr algoEnc) key sig target)

export
getRand : Int -> Promise String
getRand len =
  do
    liftIO (primIO (getRand__prim len))

export
hash : Algorithm -> String -> Promise String
hash algo password =
  do
    algoEnc <- encodeAlgorithm algo
    promisify (hash__prim (toAnyPtr algoEnc) password)


<|start_filename|>Inigo/Archive/Path.idr<|end_filename|>
module Inigo.Archive.Path

import Data.List
import Data.String
import Extra.String
import Inigo.Package.Package
import Inigo.Paths

isIPkg : String -> Bool
isIPkg =
  isSuffixOf ".ipkg"

isBuild : String -> Bool
isBuild =
  isInfixOf "/build/"

isDep : String -> Bool
isDep =
  isInfixOf inigoDepDir

isDisallowed : String -> Bool
isDisallowed x =
  isIPkg x || isBuild x || isDep x

export
ignoreFiles : List String -> List String
ignoreFiles =
  filter (not . isDisallowed)

export
depPath : Package -> String
depPath pkg =
  let
    modPath = joinPath (split '.' (package pkg))
  in
    inigoDepDir </> (ns pkg) </> modPath


<|start_filename|>Inigo/Async/SubtleCrypto/Example.idr<|end_filename|>
module Inigo.Async.SubtleCrypto.Example

import Inigo.Async.Promise
import Inigo.Async.SubtleCrypto.SubtleCrypto

-- Can be tested in a browser with:
-- idris2 SubtleCrypto/Example.idr --cg node -o testcrypto && cat build/exec/testcrypto | pbcopy

signAndVerify : Promise ()
signAndVerify =
  do
    let keyAlgo = (KeyECDSA P256)
    let algo = (ECDSA Sha256)
    (pub, priv) <- generateKey keyAlgo (Sign <&> Verify)
    privEnc <- exportKey priv
    privImp <- importKey keyAlgo Sign privEnc
    signature <- sign algo privImp "hello world"
    pubEnc <- exportKey pub
    pubImp <- importKey keyAlgo Verify pubEnc
    success <- verify algo pubImp signature "hello world"
    log ("Success: " ++ show success)

hashPassword : Promise ()
hashPassword =
  do
    salt <- getRand 8
    let algo = (PBKDF2 Sha256 salt 10000)
    hashed <- hash algo "my password"
    log ("Hashed: " ++ hashed)

main : IO ()
main =
  resolve hashPassword (\_ => pure ()) (\_ => pure ())


<|start_filename|>Base/Markdown/Test/Markdown/Format/HTMLTest.idr<|end_filename|>
module Test.Markdown.Format.HtmlTest

import IdrTest.Test
import IdrTest.Expectation

import Markdown
import Markdown.Data
import Markdown.Format.Html

toHtmlSpecs : List (String, Markdown, String)
toHtmlSpecs =
  [ ( "Render Header", Doc [Header 1 [Text " test"]], "<h1> test</h1>" )
  , ( "Render Short Paragraph", Doc [Paragraph [Text "test"]], "<p>test</p>"  )
  , ( "Render Paragraph", Doc [Paragraph [Text "test"]], "<p>test</p>" )
  , ( "Render Two Paragraphs", Doc [Paragraph [Text "test"], Paragraph [Text "test2"]], "<p>test</p>\n<p>test2</p>" )
  , ( "Render Both", Doc [Header 1 [Text " text"], Paragraph [Text "and more"]], "<h1> text</h1>\n<p>and more</p>" )
  , ( "Render Bold then Italic", Doc [Header 2 [Text " Well ", Bold [Text "hello"], Text " ", Italics [Text "there"]]], "<h2> Well <strong>hello</strong> <em>there</em></h2>" )
  , ( "Render a Link", Doc [Paragraph [Link "here" "http://example.com"]], "<p><a href=\"http://example.com\">here</a></p>" )
  , ( "Render an Image", Doc [Paragraph [Image "desc" "http://example.com/img.svg"]], "<p><img src=\"http://example.com/img.svg\" alt=\"desc\"></img></p>" )
  , ( "Render HTML", Doc [Paragraph [Text "This is ", Html "sup" [Text "Super"], Text "!"]], "<p>This is <sup>Super</sup>!</p>" )
  , ( "Render Preformatted Text", Doc [Paragraph [Pre "t0", CodeBlock "t1 <cool>" Nothing]], "<p><tt>t0</tt><pre>t1 &lt;cool&gt;</pre></p>" )
  , ( "Render a Link with Space", Doc [Paragraph [Link "here" "http://example.com", Text "."]], "<p><a href=\"http://example.com\">here</a>.</p>" )
  ]

export
suite : Test
suite =
  let
    toHtmlTests =
      map (\(name, doc, result) =>
        test name (\_ => assertEq (toHtml doc) result)
      ) toHtmlSpecs
  in
  describe "toHTML Tests" toHtmlTests


<|start_filename|>Base/Markdown/Test/Markdown/LexerTest.idr<|end_filename|>
module Test.Markdown.LexerTest

import IdrTest.Test
import IdrTest.Expectation

import Markdown.Lexer

lexerSpecs : List (String, String, Maybe (List MarkdownToken))
lexerSpecs =
  [
    (
      "Complex Example",
      "## My _Heading_\n\nThis is some [text](https://text.com) and it's **cool**.\n\nBut there's more and it's interesting.\n# There's other things, <sup>too</sup>.\nBut that's not for today!",
      Just $
      [ Tok HeadingSym "##"
      , Tok MdText " My "
      , Tok ItalicsSym ""
      , Tok MdText "Heading"
      , Tok ItalicsSym ""
      , Tok NewLine ""
      , Tok NewLine ""
      , Tok MdText "This is some "
      , Tok MdLink "[text](https://text.com)"
      , Tok MdText " and it's "
      , Tok BoldSym ""
      , Tok MdText "cool"
      , Tok BoldSym ""
      , Tok MdText "."
      , Tok NewLine ""
      , Tok NewLine ""
      , Tok MdText "But there's more and it's interesting."
      , Tok NewLine ""
      , Tok HeadingSym "#"
      , Tok MdText " There's other things, "
      , Tok HtmlOpenTag "<sup>"
      , Tok MdText "too"
      , Tok HtmlCloseTag "</sup>"
      , Tok MdText "."
      , Tok NewLine ""
      , Tok MdText "But that's not for today!"
      ]
    ),
    (
      "Brackets Example",
      "A < B > C <D E> >F< << >>",
      Just $
      [ Tok MdText "A < B > C <D E> >F< << >>"
      ]
    ),
    (
      "Preformatted Text",
      "# Hello `john`\n```how\nare\nyou```",
      Just $
      [ Tok HeadingSym "#"
      , Tok MdText " Hello "
      , Tok MdPre "`john`"
      , Tok NewLine ""
      , Tok MdCodeBlock "```how\nare\nyou```"
      ]
    )
  ]

export
suite : Test
suite =
  let
    lexerTests =
      map (\(name, text, result) =>
        test name (\_ => assertEq (lexMarkdown text) result)
      ) lexerSpecs
  in
    describe "Lexer Tests"
      [ describe "Lexer Specs" lexerTests
      , describe "tokValue Tests"
          [ test "Heading" (\_ => assertEq (value $ (Tok HeadingSym "##")) 2)
          , test "Text" (\_ => assertEq (value $ (Tok MdText "Hello")) "Hello")
          , test "NewLine" (\_ => assertEq (value $ (Tok NewLine "\n")) ())
          , test "ItalicsSym" (\_ => assertEq (value $ (Tok ItalicsSym "_")) ())
          , test "BoldSym" (\_ => assertEq (value $ (Tok BoldSym "**")) ())
          , test "Link" (\_ => assertEq (value $ (Tok MdLink "[cool](https://cool.com)")) ("cool", "https://cool.com"))
          , test "HtmlOpenTag" (\_ => assertEq (value $ (Tok HtmlOpenTag "<sup>")) "sup")
          , test "HtmlCloseTag" (\_ => assertEq (value $ (Tok HtmlCloseTag "</sup>")) "sup")
          ]
      ]


<|start_filename|>Inigo/Async/Package.idr<|end_filename|>
module Inigo.Async.Package

import Inigo.Paths
import Inigo.Async.Base
import Inigo.Async.CloudFlare.KV
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Package.PackageDhall
import Inigo.Package.PackageIndex

||| Gets a package from the "packages" KV
export
getPackage : String -> Promise (Either String Package)
getPackage package =
  map parsePackage (read "packages" package)

||| Returns an index with all packages
export
index : Promise (Either String PackageIndex)
index =
  map parsePackageIndex (read "packages" "index")

public export
data InigoPackagePath
  = TomlPath String
  | DhallPath String

export
Show InigoPackagePath where
  show (TomlPath x) = x
  show (DhallPath x) = x

export
packageFilePath : String -> Promise InigoPackagePath
packageFilePath src =
  let tomlPath = src </> inigoTomlPath
      dhallPath = src </> inigoDhallPath
  in do
    tp <- fs_exists tomlPath
    dp <- fs_exists dhallPath
    case (tp, dp) of
         (True, False) => pure $ TomlPath tomlPath
         (False, True) => pure $ DhallPath dhallPath
         (True, True) => reject "Conflict: both Inigo.toml and Inigo.dhall found"
         (False, False) => reject "Inigo.toml or Inigo.dhall file not found"

parseFile : InigoPackagePath -> Promise Package
parseFile (TomlPath path) = do
  contents <- fs_readFile path
  let Right package = parsePackage contents
    | Left err => reject ("Error reading toml package: " ++ err)
  pure package
parseFile (DhallPath path) = do
  -- can pass the file path to dhall so it can handle relative imports
  Right package <- parsePackageDhall path
    | Left err => reject ("Error reading dhall package: " ++ err)
  pure package

export
readPackage : String -> Promise Package
readPackage dir = parseFile !(packageFilePath dir)

export
currPackage : Promise Package
currPackage = readPackage "." -- current dir


<|start_filename|>Test/Inigo/Package/PackageDepsTest.idr<|end_filename|>
module Test.Inigo.Package.PackageDepsTest

import IdrTest.Test
import IdrTest.Expectation

import Data.List
import Inigo.Async.Promise
import Inigo.Package.PackageDeps
import SemVar.Data
import Test.Inigo.Package.PackageTest
import Toml

exampleDepsToml : String
exampleDepsToml = """
['1.2.3']
deps.a='=5.0.0'
dev.b='=6.0.0'

['1.2.4']
deps.a='=5.1.0'
dev.b='=6.1.0'
"""

exampleDepsExp : PackageDeps
exampleDepsExp =
  [ ((MkVersion 1 2 3 Nothing Nothing), (
      MkPackageDep
        [(["a"], (EQ (MkVersion 5 0 0 Nothing Nothing)))]
        [(["b"], (EQ (MkVersion 6 0 0 Nothing Nothing)))]
    ))
  , ((MkVersion 1 2 4 Nothing Nothing), (
      MkPackageDep
        [(["a"], (EQ (MkVersion 5 1 0 Nothing Nothing)))]
        [(["b"], (EQ (MkVersion 6 1 0 Nothing Nothing)))]
    ))
  ]

exampleDepsExpExt : PackageDeps
exampleDepsExpExt =
  [ ((MkVersion 1 2 3 Nothing Nothing), (
      MkPackageDep [] []
    ))
  , ((MkVersion 0 0 1 (Just "pre") Nothing), (
      MkPackageDep [] []
    ))
  , ((MkVersion 1 2 4 Nothing Nothing), (
      MkPackageDep [] []
    ))
  ]

toTomlTest : Test
toTomlTest =
  test "To Toml" (\_ => assertEq
    (toToml exampleDepsExp)
    [ ( ["1.2.3", "deps", "a"], Str "=5.0.0" )
    , ( ["1.2.3", "dev", "b"], Str "=6.0.0" )
    , ( ["1.2.4", "deps", "a"], Str "=5.1.0" )
    , ( ["1.2.4", "dev", "b"], Str "=6.1.0" )
    ]
  )

encodePackageDepsTest : Test
encodePackageDepsTest =
  test "Encode package index" (\_ => assertEq
    (encodePackageDeps exampleDepsExp)
    "\"1.2.3\".deps.a=\"=5.0.0\"\n\"1.2.3\".dev.b=\"=6.0.0\"\n\"1.2.4\".deps.a=\"=5.1.0\"\n\"1.2.4\".dev.b=\"=6.1.0\""
  )

toPackageDepTest : Test
toPackageDepTest =
  test "fromPackage" (\_ => assertEq
    (fromPackage examplePackage)
    (MkPackageDep
      [
        (["MyDep"], (
          AND
            (GTE $ MkVersion 1 2 3 Nothing Nothing)
            (LT $ MkVersion 2 0 0 Nothing Nothing)
        ))
      ]
      [
        (["MyDevDep"], (
          EQ (MkVersion 2 0 0 Nothing Nothing)
        ))
      ]
    )
  )

exampleDep : (Version, PackageDep)
exampleDep =
  (
    (MkVersion 0 0 1 (Just "pre") Nothing),
    (
      MkPackageDep
        [
          (["MyDep"], (
            AND
              (GTE $ MkVersion 1 2 3 Nothing Nothing)
              (LT $ MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
        [
          (["MyDevDep"], (
            EQ (MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
    )
  )

updatePackageDepNewTest : Test
updatePackageDepNewTest =
  test "updatePackageDep New Dep" (\_ => assertEq
    (
      updatePackageDep
        exampleDepsExp
        examplePackage
    )
    (snoc exampleDepsExp exampleDep)
  )

updatePackageDepExistingTest : Test
updatePackageDepExistingTest =
  test "updatePackageDep Existing Dep" (\_ => assertEq
    (
      updatePackageDep
        exampleDepsExpExt
        examplePackage
    )
    [ ((MkVersion 1 2 3 Nothing Nothing), (
        MkPackageDep [] []
      ))
    , ((MkVersion 0 0 1 (Just "pre") Nothing), (
        MkPackageDep
        [
          (["MyDep"], (
            AND
              (GTE $ MkVersion 1 2 3 Nothing Nothing)
              (LT $ MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
        [
          (["MyDevDep"], (
            EQ (MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
      ))
    , ((MkVersion 1 2 4 Nothing Nothing), (
        MkPackageDep [] []
      ))
    ]
  )

export
suite : Test
suite =
  describe "PackageDeps"
    [ test "Parse Deps" (\_ => assertEq
        (parsePackageDeps exampleDepsToml)
        (Right exampleDepsExp)
      )
    , toTomlTest
    , encodePackageDepsTest
    , toPackageDepTest
    , updatePackageDepNewTest
    , updatePackageDepExistingTest
    ]


<|start_filename|>Base/Toml/Test/TomlTest.idr<|end_filename|>
module Test.TomlTest

import IdrTest.Test
import IdrTest.Expectation

import Toml

parseSpecs : List (String, Maybe Toml)
parseSpecs =
  [
    (
      "hello=\"world\"",
      Just [(["hello"], Str "world")]
    ),
    (
      "hello=\"wor\\nld\"",
      Just [(["hello"], Str "wor\nld")]
    ),
    (
      "count=55",
      Just [(["count"], Num 55)]
    ),
    (
      "count=[55, [66 ,\"dog\"]]",
      Just [(["count"], Lst [Num 55,Lst [Num 66, Str "dog"]])]
    ),
    (
      "count=[\n55, \n66 ,77\n]",
      Just [(["count"], Lst [Num 55, Num 66, Num 77])]
    ),
    (
      "[x]\ny=55",
      Just [(["x", "y"], Num 55)]
    ),
    (
      "[x-z]\ny=55",
      Just [(["x-z", "y"], Num 55)]
    ),
    (
      "5=55",
      Just [(["5"], Num 55)]
    ),
    (
      "[\"x.y\"]\n\"z.z\"=55",
      Just [(["x.y", "z.z"], Num 55)]
    ),
    (
      "[a]\nb=1\n[c]\nd=1\ne=1",
      Just [
        (["a", "b"], Num 1),
        (["c", "d"], Num 1),
        (["c", "e"], Num 1)
      ]
    ),
    (
      "[a]\nb=1\nc.d=2\n[e.f]\ng=3",
      Just [
        (["a", "b"], Num 1),
        (["a", "c", "d"], Num 2),
        (["e", "f", "g"], Num 3)
      ]
    ),
    (
      "[[a]]\nb=1\nc=2\nd.e=3\n[[a]]\nb=3\nc=4\n[a.d]\ne=5",
      Just [
        (["a"], ArrTab [
          [ (["b"], Num 1)
          , (["c"], Num 2)
          , (["d", "e"], Num 3)
          ],
          [ (["b"], Num 3)
          , (["c"], Num 4)
          , (["d", "e"], Num 5)
          ]
        ])
      ]
    ),
    (
      "[cool]
description=\"cool package\"
version=\"1.2.3\"
[funk]
description=\"funky package\"
version=\"10.0.0\"",
      Just [
        (["cool", "description"], Str "cool package"),
        (["cool", "version"], Str "1.2.3"),
        (["funk", "description"], Str "funky package"),
        (["funk", "version"], Str "10.0.0")
      ]
    )
  ]

encodeSpecs : List (Toml, String)
encodeSpecs =
  [
    (
      [(["hello"], Str "world")],
      "hello=\"world\""
    ),
    (
      [(["hello.world"], Str "cool")],
      "\"hello.world\"=\"cool\""
    ),
    (
      [(["hello=world"], Str "cool")],
      "\"hello=world\"=\"cool\""
    ),
    (
      [(["count"], Num 55)],
      "count=55"
    ),
    (
      [(["deep","count"], Num 55)],
      "deep.count=55"
    ),
    (
      [
        (["a"], ArrTab [
          [ (["b"], Num 1)
          , (["c"], Num 2)
          , (["d", "e"], Num 3)
          ],
          [ (["b"], Num 3)
          , (["c"], Num 4)
          , (["d", "e"], Num 5)
          ]
        ])
      ],
      "[[a]]\nb=1\nc=2\nd.e=3\n\n[[a]]\nb=3\nc=4\nd.e=5"
    )
  ]

getSpecs : List (Toml, List String, Maybe Value)
getSpecs =
  [
    (
      [(["hello"], Str "world")],
      ["hello"],
      Just (Str "world")
    ),
    (
      [(["count"], Num 55)],
      ["count"],
      Just (Num 55)
    ),
    (
      [(["count"], Num 55)],
      ["butter"],
      Nothing
    ),
    (
      [(["count"], Num 55)],
      ["count", "more"],
      Nothing
    ),
    (
      [(["count"], Num 55)],
      [],
      Nothing
    ),
    (
      [(["deep","count"], Num 55)],
      ["deep", "count"],
      Just (Num 55)
    )
  ]

export
suite : Test
suite =
  let
    parseTests =
      map (\(text, result) =>
        test text (\_ => assertEq (parseToml text) result)
      ) parseSpecs

    encodeTests =
      map (\(toml, exp) =>
        test exp (\_ => assertEq (encode toml) exp)
      ) encodeSpecs

    getTests =
      map (\(toml, keys, exp) =>
        test ("Getting " ++ show keys ++ " from " ++ show toml) (\_ => assertEq (get keys toml) exp)
      ) getSpecs
  in
    describe "Toml Tests"
      [ describe "Parser Specs" parseTests
      , describe "Encoder Specs" encodeTests
      , describe "Get Specs" getTests
      ]


<|start_filename|>config.mk<|end_filename|>
INSTALL_DIR = /usr/local/bin


<|start_filename|>Base/Toml/Toml.idr<|end_filename|>
module Toml

import Data.List
import Data.String
import Extra.String
import Toml.Parser
import Toml.Lexer

import Text.Bounded

import public Toml.Data

||| Parse a Toml document
export
parseToml : String -> Maybe Toml
parseToml x = parseTomlToks !(lexToml x)

||| Encode a Toml document with raw keys
export
encode : Toml -> String
encode =
  join "\n" . map showVal
  where
    showKeyPart : String -> String
    showKeyPart k =
      if includesAny ".=\"'" k
        then quote k
        else k

    showKey : List String -> String
    showKey =
      join "." . map showKeyPart

    showVal : (List String, Value) -> String
    showVal (key, ArrTab l) =
      let
        heading = (++) ("[[" ++ (showKey key) ++ "]]\n")
        contents = map (heading . encode) l
      in
        join "\n\n" contents

    showVal (key, value) =
      let
        k = showKey key
        v = show value
      in
        k ++ "=" ++ v

export
get : List String -> Toml -> Maybe Value
get key =
  (map snd) . (find ((== key) . fst))

export
getToml : List String -> Toml -> Toml
getToml key =
  (map (mapFst (drop (length key)))) . (filter (isPrefixOf key . fst))


<|start_filename|>Base/Markdown/Markdown.idr<|end_filename|>
module Markdown

import Markdown.Lexer
import Markdown.Parser

import Text.Bounded

import public Markdown.Data

%default covering

||| Parse a Markdown string
export
parse : String -> Maybe Markdown
parse x = parseMarkdown !(lexMarkdown x)


<|start_filename|>Inigo/Account/Account.idr<|end_filename|>
module Inigo.Account.Account

import Data.List
import Data.Maybe
import Extra.String
import Fmt
import Toml
import Inigo.Async.SubtleCrypto.SubtleCrypto -- TODO: We don't use Async, maybe split package?

||| An account registered with an Inigo server
public export
record Account where
  constructor MkAccount
  ns : String
  email : String
  kdf : Algorithm
  hash : String

public export
Show Account where
  show (MkAccount ns email _ _) = fmt "MkAccount{ns=%s, email=%s, kdf=***, hash=***}" ns email

public export
Eq Account where
  (MkAccount ns0 email0 kdf0 hash0) == (MkAccount ns1 email1 kdf1 hash1) =
    ns0 == ns1 && email0 == email1 && kdf0 == kdf1 && hash0 == hash1

||| Encodes an account into a Toml data type
toToml : Account -> Toml
toToml (MkAccount ns email kdf hash) =
  [ (["ns"], Str ns)
  , (["email"], Str email)
  ] ++ toTomlKdf kdf ++
  [ (["hash"], Str hash)
  ]
  where
    toTomlKdf : Algorithm -> Toml
    toTomlKdf (PBKDF2 sha salt iterations) =
      [ (["kdf", "type"], Str "PBKDF2")
      , (["kdf", "sha"], Str (encodeSha sha))
      , (["kdf", "salt"], Str salt)
      , (["kdf", "iterations"], Num iterations)
      ]

    toTomlKdf (ECDSA sha) =
      [ (["kdf", "type"], Str "ECDSA")
      , (["kdf", "sha"], Str (encodeSha sha))
      ]

||| Decodes a Toml data value into an account object
export
fromToml : Toml -> Maybe Account
fromToml toml =
  do
    ns <- str ["ns"] toml
    email <- str ["email"] toml
    kdf <- fromTomlKdf (getToml ["kdf"] toml)
    hash <- str ["hash"] toml
    pure $ (MkAccount ns email kdf hash)
  where
    str : List String -> Toml -> Maybe String
    str key toml =
      case get key toml of
        Just (Str v) =>
          Just v

        _ =>
          Nothing

    int : List String -> Toml -> Maybe Int
    int key toml =
      case get key toml of
        Just (Num v) =>
          Just v

        _ =>
          Nothing

    fromTomlKdfType : String -> Toml -> Maybe Algorithm
    fromTomlKdfType "PBKDF2" toml =
      do
        sha <- (str ["sha"] toml) >>= decodeSha
        salt <- str ["salt"] toml
        iterations <- int ["iterations"] toml
        pure (PBKDF2 sha salt iterations)
    fromTomlKdfType "ECDSA" toml =
      do
        sha <- (str ["sha"] toml) >>= decodeSha
        pure (ECDSA sha)
    fromTomlKdfType _ _ = Nothing

    fromTomlKdf : Toml -> Maybe Algorithm
    fromTomlKdf toml =
      do
        type <- str ["type"] toml
        fromTomlKdfType type toml

||| Encodes an account into a Toml doc
export
encode : Account -> String
encode =
  encode . toToml

||| Decodes an account from a Toml doc
export
decode : String -> Maybe Account
decode str =
  parseToml str >>= fromToml

-- TODO: Improve quality of Validity parsing, e.g. by passing back a hidden type
export
require : List (Bool, String) -> List String
require conds =
  foldl accumulateErr [] conds
  where
    accumulateErr : List String -> (Bool, String) -> List String
    accumulateErr acc (cond, err) =
      if cond then
        acc
      else
        (err :: acc)

export
nsValid : String -> List String
nsValid str =
  let
    unpacked = unpack str
  in
    require
      [ (length str >= 4, "Namespace must be at least 4 chars")
      , ( (foldl (\acc, el => acc && (isAlphaNum el)) True unpacked) , "Namespace must be alpha-numeric")
      , (fromMaybe False $ map isUpper $ head' unpacked, "Must start with an uppercase letter") --'
      ]

export
emailValid : String -> List String
emailValid email =
  require $ case split '@' email of
    (first :: last :: []) =>
      do
      [ ( length first > 0, "Invalid email username" )
      , ( length last > 0, "Invalid email domain" )
      ]
    _ =>
      [ ( False, "Email must contain a single @ sign" ) ]

export
passphraseValid : String -> List String
passphraseValid passphrase =
  require
    [ ( length passphrase > 10, "Please use a strong passphrase" ) ]

export
mkAccount : String -> String -> Algorithm -> String -> String -> Either String Account
mkAccount ns email kdf passphrase hash =
  do
    validate (nsValid ns)
    validate (emailValid email)
    validate (passphraseValid passphrase)
    pure $ MkAccount ns email kdf hash
  where
    validate : List String -> Either String ()
    validate [] = Right ()
    validate errs = Left (join ", " errs)


<|start_filename|>Client/Action/Push.idr<|end_filename|>
module Client.Action.Push

import Data.Maybe
import Client.Server
import Client.Util
import Data.Buffer
import Extra.Buffer
import Inigo.Async.Archive
import Inigo.Async.Fetch
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Async.Package
import Inigo.Util.Url.Url
import Toml
import System.Path

pushArchive : Server -> String -> Package -> String -> Promise ()
pushArchive server session pkg rootPath =
  do
    contents <- Inigo.Async.Archive.buildArchive pkg rootPath
    let url = toString (fromHostPath (host server) (postArchiveUrl pkg))
    ignore $ assertOk url $ request url "POST" contents [auth session]

pushReadme : Server -> String -> Package -> String -> Promise ()
pushReadme server session pkg contents =
  do
    let url = toString (fromHostPath (host server) (postReadmeUrl pkg))
    ignore $ assertOk url $ request url "POST" contents [auth session]

pushPackage : Server -> String -> Package -> Promise ()
pushPackage server session pkg =
  do
    let url = toString (fromHostPath (host server) (postPackageUrl pkg))
    ignore $ assertOk url $ request url "POST" (encode $ toToml pkg) [auth session]

maybePushReadme : Server -> String -> Maybe String -> Package -> Promise ()
maybePushReadme _ _ Nothing pkg = pure ()
maybePushReadme server session (Just path) pkg =
  do
    contents <- fs_readFile path
    pushReadme server session pkg contents

export
push : Server -> String -> String -> Promise ()
push server session packageFile =
  do
    pkg <- readPackage packageFile
    let rootPath = fromMaybe "" $ parent packageFile    
    pushArchive server session pkg rootPath
    maybePushReadme server session (map (rootPath </>) (readme pkg)) pkg
    pushPackage server session pkg


<|start_filename|>Base/IdrTest/IdrTest/Test.idr<|end_filename|>
module IdrTest.Test

import Data.List
import Data.Maybe
import Data.SortedSet as Set
import Extra.String
import IdrTest.Expectation
import System

data Flag : Type where
  Only : Flag
  Skip : Flag

Eq Flag where
  Only == Only = True
  Skip == Skip = True
  _ == _ = False

Ord Flag where
  compare Only Skip = GT
  compare Skip Only = LT
  compare _ _ = EQ

TestCase : Type
TestCase = (String, () -> Expectation, SortedSet Flag)

export
Test : Type
Test = List TestCase

toTestList : Test -> List TestCase
toTestList = id

runTest : (Nat, List String) -> TestCase -> (Nat, List String)
runTest (succ, failures) (name, expectation, _) =
  case expectation () of
    Nothing =>
      (succ + 1, failures)
    Just err =>
      (succ, (name ++ ": " ++ err) :: failures)

enumerate : Nat -> String -> String -> String
enumerate n single multiple =
  (show n) ++ " " ++ case n of
    1 =>
      single
    _ =>
      multiple

showResults : (Nat, List String) -> Nat -> IO ()
showResults (succ, failures) skips =
  let
    count = succ + List.length failures + skips
    countStr = enumerate count "test" "tests"
    successStr = enumerate succ "success" "successes"
    failureStr = enumerate (List.length failures) "failure" "failures"
    skipStr = enumerate skips "test skipped" "tests skipped"
    allFailuresStr = join "\n\n" $ map (\f => "❌ Failed: " ++ f) failures
  in
    do putStrLn allFailuresStr
       putStrLn (join ", " [countStr, successStr, failureStr, skipStr])

export
describe : String -> (List Test) -> Test
describe desc =
  map (\(name, expectation) => (desc ++ ": " ++ name, expectation)) . concat

export
only : Test -> Test
only =
  map (\(name, expectation, flags) => (name, expectation, insert Only flags))

export
skip : Test -> Test
skip =
  map (\(name, expectation, flags) => (name, expectation, insert Skip flags))

export
test : String -> (() -> Expectation) -> Test
test name expectation =
  [
    (name, expectation, Set.empty)
  ]

filterTests : List TestCase -> (List TestCase, List TestCase)
filterTests tests =
  let
    cond = if hasOnly tests
      then filterForOnly
      else filterSkips
  in
    partition cond tests
  where
    hasOnly : List TestCase -> Bool
    hasOnly =
      any (\(_, _, f) => Set.contains Only f)

    filterSkips : TestCase -> Bool
    filterSkips (_, _, flags) =
      not $ Set.contains Skip flags

    filterForOnly : TestCase -> Bool
    filterForOnly (_, _, flags) =
      Set.contains Only flags && (not $ Set.contains Skip flags)

export
runSuite : Test -> IO Bool
runSuite suite =
  let
    (tests, skips) = filterTests (toTestList suite)
    results = foldl runTest (0, []) tests
  in
    do
      showResults results (List.length skips)
      pure $ ((length . snd) results > 0) -- has failures

export
runSuites : List Test -> IO ()
runSuites tests =
  do
    hasFailures <- (runSuite . concat) tests
    if hasFailures
      then exitFailure
      else exitSuccess


<|start_filename|>golden/inigo/test002/MyPkg.idr<|end_filename|>
module MyPkg

main : IO ()
main =
  putStrLn "Hello from MyPkg"


<|start_filename|>Base/Toml/Toml/Parser.idr<|end_filename|>
module Toml.Parser

import Data.List
import Data.List1
import Extra.List
import Text.Parser
import Text.Token
import Toml.Data
import Toml.Lexer

import public Toml.Tokens

comment : Grammar _ TomlToken True (Maybe (List String, Value))
comment =
  map (const Nothing) (match Comment)

whitespace : Grammar _ TomlToken True (Maybe (List String, Value))
whitespace =
  map (const Nothing) (match Whitespace)

optWhitespace : Grammar _ TomlToken False ()
optWhitespace = ignore $ optional $ match Whitespace

keyword : Grammar _ TomlToken True (List String)
keyword =
  forget <$> sepBy1 (match Dot) (match Keyword <|> match StringLit <|> (map show $ match Number))

heading : Grammar _ TomlToken True (List String)
heading =
  do
    match LeftBracket
    optWhitespace
    key <- keyword
    optWhitespace
    match RightBracket
    pure key


doubleHeading : Grammar _ TomlToken True (List String)
doubleHeading =
  do
    match LeftBracket
    match LeftBracket
    optWhitespace
    key <- keyword
    optWhitespace
    match RightBracket
    match RightBracket
    pure key

doubleHeadingOf : List String -> Grammar _ TomlToken True String
doubleHeadingOf lookup =
  do
    key <- doubleHeading
    the (Grammar _ _ False _) $
      if key == lookup
        then pure "hi"
        else fail "mismatched double heading"

str : Grammar _ TomlToken True Value
str =
  map Str (match StringLit)

num : Grammar _ TomlToken True Value
num =
  map Num (match Number)

optSpacing : Grammar state TomlToken True a -> Grammar state TomlToken True a
optSpacing inner =
  do
    optWhitespace
    res <- inner
    optWhitespace
    pure res

mutual
  list : Grammar state TomlToken True Value
  list =
    do
      ignore $ match LeftBracket
      values <- sepBy (optSpacing $ match Comma) value
      ignore $ match RightBracket
      pure (Lst values)

  value : Grammar _ TomlToken True Value
  value =
    optSpacing $ str <|> num <|> list

kv : Grammar _ TomlToken True (Maybe (List String, Value))
kv =
  do
    key <- keyword
    optWhitespace
    match Equals
    optWhitespace
    v <- value
    pure $ Just (key, v)

mutual
  subtable : Grammar _ TomlToken True (List (List String, Value))
  subtable =
    do
      key <- doubleHeading
      -- Let's read a table and repeat with the same heading any number of times
      tomls <- sepBy1 (doubleHeadingOf key) (simpleToml key)
      let val = ArrTab $ forget tomls
      pure [(key, val)]

  emptyHeading : Grammar _ TomlToken True (List (List String, Value))
  emptyHeading =
    do
      ignore heading
      pure []

  kvs : Grammar _ TomlToken True (List (List String, Value))
  kvs =
    do
      key <- option [] heading
      inner <- some (
            kv
        <|> comment
        <|> whitespace)
      pure $ map (\(k, v) => (key ++ k, v)) (mapMaybe id $ forget inner)

  simpleToml : List String -> Grammar _ TomlToken False Toml
  simpleToml pre =
    do
      res <- map concat (many (kvs <|> emptyHeading))
      pure $ map (mapFst $ dropPrefix pre) res

  toml : Grammar _ TomlToken False Toml
  toml =
    map concat (many (subtable <|> kvs <|> emptyHeading))

export
parseTomlToks : List (WithBounds TomlToken) -> Maybe Toml
parseTomlToks toks = case parse toml toks of
                      Right (j, []) => Just j
                      _ => Nothing


<|start_filename|>Server/InigoServer/KVOps.idr<|end_filename|>
module Server.InigoServer.KVOps

import Inigo.Async.Promise

import Data.List
import Data.Maybe
import Data.SortedSet as Set
import Extra.String
import Fmt
import Inigo.Account.Account as Account
import Inigo.Async.Base
import Inigo.Async.CloudFlare.KV
import Inigo.Async.SubtleCrypto.SubtleCrypto
import Inigo.Package.Package
import Inigo.Package.PackageDeps
import Inigo.Package.PackageIndex
import SemVar.Data
import Server.InigoServer.Util

||| TODO: Should package technically be a list of strings?
||| TODO: We should be able to rebuild if any of the redundant stores becomes corrupted

sessionTTL : Int
sessionTTL = 60 * 60 * 24 * 10 -- 10 days

packageIndexKey : (String, String)
packageIndexKey = ("index", "index")

packageKey : String -> String -> Version -> (String, String)
packageKey ns package version = ("packages", fmt "%s.%s@%s" ns package (show version))

readmeKey : String -> String -> Version -> (String, String)
readmeKey ns package version = ("readme", fmt "%s.%s@%s" ns package (show version))

archiveKey : String -> String -> Version -> (String, String)
archiveKey ns package version = ("archives", fmt "%s.%s@%s" ns package (show version))

packageDepKey : String -> String -> (String, String)
packageDepKey ns package = ("deps", fmt "%s.%s" ns package)

accountKey : String -> (String, String)
accountKey ns = ("accounts", ns)

sessionKey : String -> (String, String)
sessionKey session = ("sessions", session)

pkgVerKey : Package -> (String -> String -> Version -> a) -> a
pkgVerKey pkg f =
  f (ns pkg) (package pkg) (version pkg)

pkgKey : Package -> (String -> String -> a) -> a
pkgKey pkg f =
  f (ns pkg) (package pkg)

read : (String, String) -> Promise (Maybe String)
read key =
  do
    res <- (uncurry KV.read key)
    if res == ""
      then pure $ Nothing
      else pure $ Just res

write : (String, String) -> String -> Promise ()
write key val = (uncurry KV.write key) val

writeTTL : (String, String) -> String -> Int -> Promise ()
writeTTL key val ttl = (uncurry KV.writeTTL key) val ttl

export
readIndex : Promise PackageIndex
readIndex =
  do
    indexRes <- read packageIndexKey
    log ("Package Index: " ++ show indexRes)
    expectResult $ fromMaybe (Right []) $ map parsePackageIndex indexRes

export
writeIndex : PackageIndex -> Promise ()
writeIndex index =
  write packageIndexKey (encodePackageIndex index)

export
readArchive : String -> String -> Version -> Promise (Maybe String)
readArchive packageNS packageName version =
  read (archiveKey packageNS packageName version)

export
writeArchive : String -> String -> Version -> String -> Promise ()
writeArchive packageNS packageName version body =
  write (archiveKey packageNS packageName version) body

export
readReadme : String -> String -> Version -> Promise (Maybe String)
readReadme packageNS packageName version =
  read (readmeKey packageNS packageName version)

export
writeReadme : String -> String -> Version -> String -> Promise ()
writeReadme packageNS packageName version body =
  write (readmeKey packageNS packageName version) body

-- TODO: This logic is a little complex to be here
export
readAllDeps : String -> String -> Promise (List (List String, PackageDeps))
readAllDeps packageNS packageName =
  readAllDeps_ Set.empty [packageNS, packageName]
  where
    readDep : List String -> Promise PackageDeps
    readDep [packageNS, packageName] =
      do
        depsRes <- read (packageDepKey packageNS packageName)
        log ("Package Deps: " ++ show depsRes)
        expectResult $ fromMaybe (Right []) $ map parsePackageDeps depsRes

    readDep els =
      reject ("Invalid package name: " ++ show els)

    readAllDeps_ : SortedSet (List String) -> List String -> Promise (List (List String, PackageDeps))
    readAllDeps_ curr q =
      do
        packageDeps <- readDep q
        let allDeps = concat $ map (\(_, packageDep) => deps packageDep ++ dev packageDep) packageDeps
        let subDeps = foldl (\acc, (pkgName, _) => Set.insert pkgName acc) (the (SortedSet (List String)) Set.empty) allDeps
        let newDeps = difference subDeps curr
        let nextSet = Set.insert q curr
        res <- all $ map (readAllDeps_ (union nextSet newDeps)) (Set.toList newDeps)
        pure $ (q, packageDeps) :: (concat res)

export
readDeps : Package -> Promise PackageDeps
readDeps pkg =
  do
    depsRes <- read (pkgKey pkg packageDepKey)
    log ("Package Deps: " ++ show depsRes)
    expectResult $ fromMaybe (Right []) $ map parsePackageDeps depsRes

export
writeDeps : Package -> PackageDeps -> Promise ()
writeDeps pkg packageDeps =
  write (pkgKey pkg packageDepKey) (encodePackageDeps packageDeps)

export
writePackage : Package -> Promise ()
writePackage pkg =
  write (pkgVerKey pkg packageKey) (encodePackage pkg)

export
readPackage : String -> String -> Version -> Promise (Either String Package)
readPackage packageNS packageName version =
  do
    Just contents <- read (packageKey packageNS packageName version)
      | Nothing => pure $ Left "package not found"
    pure $ parsePackage contents

export
readVersions : String -> String -> Promise (List Version)
readVersions packageNS packageName =
  do
    depsRes <- read (packageDepKey packageNS packageName)
    deps <- expectResult $ fromMaybe (Right []) $ map parsePackageDeps depsRes
    pure $ map fst deps

export
latestVersion : String -> String -> Promise (Maybe Version)
latestVersion packageNS packageName =
  do
    versions <- readVersions packageNS packageName
    pure $ head' $ reverse $ sort $ versions --'

-- Note: there could be race conditions, and since this
--       is EV, it would be difficult to prevent overall
-- TODO: Validate account details on server-side
export
newAccount : Account -> Promise (Maybe (Int, String))
newAccount account =
  do
    Nothing <- read (accountKey (ns account))
      | Just _ => pure $ Just (400, "account already exists")
    write (accountKey (ns account)) (encode account)
    pure Nothing

export
readAccountHash : String -> Promise (Maybe (Algorithm, String))
readAccountHash ns =
  do
    Just accountToml <- read (accountKey ns)
      | Nothing => pure Nothing
    let Just account = Account.decode accountToml
      | Nothing => pure Nothing
    pure (Just $ (kdf account, hash account))

export
readSession : String -> Promise (Maybe String)
readSession session =
  read (sessionKey session)

||| TODO: write session should have an expiration
export
writeSession : String -> String -> Promise ()
writeSession session ns =
  writeTTL (sessionKey session) ns sessionTTL


<|start_filename|>Client/Skeleton/BaseWithTest/Test/Suite.idr<|end_filename|>
module Client.Skeleton.BaseWithTest.Test.Suite

import Fmt

export
name : (String, String) -> List String
name = const ["Test", "Suite.idr"]

export
build : (String, String) -> String
build (packageNS, packageName) = fmt """
module Test.Suite

import IdrTest.Test

import Test.%sTest

suite : IO ()
suite = do
  runSuites
    [ Test.%sTest.suite
    ]
""" packageName packageName


<|start_filename|>Test/Server/Template/TemplateTest.idr<|end_filename|>
module Test.Server.Template.TemplateTest

import IdrTest.Test
import IdrTest.Expectation

import Server.Template.Template

%default total

export
suite : Test
suite =
  describe "Template Tests"
    [ test "Show Template" (\_ => assertEq
        (template "My Template <%% DESC %%>" [("DESC","Rocks")])
        "My Template Rocks"
      )
    ]


<|start_filename|>Base/IdrTest/IdrTest/Expectation.idr<|end_filename|>
module IdrTest.Expectation

import Color

public export
Expectation : Type
Expectation = Maybe String

export
assertEq : Show a => Eq a => a -> a -> Expectation
assertEq a b =
  if a == b then
    Nothing
  else
    Just ("Failed expectation, expected " ++ (decorate (Text Green) (show a)) ++ "=" ++ (decorate (Text Red) (show b)))

export
pass : Expectation
pass =
  Nothing

export
fail : String -> Expectation
fail err =
  Just ("Failed expectation: " ++ (decorate (Text Red) err))


<|start_filename|>Inigo/Package/PackageIndex.idr<|end_filename|>
module Inigo.Package.PackageIndex

import Data.List
import Data.Maybe
import Extra.Either
import Extra.List
import Extra.String
import Inigo.Package.ParseHelpers
import Inigo.Package.Package
import SemVar
import Toml

||| Information about a package in the index
public export
record PackageMeta where
  constructor MkPackageMeta
  ns : String
  package : String
  description : Maybe String
  version : Version

public export
PackageIndex : Type
PackageIndex = List PackageMeta

public export
Show PackageMeta where
  show (MkPackageMeta ns package description version) =
    "MkPackageMeta{ns=" ++ ns ++ ",package=" ++ package ++ ",description=" ++ (show description) ++ ",version=" ++ show version ++ "}"

public export
Eq PackageMeta where
  (MkPackageMeta ns0 package0 description0 version0) == (MkPackageMeta ns1 package1 description1 version1) =
    ns0 == ns1 && package0 == package1 && description0 == description1 && version0 == version1

parsePackageMetaToml : Toml -> Either String PackageMeta
parsePackageMetaToml toml =
  do
    ns <- string ["ns"] toml
    package <- string ["package"] toml
    description <- maybe (string ["description"] toml)
    versionStr <- string ["version"] toml
    version <- expect ("Invalid version: " ++ versionStr) (parseVersion versionStr)
    pure $ MkPackageMeta ns package description version

parsePackageIndexToml : Toml -> Either String PackageIndex
parsePackageIndexToml toml =
  case get ["pkg"] toml of
    Just (ArrTab arr) =>
      map reverse (foldl parseIndex (Right []) arr)
    _ =>
      Left "invalid package index `pkg` key"
  where
    parseIndex : Either String PackageIndex -> Toml -> Either String PackageIndex
    parseIndex accE toml =
      do
        acc <- accE
        packageMeta <- parsePackageMetaToml toml
        pure $ (packageMeta :: acc)

export
parsePackageIndex : String -> Either String PackageIndex
parsePackageIndex pkgIndexToml =
  do
    toml <- expect "Failed to parse PackageIndex Toml" $ parseToml pkgIndexToml
    parsePackageIndexToml toml

export
toToml : PackageIndex -> Toml
toToml pkgIndex =
  [ (["pkg"], ArrTab $ map toTomlPkg pkgIndex) ]
  where
    toTomlPkg : PackageMeta -> Toml
    toTomlPkg pkgMeta =
      mapMaybe id
        [ Just (["ns"], Str (ns pkgMeta))
        , Just (["package"], Str (package pkgMeta))
        , map (\desc => (["description"], Str desc)) (description pkgMeta)
        , Just (["version"], Str (show . version $ pkgMeta))
        ]

export
searchPackageIndex : String -> PackageIndex -> PackageIndex
searchPackageIndex search index =
  filter (\x => searchMany (cleanup search) [package x, fromMaybe "" (description x)]) index
  where
    cleanup : String -> List Char
    cleanup =
      (map toLower) . unpack

    doSearch : String -> List Char -> Bool
    doSearch str lookup =
      findAll (cleanup str) lookup /= []

    searchMany : List Char -> List String -> Bool
    searchMany lookup [] = False
    searchMany lookup (x :: xs) = (doSearch x lookup) || (searchMany lookup xs)

||| Encode a package, for instance, after adding a new dep
export
encodePackageIndex : PackageIndex -> String
encodePackageIndex = encode . toToml

export
fromPackage : Package -> PackageMeta
fromPackage pkg =
  MkPackageMeta (ns pkg) (package pkg) (description pkg) (version pkg)

export
updatePackageMeta : PackageIndex -> Package -> PackageIndex
updatePackageMeta pkgIndex pkg =
  let
    meta = fromPackage pkg
    (found, res) = foldl (accumulate meta) (False, []) pkgIndex
  in
    if found then
      reverse res
    else
      reverse (meta :: res)
  where
    accumulate : PackageMeta -> (Bool, PackageIndex) -> PackageMeta -> (Bool, PackageIndex)
    accumulate meta (True, acc) el = (True, el :: acc)
    accumulate meta (False, acc) el =
      if ns el == ns pkg && package el == package pkg then
        (True, meta :: acc)
      else
        (False, el :: acc)


<|start_filename|>Server/InigoStatic/Static/main.css<|end_filename|>
body {
  background-color: #323c4f;
  color: #fff6ef;

  font-size: 1.2em;

  font-family: Monaco;
}

body nav {
  width: 100%;
  display: flex;
  flex-wrap: wrap;
}

body nav img {
  width: 130px;
  height: 130px;
  margin-right: 1em;
}

body nav a:not(.logo) {
  height: 130px;
  margin: 0 1.2em 0 1.2em;
  display: flex;
  justify-content: center;
  align-items: center;
}

body nav a:focus {
  outline: none;
}

body section#search {
  width: 100%;
  height: 100px;
  display: flex;
  align-items: center;
  justify-content: center;
}

body section#search form {
  flex-basis: 100%;
  display: flex;
  justify-content: center;
}

body section#search form input[type="text"] {
  flex-basis: 80%;
  max-width: 500px;
  border-right: none;
}

body section#search form input[type="submit"] {
  flex-basis: 20%;
  max-width: 100px;
}

input[type="submit"] {
  background-color: #fff6ef;
  border: 1px solid white;
  font-size: 20px;
  color: #323c4f;
  filter: brightness(80%);
}

input[type="text"] {
  padding: 10px 10px 10px 20px;
  border: 1px solid white;
  font-size: 20px;
  background-color: #323c4f;
  color: #fff6ef;
}

input[type="text"]::placeholder {
  color: #fff6ef;
  filter: brightness(70%);
}

input[type="text"]:focus {
  outline: none;
}

a {
  color: #5792ff;
  text-decoration: none;
  font-size: 0.95em;
}

a:hover {
  text-decoration: underline;
}

body article {
  margin: 2em auto 2em auto;
  min-height: 200px;
  max-width: 900px;
  width: 80%;
}

body article h1 {
  font-size: 2em;
  text-align: center;
}

body article p {
  margin-top: 30px;
}

tt {
  background-color: #fff6ef;
  color: #333;
  margin: 1px;
  padding: 1px;
  filter: brightness(90%);
}

pre {
  background-color: #fff6ef;
  color: #333;
  margin: 5px;
  padding: 5px;
  filter: brightness(90%);
}

/*body article img {
  width: 30%;
  max-width: 150px;
  margin-bottom: 20px;
  height: 150px;
}*/

/*body article img[alt*="!"] {
  width: 50%;
  max-width: 500px;
  margin-bottom: 20px;
  height: 300px;
  background-color: #88888811;
  margin: auto;
  display: block;
  border-radius: 25% 10%;
}*/

/*@media only screen and (max-device-width: 480px) {
  body article img {
    height: 100px;
  }

  body article img[alt*="!"] {
    height: 150px;
  }
}*/

ul {
  margin-top: 20px;
}

ul li {
  margin-left: 4px;
  margin-top: 8px;
}

/* CSS Reset */
html {
  box-sizing: border-box;
  font-size: 16px;
}

*, *:before, *:after {
  box-sizing: inherit;
}

body, h1, h2, h3, h4, h5, h6, p, ol, ul {
  margin: 1em 0 1em 0;
  padding: 0;
  font-weight: normal;
}

ol, ul {
  list-style: none;
}

img {
  max-width: 100%;
  height: auto;
}


<|start_filename|>Client/Action/Build.idr<|end_filename|>
module Client.Action.Build

import Inigo.Async.Base
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.CodeGen
import Inigo.Package.Package
import Inigo.Async.Package
import Inigo.Paths

export
writeIPkgFile : Promise Package
writeIPkgFile =
  do
    pkg <- Inigo.Async.Package.currPackage
    -- TODO: Only build if not exists ?
    fs_writeFile inigoIPkgPath (Package.Package.generateIPkg True Nothing pkg)
    pure pkg

export
runBuild : CodeGen -> Promise ()
runBuild codeGen =
    ignore $ system "idris2" ["--build", inigoIPkgPath, "--cg", toString codeGen] Nothing False True

export
build : CodeGen -> Promise ()
build codeGen =
  do
    pkg <- writeIPkgFile
    runBuild codeGen


<|start_filename|>Base/Fmt/Fmt.idr<|end_filename|>
module Fmt

import Data.String

%default total

-- From https://gist.github.com/chrisdone/672efcd784528b7d0b7e17ad9c115292

-- TODO: Add showables

public export
data Format
  = FInt Format
  | FString Format
  | FOther Char Format
  | FEnd

public export
format : List Char -> Format
format ('%' :: 'd' :: cs) = FInt (format cs)
format ('%' :: 's' :: cs) = FString (format cs)
format (c :: cs) = FOther c (format cs)
format [] = FEnd

public export
formatString : String -> Format
formatString = format . unpack

public export
interpFormat : Format -> Type
interpFormat (FInt f) = Int -> interpFormat f
interpFormat (FString f) = String -> interpFormat f
interpFormat (FOther _ f) = interpFormat f
interpFormat FEnd = String

public export
toFunction : (fmt : Format) -> String -> interpFormat fmt
toFunction (FInt f) a = \i => toFunction f (a ++ show i)
toFunction (FString f) a = \s => toFunction f (a ++ s)
toFunction (FOther c f) a = toFunction f (a ++ singleton c)
toFunction FEnd a = a

public export
fmt : (s : String) -> interpFormat (formatString s)
fmt s = toFunction (formatString s) ""


<|start_filename|>Inigo/Async/Promise.idr<|end_filename|>
module Inigo.Async.Promise

export
data Promise : Type -> Type where
  MkPromise : ((a -> IO ()) -> (String -> IO ()) -> IO ()) -> Promise a

export
Functor Promise where
  map f (MkPromise cmd) = MkPromise (\succ => \err => cmd (\x => succ (f x)) err)

mutual
  export
  Applicative Promise where
    pure x = MkPromise (\succ => \err => succ x)
    x <*> y = x >>= (\f => f <$> y)

  export
  Monad Promise where
    (MkPromise cmd) >>= f = MkPromise (\succ =>
                                        \err =>
                                                cmd (\x =>
                                                          let (MkPromise cmd_) = (f x)
                                                          in cmd_ succ err
                                                    ) err
                                      )

export
resolve : Promise a -> (a -> IO ()) -> (String -> IO ()) -> IO ()
resolve (MkPromise cmd) ok err =
  cmd ok err

export
run : Promise a -> IO ()
run p =
  resolve p (\_ => pure ()) (\err => putStrLn ("Error: " ++ err))

-- I can fold these, but that's a bit of an issue since
-- they will end up running sequentially, which is really
-- not the intent here, but for now...
export
all : List (Promise a) -> Promise (List a)
all promises =
  doAll promises
  where
    doAll : List (Promise a) -> Promise (List a)
    doAll (p :: ps) =
      do
        x <- p
        rest <- doAll ps
        pure (x :: rest)
    doAll [] = pure []

export
lift : a -> Promise a
lift x = MkPromise (\ok => \err => ok x)

export
liftIO : IO a -> Promise a
liftIO x = MkPromise (\ok => \err => x >>= ok)

export
parallel : Promise a -> Promise a -> Promise a
parallel (MkPromise s1) (MkPromise s2) = MkPromise $ \err => \cb => do
  s1 err cb
  s2 err cb

public export
promise : Type -> Type
promise a = (a -> IO ()) -> (String -> IO ()) -> PrimIO ()

export
promisify : promise a -> Promise a
promisify prim =
  MkPromise (\ok, err => primIO $ prim ok err)

export
boolToInt : Bool -> Int
boolToInt False = 0
boolToInt True = 1

<|start_filename|>Base/Extra/Test/Extra/ListTest.idr<|end_filename|>
module Test.Extra.ListTest

import IdrTest.Test
import IdrTest.Expectation

import Extra.List

export
suite : Test
suite =
  describe "List Extra Tests" [
    describe "Length" [
      test "Populated List" (\_ => assertEq
        (length [1,2,3])
        3
      ),
      test "Empty" (\_ => assertEq
        (length (the (List Int) []))
        0
      )
    ],
    describe "Range" [
      test "Simple Range" (\_ => assertEq
        (range 5)
        [0,1,2,3,4]
      ),
      test "Empty Range" (\_ => assertEq
        (range 0)
        []
      )
    ],
    describe "Zip with Index" [
      test "Simple List" (\_ => assertEq
        (zipWithIndex ['a', 'b', 'c', 'd'])
        [('a', 0), ('b', 1), ('c', 2), ('d', 3)]
      ),
      test "Empty List" (\_ => assertEq
        (zipWithIndex (the (List Int) []))
        []
      )
    ],
    describe "Find all" [
      test "Find all simple" (\_ => assertEq
        (findAll (unpack "abcbcd") (unpack "bc"))
        ([1, 3])
      )
    ],
    describe "Replace" [
      test "Replace simple" (\_ => assertEq
        (replace (unpack "abcbcd") (unpack "bc") (unpack "zzz"))
        (unpack "azzzzzzd")
      )
    ]
  ]


<|start_filename|>Base/Extra/Extra/Buffer.idr<|end_filename|>
module Extra.Buffer

import Data.Buffer

%foreign "node:lambda:(buf)=>buf.toString('base64')"
enc64__prim : Buffer -> PrimIO String

%foreign "node:lambda:(str)=>Buffer.from(str, 'base64')"
dec64__prim : String -> PrimIO Buffer

%foreign "node:lambda:(str)=>Buffer.from(str, 'utf-8')"
fromString__prim : String -> PrimIO Buffer

%foreign "node:lambda:(buf,char)=>buf.indexOf(char)"
indexOf__prim : Buffer -> Char -> PrimIO Int

export
enc64 : HasIO io => Buffer -> io String
enc64 =
  primIO . enc64__prim

export
dec64 : HasIO io => String -> io Buffer
dec64 =
  primIO . dec64__prim

export
fromString : HasIO io => String -> io Buffer
fromString =
  primIO . fromString__prim

export
indexOf : HasIO io => Char -> Buffer -> io (Maybe Int)
indexOf char buf =
  do
    res <- primIO (indexOf__prim buf char)
    if res < 0
      then pure $ Nothing
      else pure $ Just res

export
readAll : HasIO io => Buffer -> io String
readAll buf =
  do
    len <- rawSize buf
    x <- getString buf 0 len
    pure x

export
readLine : HasIO io => Buffer -> io (String, Maybe Buffer)
readLine buf =
  do
    Just index <- indexOf '\n' buf
      | Nothing =>  do
                        contents <- readAll buf
                        pure $ (contents, Nothing)
    Just (line, rest) <- splitBuffer buf (index + 1)
      | Nothing => pure $ ( "", Just buf ) -- Shrug
    contents <- readAll line
    pure $ (contents, Just rest)


<|start_filename|>Base/Markdown/Markdown/String.idr<|end_filename|>
module Markdown.String

import Data.Nat
import Text.Lexer
import Text.Quantity

%default total

export
headingSym : Lexer
headingSym
  = some (is '#')

export
imageSym : Lexer
imageSym
  = is '!'

export
newLine : Lexer
newLine = is '\n'

export
italicsSym : Lexer
italicsSym = is '_'

export
boldSym : Lexer
boldSym =
  count (exactly 2) (is '*')

export
link : Lexer
link =
      surround (is '[') (is ']') any
  <+> surround (is '(') (is ')') any

||| Note: we currently don't allow attributes
||| To do so, we might need to move this from the lexer into the parser
export
htmlOpenTag : Lexer
htmlOpenTag =
  surround (is '<') (is '>') alphaNum

export
htmlCloseTag : Lexer
htmlCloseTag =
  surround (exact "</") (is '>') alphaNum

export
pre : Lexer
pre = quote (is '`') (non newline)

export
codeFence : Lexer
codeFence = quote (exact "```") any

-- Grab the next non-newline character (even if it's special, like a *),
-- and then consume non-special characters until we find another special marker.
export
text : Lexer
text = (isNot '\n') <+> manyUntil (oneOf "_*\n<>#[]()`") any


<|start_filename|>Base/Toml/Toml/Tokens.idr<|end_filename|>
module Toml.Tokens

import public Text.Token

import Data.List
import Extra.String

public export
data TomlTokenKind
  = Keyword
  | Dot
  | StringLit
  | Number
  | Equals
  | LeftBracket
  | RightBracket
  | Comma
  | Comment
  | Whitespace

public export
Eq TomlTokenKind where
  Keyword == Keyword = True
  Dot == Dot = True
  StringLit == StringLit = True
  Number == Number = True
  Equals == Equals = True
  LeftBracket == LeftBracket = True
  RightBracket == RightBracket = True
  Comma == Comma = True
  Comment == Comment = True
  Whitespace == Whitespace = True
  _ == _ = False

public export
TomlToken : Type
TomlToken = Token TomlTokenKind

public export
TokenKind TomlTokenKind where
  TokType Keyword = String
  TokType Dot = ()
  TokType StringLit = String
  TokType Number = Int
  TokType Equals = ()
  TokType LeftBracket = ()
  TokType RightBracket = ()
  TokType Comma = ()
  TokType Comment = ()
  TokType Whitespace = ()

  tokValue Keyword str = str
  tokValue Dot x = ()
  tokValue StringLit str = unquote str
  tokValue Number x = cast x
  tokValue Equals x = ()
  tokValue LeftBracket x = ()
  tokValue RightBracket x = ()
  tokValue Comma x = ()
  tokValue Comment x = ()
  tokValue Whitespace x = ()

export
Show TomlToken where
  show (Tok Keyword x) = "Keyword " ++ (quote x)
  show (Tok Dot x) = "Dot " ++ (quote x)
  show (Tok StringLit str) = "StringLit " ++ (quote str)
  show (Tok Number x) = "Number " ++ (show x)
  show (Tok Equals x) = "Equals " ++ (quote x)
  show (Tok LeftBracket x) = "LeftBracket " ++ (quote x)
  show (Tok RightBracket x) = "RightBracket " ++ (quote x)
  show (Tok Comma x) = "Comma " ++ (quote x)
  show (Tok Comment x) = "Comment " ++ (quote x)
  show (Tok Whitespace x) = "Whitespace " ++ (quote x)

export
Eq TomlToken where
  (Tok Keyword x0) == (Tok Keyword x1) = x0 == x1
  (Tok Dot x0) == (Tok Dot x1) = True
  (Tok StringLit x0) == (Tok StringLit x1) = x0 == x1
  (Tok Number x0) == (Tok Number x1) = x0 == x1
  (Tok Equals x0) == (Tok Equals x1) = True
  (Tok LeftBracket x0) == (Tok LeftBracket x1) = True
  (Tok RightBracket x0) == (Tok RightBracket x1) = True
  (Tok Comma x0) == (Tok Comma x1) = True
  (Tok Comment x0) == (Tok Comment x1) = x0 == x1
  (Tok Whitespace x0) == (Tok Whitespace x1) = True
  _ == _ = False


<|start_filename|>Client/Action/Login.idr<|end_filename|>
module Client.Action.Login

import Client.Server
import Client.Util
import Data.Buffer
import Extra.Buffer
import Inigo.Async.Base
import Inigo.Async.Fetch
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Util.Url.Url

loginAccountCall : Server -> String -> String -> Promise ()
loginAccountCall server ns passphrase =
  do
    let url = toString (fromHostPath (host server) (accountLoginUrl ns))
    sessionBuf <- assertOk url $ request url "POST" passphrase []
    session <- liftIO $ readAll sessionBuf
    Just sessionFile <- liftIO $ inigoSessionFile
      | Nothing => reject "Login requires $INIGO_SESSION, $INIGO_HOME or $HOME dir"
    fs_writeFile sessionFile session
    log "You are logged into Inigo"
    pure ()

export
loginAccount : Server -> String -> String -> Promise ()
loginAccount =
  loginAccountCall


<|start_filename|>Server/InigoServer/Util.idr<|end_filename|>
module Server.InigoServer.Util

import Data.Either
import Data.String
import Inigo.Async.Base
import Inigo.Async.CloudFlare.Worker
import Inigo.Async.Promise
import Inigo.Package.PackageIndex
import Server.Template.Template

export
renderLayout : String -> String -> String
renderLayout layout contents =
  if layout == "" then -- Allow empty or missing layout
    contents
  else
    template layout [("CONTENTS", contents)]

export
sniffContentType : String -> Headers
sniffContentType path =
  if isSuffixOf ".css" path
    then [("Content-Type", "text/css")]
    else if isSuffixOf ".svg" path
      then [("Content-Type", "image/svg+xml")]
      else []

export
withIndex : String -> String
withIndex "/" = "/home"
withIndex s = s

export
buildPkgLink : PackageMeta -> String
buildPkgLink (MkPackageMeta ns package description version) =
  let
    qualifiedName = ns ++ "." ++ package
    packagePath = "/packages/" ++ ns ++ "/" ++ package
    desc = case description of
      Just d =>
        " - " ++ d

      Nothing =>
        ""
  in
    " * [" ++ qualifiedName ++ "](" ++ packagePath ++ ")" ++ desc

||| Helpful default function for kv which returns empty strings
export
def : a -> (String -> a) -> String -> a
def d f "" = d
def d f str = f str

||| Raise an Either to a promise of its right prong
export
expectResult : Show err => Either err a -> Promise a
expectResult (Right x) = lift x
expectResult (Left err) = reject (show err)

||| Raise an Either to a promise of its right prong
export
expect : Show err => err -> Maybe a -> Promise a
expect err x = expectResult (maybeToEither err x)


<|start_filename|>Base/Color/Color.idr<|end_filename|>
module Color

public export
data Color : Type where
  Black : Color
  Red : Color
  Green : Color
  Yellow : Color
  Blue : Color
  Magenta : Color
  Cyan : Color
  White : Color

public export
data Decorator : Type where
  Reset : Decorator
  Text : Color -> Decorator
  BG : Color -> Decorator
  Bold : Decorator
  Underline : Decorator
  Reversed : Decorator
  Both : Decorator -> Decorator -> Decorator

export %inline
(<&>) : Decorator -> Decorator -> Decorator
(<&>) = Both
infixr 5 <&>

ctrl : String -> String
ctrl =
  strCons (chr 27)

export
init : Decorator -> String
init Reset = ctrl "[0m"
init Bold = ctrl "[1m"
init Underline = ctrl "[4m"
init Reversed = ctrl "[7m"
init (Text Black) = ctrl "[30m"
init (Text Red) = ctrl "[31m"
init (Text Green) = ctrl "[32m"
init (Text Yellow) = ctrl "[33m"
init (Text Blue) = ctrl "[34m"
init (Text Magenta) = ctrl "[35m"
init (Text Cyan) = ctrl "[36m"
init (Text White) = ctrl "[37m"
init (BG Black) = ctrl "[40m"
init (BG Red) = ctrl "[41m"
init (BG Green) = ctrl "[42m"
init (BG Yellow) = ctrl "[43m"
init (BG Blue) = ctrl "[44m"
init (BG Magenta) = ctrl "[45m"
init (BG Cyan) = ctrl "[46m"
init (BG White) = ctrl "[47m"
init (Both a b) = init a ++ init b

export
fin : Decorator -> String
fin Reset = ""
fin (Both a b) = fin a ++ fin b
fin _ = init Reset

export
decorate : Decorator -> String -> String
decorate d str = (init d) ++ str ++ (fin d)


<|start_filename|>Client/Action/Archive.idr<|end_filename|>
module Client.Action.Archive

import Data.Buffer
import Data.Maybe
import Extra.Buffer
import Inigo.Archive.Archive
import Inigo.Async.Archive
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Async.FS
import Inigo.Async.Package
import System.Path

export
buildArchive : String -> String -> Promise ()
buildArchive packageFile outFile =
  do
    package <- Inigo.Async.Package.readPackage packageFile
    Inigo.Async.Archive.saveArchive package (fromMaybe "" $ parent packageFile) outFile

export
extractArchive : String -> String -> Promise ()
extractArchive archiveFile outPath =
  do
    archive <- fs_readFileBuf archiveFile
    Inigo.Async.Archive.extractArchive archive outPath


<|start_filename|>Inigo/Async/Archive.idr<|end_filename|>
module Inigo.Async.Archive

import Data.Buffer
import Data.List
import Data.Maybe
import Data.String
import Extra.Buffer
import Extra.String
import Fmt
import Inigo.Archive.Archive as Archive
import Inigo.Archive.Path
import Inigo.Async.Base
import Inigo.Async.Compress.Brotli
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.Package
import System
import System.Path

-- Simple archive format for storing files compressed in Toml files

-- Overall, this file is still a bit complex and does
-- too much in promises, but it's a start

compressFileEnc64 : String -> Promise String
compressFileEnc64 path =
  do
    compressed <- compressFile path
    liftIO $ enc64 compressed

export
buildArchive : Package -> String -> Promise String
buildArchive package rootPath =
  do
    allFiles <- fs_getFilesR rootPath
    -- We're going to skip `ipkg` files
    let files = ignoreFiles allFiles
    enc <- all (map encodeFile files)
    pure (Archive.encode enc)
  where
    encodeFile : String -> Promise (List String, String)
    encodeFile file =
      do
        res <- compressFileEnc64 file
        let relPath = fromMaybe "" $ Path.dropBase rootPath file
        log (fmt "Archiving %s..." relPath)
        pure (splitPath relPath, res)

export
saveArchive : Package -> String -> String -> Promise ()
saveArchive package rootPath outFile =
  do
    contents <- buildArchive package rootPath
    fs_writeFile outFile contents
    log ("Wrote archive " ++ outFile)

decompressFile : String -> (List String, String) -> Promise ()
decompressFile outPath (filename, compressed) =
  do
    let resultFile = outPath </> (joinPath filename)
    buffer <- liftIO $ dec64 compressed
    res <- decompress buffer
    log ("Decompressing " ++ resultFile ++ "...")
    pure ()
    let resultDir = fromMaybe "" $ parent resultFile
    fs_mkdir True resultDir
    fs_writeFileBuf resultFile res

expect : String -> Maybe a -> Promise a
expect msg (Just val) = pure val
expect msg Nothing = reject msg

export
extractArchive : Buffer -> String -> Promise ()
extractArchive archive outPath =
  do
    contents <- liftIO (readAll archive)
    files <- expect "Failed to read archive" (Archive.decode contents)
    ignore $ all (map (decompressFile outPath) files)


<|start_filename|>Inigo/Package/ParseHelpers.idr<|end_filename|>
module Inigo.Package.ParseHelpers

import Toml

export
maybe : Either String a -> Either String (Maybe a)
maybe (Left err) = Right Nothing
maybe (Right val) = Right (Just val)

export
withDefault : a -> Either String a -> Either String a
withDefault x (Left err) = Right x
withDefault _ els = els

export
string : List String -> Toml -> Either String String
string key toml =
  case get key toml of
    Just (Str x) =>
      Right x

    _ =>
      Left ("Missing or invalid key: " ++ (show key))

export
listStr : List String -> Toml -> Either String (List String)
listStr key toml =
  case get key toml of
    Just (Lst l) =>
      foldl (\acc, el =>
        case (acc, el) of
          (Right l, Str s) =>
            Right (s :: l)
          (Left err, _) =>
            Left err
          _ =>
            Left ("Invalid value type for " ++ (show key))
      ) (Right []) l
    _ =>
      Left ("Missing or invalid key: " ++ (show key))


<|start_filename|>Client/Action/Check.idr<|end_filename|>
module Client.Action.Check

import Client.Action.Build
import Inigo.Async.Base
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Paths

export
check : Promise ()
check =
  do
    ignore writeIPkgFile
    ignore $ system "idris2" ["--typecheck", inigoIPkgPath] Nothing False False


<|start_filename|>Server/InigoServer/Server.idr<|end_filename|>
module Server.InigoServer.Server

import Inigo.Async.Base
import Inigo.Async.CloudFlare.Worker as Worker
import Inigo.Async.Promise
import Server.InigoServer.Handler

server : Promise ()
server =
  do
    Worker.serve handler
    never -- wait forever

export
main : IO ()
main =
  run server


<|start_filename|>Inigo/Async/Fetch.idr<|end_filename|>
module Inigo.Async.Fetch

import Data.Buffer
import Extra.Buffer
import Inigo.Async.Base
import Inigo.Async.Promise
import Inigo.Async.Util

%foreign (promisifyPrim "(url)=>new Promise((resolve,reject)=>(url.startsWith('https')?require('https'):require('http')).get(url,(r)=>{let d='';r.on('data',(c)=>{d+=c;});r.on('end',()=>{resolve(d)});}).on('error',(e)=>{reject(e);}))")
fetch__prim : String -> promise String

%foreign (promisifyPrim "(url)=>new Promise((resolve,reject)=>(url.startsWith('https')?require('https'):require('http')).get(url,(r)=>{let cs=[];r.on('data',(c)=>{cs.push(Buffer.from(c))});r.on('end',()=>{resolve(Buffer.concat(cs))});}).on('error',(e)=>{reject(e);}))")
fetchBuf__prim : String -> promise Buffer

%foreign (promisifyPrim ("(url,method,data,headers)=>new Promise((resolve,reject)=>{"++ toObject ++";let u=new URL(url);let port=u.port!==''?u.port:u.protocol==='https:'?443:80;let opts={hostname:u.hostname,port,path:u.pathname,method,headers:toObject(headers)};let req=(u.protocol==='https:'?require('https'):require('http')).request(opts,(r)=>{let cs=[];r.on('data',(c)=>{cs.push(Buffer.from(c))});r.on('end',()=>{resolve(__prim_js2idris_array([Buffer.from(r.statusCode.toString(), 'utf-8'), Buffer.concat(cs)]))});}).on('error',(e)=>reject(e));req.on('error',(e)=>reject(e));req.write(data);req.end();})"))
request__prim : String -> String -> Buffer -> List (String, String) -> promise (List Buffer)

export
fetch : String -> Promise String
fetch url =
  promisify (fetch__prim url)

export
fetchBuf : String -> Promise Buffer
fetchBuf url =
  promisify (fetchBuf__prim url)

convertStatusCode : List Buffer -> Promise (Int, Buffer)
convertStatusCode lb =
  case lb of
    statusBuf :: buf :: [] =>
      do
        status <- liftIO $ readAll statusBuf
        pure (cast status, buf)
    _ =>
      reject "Invalid response"

export
requestBuf : String -> String -> Buffer -> List (String, String) -> Promise (Int, Buffer)
requestBuf url method body headers =
  do
    res <- promisify (request__prim url method body headers)
    convertStatusCode res

export
request : String -> String -> String -> List (String, String) -> Promise (Int, Buffer)
request url method body headers =
  do
    buf <- liftIO $ fromString body
    res <- promisify (request__prim url method buf headers)
    convertStatusCode res


<|start_filename|>golden/Main.idr<|end_filename|>
module Main

import Test.Golden

%default covering

allTests : TestPool
allTests = MkTestPool "Name of the pool" [] Nothing
  [ "test001"
  , "test002"
  ]

main : IO ()
main = runner
  [ testPaths "inigo" allTests
  ] where
    testPaths : String -> TestPool -> TestPool
    testPaths dir = record { testCases $= map ((dir ++ "/") ++) }


<|start_filename|>Base/Toml/Toml/Lexer.idr<|end_filename|>
module Toml.Lexer

import Text.Lexer
import Text.Token

import public Toml.Tokens

%default total

stringLitSingle : Lexer
stringLitSingle = quote (is '\'') any

||| Recognise one or more characters that can comprise a keyword
||| /[A-Za-z0-9-_]+/
export
keyword : Lexer
keyword = some (pred (\x => isAlphaNum x || x == '-' || x == '_'))

tomlTokenMap : TokenMap TomlToken
tomlTokenMap = toTokenMap $
  [ (stringLit, StringLit)
  , (stringLitSingle, StringLit)
  , (digits, Number)
  , (keyword, Keyword)
  , (is '.', Dot)
  , (is '=', Equals)
  , (is '[', LeftBracket)
  , (is ']', RightBracket)
  , (is ',', Comma)
  , (is '#' <+> manyUntil newline any, Comment)
  , (spaces, Whitespace)
  ]

public export
lexToml : String -> Maybe (List $ WithBounds TomlToken)
lexToml str
  = case lex tomlTokenMap str of
         (tokens, _, _, "") => Just $ tokens
         _ => Nothing


<|start_filename|>Base/Markdown/Test/MarkdownTest.idr<|end_filename|>
module Test.MarkdownTest

import IdrTest.Test
import IdrTest.Expectation

import Markdown.Data
import Markdown

parserSpecs : List (String, String, Maybe Markdown)
parserSpecs =
  [ ( "Parse Header", "# test", Just $ Doc [Header 1 [Text " test"]] )
  , ( "Parse Short Paragraph", "test", Just $ Doc [Paragraph [Text "test"]] )
  , ( "Parse Paragraph", "test\n\n", Just $ Doc [Paragraph [Text "test"]] )
  , ( "Parse Two Paragraphs", "test\n\ntest2", Just $ Doc [Paragraph [Text "test"], Paragraph [Text "test2"]] )
  , ( "Parse Both", "# text\nand more\n\n", Just $ Doc [Header 1 [Text " text"], Paragraph [Text "and more"]] )
  , ( "Parse Bold then Italic", "## Well **hello** _there_", Just $ Doc [Header 2 [Text " Well ", Bold [Text "hello"], Text " ", Italics [Text "there"]]] )
  , ( "Parse a Link", "[here](http://example.com)", Just $ Doc [Paragraph [Link "here" "http://example.com"]] )
  , ( "Parse an Image", "![desc](http://example.com/img.svg)", Just $ Doc [Paragraph [Image "desc" "http://example.com/img.svg"]] )
  , ( "Parse HTML", "This is <sup>Super</sup>!", Just $ Doc [Paragraph [Text "This is ", Html "sup" [Text "Super"], Text "!"]] )
  , ( "Parse Non-HTML Brackets", "A < B > C <D E> >F< << >>", Just $ Doc [Paragraph [Text "A < B > C <D E> >F< << >>"]] )
  , ( "Parse Preformatted Text", "# Hello `john`\n```how\nare\nyou```", Just $ Doc [Header 1 [Text " Hello ", Pre "john"], Paragraph [CodeBlock "are\nyou" (Just "how")]] )
  , ( "Parse Spaced Start", "\n\n# test\n\n\n\n", Just $ Doc [Header 1 [Text " test"]] )
  ]

export
suite : Test
suite =
  let
    parserTests =
      map (\(name, text, result) =>
        test name (\_ => assertEq (parse text) result)
      ) parserSpecs
  in
  describe "Markdown"
    [ describe "Parser Specs" parserTests ]


<|start_filename|>Base/Extra/Extra/Op.idr<|end_filename|>
module Extra.Op

public export
(>>) : (a -> b) -> (b -> c) -> (a -> c)
(>>) f g = g . f
infixr 9 >>

public export
(|>) : a -> (a -> b) -> b
(|>) x f = f x
infixr 5 |>


<|start_filename|>Server/InigoServer/Handler.idr<|end_filename|>
module Server.InigoServer.Handler

import Data.Buffer
import Data.Either
import Data.List
import Data.Maybe
import Data.String
import Extra.Buffer
import Extra.Either
import Extra.String
import Fmt
import Inigo.Account.Account
import Inigo.Async.Base
import Inigo.Async.CloudFlare.KV as KV
import Inigo.Async.CloudFlare.Worker
import Inigo.Async.Package
import Inigo.Async.Promise
import Inigo.Async.SubtleCrypto.SubtleCrypto
import Inigo.Package.Package
import Inigo.Package.PackageDeps
import Inigo.Package.PackageIndex
import Markdown
import Markdown.Format.Html
import SemVar
import Server.InigoServer.KVOps as KVOps
import Server.InigoServer.Util as Util
import Server.Template.Template as Template
import Toml

limit : Nat
limit = 50

defaultHash : String -> Algorithm
defaultHash salt =
  PBKDF2 Sha256 salt 10000

-- TODO: While this is practical, we should
--       switch the server to use dependent types (e.g. App)
--       in order to clean up the mess of dependencies here
--       Note: this may be hard to do with Promises, but maybe
--       this can assist us in writing cleaner code!

-- TODO: Complete Request Data type
-- TODO: mapError
-- TODO: Parallel requests
handlePage : String -> List (String, String) -> Promise Response
handlePage path vars =
  do
    contents <- KV.read "pages" (Util.withIndex path)
    layout <- KV.read "static" "/layout.html" -- TODO: Request in paralel
    if contents == ""
      then pure (404, "Missing data for page", [])
      else do
        let tmplContents = Template.template contents vars
        case map toHtml $ Markdown.parse tmplContents of
          Nothing =>
            pure (500, "Failed to parse markdown", [])
          Just parsed =>
            pure (html (Util.renderLayout layout parsed))

handleApiArchive : String -> String -> Version -> Promise Response
handleApiArchive packageNS packageName version =
  do
    Just contents <- KVOps.readArchive packageNS packageName version
      | Nothing => pure (404, "not found", [])
    pure (200, contents, [])

handlePackageIndex : Promise Response
handlePackageIndex =
  do
    index <- KVOps.readIndex
    let packageList = map Util.buildPkgLink (take limit index)
    let vars = [("PACKAGES", join "\n" packageList)]
    handlePage "/packageIndex" vars

enumerate : String -> String -> Nat -> String
enumerate sing _ (S Z) = "1 " ++ sing
enumerate _ plur n = fmt "%d %s" (cast n) plur

handleSearch : String -> Promise Response
handleSearch term =
  do
    index <- KVOps.readIndex
    let packages = searchPackageIndex term index
    let packageList = map Util.buildPkgLink packages
    let vars =
      [ ("COUNT", enumerate "package" "packages" (length packageList))
      , ("TERM", term)
      , ("PACKAGES", join "\n" packageList)
      ]
    handlePage "/search" vars

handleApiPackageIndex : Promise Response
handleApiPackageIndex =
  do
    index <- KVOps.readIndex
    pure (200, encodePackageIndex index, [])

orLatestVersion : Maybe Version -> String -> String -> Promise (Maybe Version)
orLatestVersion (Just v) = const $ const $ lift (Just v)
orLatestVersion Nothing = latestVersion

handlePackage : String -> String -> (Maybe Version) -> Promise Response
handlePackage packageNS packageName maybeVersion =
  do
    Just version <- orLatestVersion maybeVersion packageNS packageName
      | Nothing => pure (404, "not found", [])
    Right pkg <- KVOps.readPackage packageNS packageName version
      | Left err => pure (500, err, [])
    readme <- KVOps.readReadme packageNS packageName version
    versions <- readVersions packageNS packageName
    let vars =
      [ ("NS", ns pkg)
      , ("PACKAGE", package pkg)
      , ("DESCRIPTION", fromMaybe "" $ description pkg)
      , ("EXT_DESCRIPTION", fromMaybe "" $ readme)
      , ("VERSION", show version)
      , ("VERSIONS", versionLinks versions)
      , ("LINK", fromMaybe "" $ map asLink (link pkg))
      , ("LICENSE", fromMaybe "" (license pkg))
      ]
    log ("Vars: " ++ show vars)
    handlePage "/package" vars
  where
    versionLink : Version -> String
    versionLink version = fmt " * [%s](/packages/%s/%s/%s)" (show version) packageNS packageName (show version)

    asLink : String -> String
    asLink link =
      fmt "[%s](%s)" link link

    versionLinks : List Version -> String
    versionLinks =
      join "\n" . map versionLink . reverse . sort

handleStatic : String -> Promise Response
handleStatic path =
  do
    contents <- KV.read "static" path
    let contentType = Util.sniffContentType path
    if contents == ""
      then pure (404, "Static page not found", [])
      else pure (200, contents, contentType)

handleAccountPost : String -> String -> Promise Response
handleAccountPost ns body =
  do
    Right (email, passphrase) <- getAccountValues body
      | Left res => pure res
    salt <- getRand 20
    let kdf = defaultHash salt
    hashedPassphrase <- hash kdf passphrase
    let Right account = mkAccount ns email kdf passphrase hashedPassphrase
      | Left err => pure (400, err, [])
    Nothing <- KVOps.newAccount account
      | Just (err, msg) => pure (err, msg, [])
    pure (200, "ok", [])
  where
    getAccountValues : String -> Promise (Either Response (String, String))
    getAccountValues body =
      do
        let Just toml = parseToml body
          | Nothing => pure $ Left (400, "Bad request: invalid body toml", [])
        let Just (Str email) = get ["email"] toml
          | _ => pure $ Left (400, "Bad request: missing email", [])
        let Just (Str passphrase) = get ["passphrase"] toml
          | _ => pure $ Left (400, "Bad request: missing passphrase", [])
        pure $ Right (email, passphrase)

handleAccountLoginPost : String -> String -> Promise Response
handleAccountLoginPost ns passphrase =
  do
    Just (kdf, accountHash) <- KVOps.readAccountHash ns
      | _ => pure (404, "not found", [])
    hashedInput <- hash kdf passphrase
    if accountHash == hashedInput
      then do
        session <- getRand 50
        KVOps.writeSession session ns
        pure (200, session, [])
      else
        pure (500, "unauthorized", [])

authenticate : String -> String -> Promise (Maybe Response)
authenticate session ns =
  do
    Just sessionNS <- KVOps.readSession session
      | Nothing => pure $ Just (500, "unauthorized", [])
    if sessionNS == ns
      then
        pure Nothing
      else
        pure $ Just (500, "unauthorized", [])

handleApiArchivePost : String -> String -> String -> Version -> String -> Promise Response
handleApiArchivePost session packageNS packageName version body =
  do
    Nothing <- authenticate session packageNS
      | Just res => pure res
    KVOps.writeArchive packageNS packageName version body
    pure (200, "ok", [])

handleApiReadmePost : String -> String -> String -> Version -> String -> Promise Response
handleApiReadmePost session packageNS packageName version body =
  do
    Nothing <- authenticate session packageNS
      | Just res => pure res
    KVOps.writeReadme packageNS packageName version body
    pure (200, "ok", [])

handleApiPackagePost : String -> String -> String -> Version -> String -> Promise Response
handleApiPackagePost session packageNS packageName version body =
  do
    Nothing <- authenticate session packageNS
      | Just res => pure res
    pkg <- expectResult (parsePackage body)
    -- Update package deps
    currDeps <- KVOps.readDeps pkg
    let nextDeps = updatePackageDep currDeps pkg
    KVOps.writeDeps pkg nextDeps
    -- Update current package
    KVOps.writePackage pkg
    -- Update index if latest
    let isLatest = (Just version) == (head' $ reverse $ sort $ map fst nextDeps) --'
    if isLatest
      then
        do
          -- Update the global index
          currIndex <- KVOps.readIndex
          let nextIndex = updatePackageMeta currIndex pkg
          KVOps.writeIndex nextIndex
      else pure ()
    pure (200, "ok", [])

handleApiPackageConf : String -> String -> Version -> Promise Response
handleApiPackageConf packageNS packageName version =
  do
    Right pkg <- KVOps.readPackage packageNS packageName version
      | Left err => pure (500, err, [])
    pure (200, encodePackage pkg, [])

handleApiPackageDeps : String -> String -> Promise Response
handleApiPackageDeps packageNS packageName =
  do
    deps <- KVOps.readAllDeps packageNS packageName
    log ("Deps: " ++ show deps)
    -- TODO: Better encoding here
    let res = join "\n\n" $ map (\(pkg, deps) => fmt "['%s']\n%s" (join "." pkg) (encodePackageDeps deps)) deps
    pure (200, res, [])

getVersion : String -> Promise Version
getVersion str =
  case parseVersion str of
    Just version =>
      pure version

    Nothing =>
      reject ("Invalid version: " ++ str)

getSession : List (String, String) -> Promise String
getSession headers =
  case map (split ' ' . snd) $ find ((== "authorization") . fst) headers of
    Just ["Basic", session] =>
      pure session
    _ =>
      reject ("Authorization Required")

export
handler : String -> String -> List (String, String) -> List (String, String) -> Promise Response
handler path body params headers =
  do
    log ("Request Path: " ++ path ++ ", params=" ++ show params)
    case drop 1 (split '/' path) of
      ["api", "archive", ns, package, version] =>
        handleApiArchive ns package !(getVersion version)

      ["api", "archive", ns, package, version, "post"] =>
        handleApiArchivePost !(getSession headers) ns package !(getVersion version) body

      ["api", "readme", ns, package, version, "post"] =>
        handleApiReadmePost !(getSession headers) ns package !(getVersion version) body

      ["api", "packages"] =>
        handleApiPackageIndex

      ["api", "packages", ns, package, version, "post"] =>
        handleApiPackagePost !(getSession headers) ns package !(getVersion version) body

      ["api", "packages", ns, package, version, "conf"] =>
        handleApiPackageConf ns package !(getVersion version)

      ["api", "packages", ns, package, "deps"] =>
        handleApiPackageDeps ns package

      ["search"] =>
        case params of
          ("term", term) :: _ =>
            handleSearch term
          _ =>
            pure (404, "Missing search term", [])

      ["packages"] =>
        handlePackageIndex

      ["packages", ns, package] =>
        handlePackage ns package Nothing

      ["packages", ns, package, version] =>
        handlePackage ns package (Just !(getVersion version))

      ["api", "account", ns, "post"] =>
        handleAccountPost ns body

      ["api", "account", ns, "login"] =>
        handleAccountLoginPost ns body

      _ =>
        do
          staticResponse <- handleStatic path
          case staticResponse of
            (200, _, _) =>
              pure $ staticResponse
            _ =>
              handlePage path []


<|start_filename|>Base/Markdown/Markdown/Lexer.idr<|end_filename|>
module Markdown.Lexer

import Data.List1

import Text.Lexer
import Text.Token
import Text.Bounded

import Markdown.String
import public Markdown.Tokens

%default total

private
markdownTokenMap : TokenMap MarkdownToken
markdownTokenMap = toTokenMap $
  [ (codeFence, MdCodeBlock)
  , (pre, MdPre)
  , (headingSym, HeadingSym)
  , (italicsSym, ItalicsSym)
  , (boldSym, BoldSym)
  , (imageSym, ImageSym)
  , (link, MdLink)
  , (htmlCloseTag, HtmlCloseTag)
  , (htmlOpenTag, HtmlOpenTag)
  , (newLine, NewLine)
  , (text, MdText)
  ]

||| Combine consecutive `MdText` nodes into one
combineText : List (WithBounds MarkdownToken) -> List (WithBounds MarkdownToken)
combineText [] = []
combineText (el :: rest) =
  let
    init = (List1.singleton el, el)
  in
    forget $ reverse $ fst $ (foldl accumulate init rest)
  where
    accumulate : (List1 $ WithBounds MarkdownToken, WithBounds MarkdownToken) -> WithBounds MarkdownToken -> (List1 $ WithBounds MarkdownToken, WithBounds MarkdownToken)
    accumulate (acc0 ::: acc1, last) el =
      case (last, el) of
        ( (MkBounded (Tok MdText a) isIrr (MkBounds startLine startCol _ _)),
          (MkBounded (Tok MdText b) _     (MkBounds _ _ endLine endCol)))
          => let
               combined = (MkBounded (Tok MdText (a ++ b)) isIrr (MkBounds startLine startCol endLine endCol))
             in (combined ::: acc1, combined)
        _ =>
          (el ::: acc0 :: acc1, el)

public export
lexMarkdown : String -> Maybe (List $ WithBounds MarkdownToken)
lexMarkdown str
  = case lex markdownTokenMap str of
         (tokens, _, _, "") => Just $ combineText $ tokens
         _ => Nothing


<|start_filename|>Client/Action/Register.idr<|end_filename|>
module Client.Action.Register

import Client.Util
import Client.Server
import Data.Buffer
import Inigo.Async.Fetch
import Inigo.Async.Promise
import Inigo.Util.Url.Url
import Toml

registerAccountCall : Server -> String -> String -> String -> Promise ()
registerAccountCall server ns email passphrase =
  do
    let contents = encode [(["email"], Str email), (["passphrase"], Str passphrase)]
    let url = toString (fromHostPath (host server) (accountPostUrl ns))
    ignore $ assertOk url $ request url "POST" contents []

export
registerAccount : Server -> String -> String -> String -> Promise ()
registerAccount =
  registerAccountCall


<|start_filename|>Client/Skeleton/Skeleton.idr<|end_filename|>
module Client.Skeleton.Skeleton

import Client.Skeleton.BaseWithTest.InigoTOML
import Client.Skeleton.BaseWithTest.Package
import Client.Skeleton.BaseWithTest.Test.Suite
import Client.Skeleton.BaseWithTest.Test.Test

public export
data Skeleton : Type where
  BaseWithTest : Skeleton

export
toString : Skeleton -> String
toString BaseWithTest = "BaseWithTest"

export
describe : Skeleton -> String
describe BaseWithTest = "base skeleton with tests"

export
fromString : String -> Maybe Skeleton
fromString "BaseWithTest" = Just BaseWithTest
fromString _ = Nothing

export
getFiles : Skeleton -> (String, String) -> List (List String, String)
getFiles BaseWithTest vars =
  [ ( Client.Skeleton.BaseWithTest.InigoTOML.name vars
    , Client.Skeleton.BaseWithTest.InigoTOML.build vars
    )
  , ( Client.Skeleton.BaseWithTest.Package.name vars
    , Client.Skeleton.BaseWithTest.Package.build vars
    )
  , ( Client.Skeleton.BaseWithTest.Test.Suite.name vars
    , Client.Skeleton.BaseWithTest.Test.Suite.build vars
    )
  , ( Client.Skeleton.BaseWithTest.Test.Test.name vars
    , Client.Skeleton.BaseWithTest.Test.Test.build vars
    )
  ]


<|start_filename|>Inigo/Async/Base.idr<|end_filename|>
module Inigo.Async.Base

import Data.Maybe
import Inigo.Async.Promise
import Inigo.Async.Util
import Inigo.Paths

%foreign (promisifyPrim "()=>new Promise((resolve,reject)=>{})")
never__prim : promise ()

%foreign (promisifyPrim "(_,err)=>new Promise((resolve,reject)=>reject(err))")
reject__prim : String -> promise a

%foreign (promisifyResolve "null" "(text)=>console.log(text)")
log__prim : String -> promise ()

%foreign (promisifyPrim (toArray "(cmd,args,workDir,detached,verbose)=>new Promise((resolve,reject)=>{let opts={detached:detached===1, stdio: ['ignore', process.stdout, process.stderr],cwd:workDir};require('child_process').spawn(cmd, toArray(args), opts).on('close', (code) => resolve(code))})"))
system__prim : String -> List String -> String -> Int -> Int -> promise Int

%foreign (promisifyPrim (toArray "(cmd,args,detached,verbose)=>new Promise((resolve,reject)=>{let opts={detached:detached===1, stdio: 'inherit'};require('child_process').spawn(cmd, toArray(args), opts).on('close', (code) => resolve(code))})"))
systemWithStdIO__prim : String -> List String -> Int -> Int -> promise Int

export
never : Promise ()
never =
  promisify never__prim

export
reject : String -> Promise a
reject err =
  promisify (reject__prim err)

export
log : String -> Promise ()
log text =
  promisify (log__prim text)

export
debugLog : String -> Promise ()
debugLog text = when DEBUG $ log text

export
system : String -> List String -> Maybe String -> Bool -> Bool -> Promise Int
system cmd args cwd detached verbose =
  promisify (system__prim cmd args (fromMaybe "" cwd) (boolToInt detached) (boolToInt verbose))

export
systemWithStdIO : String -> List String -> Bool -> Bool -> Promise Int
systemWithStdIO cmd args detached verbose =
  promisify (systemWithStdIO__prim cmd args (boolToInt detached) (boolToInt verbose))

-- This is here and not in `Promise.idr` since it relies on `reject`
export
liftEither : Either String a -> Promise a
liftEither x =
  do
    let Right res = x
      | Left err => reject err
    pure res


<|start_filename|>Base/Toml/Test/Toml/DataTest.idr<|end_filename|>
module Test.Toml.DataTest

import IdrTest.Test
import IdrTest.Expectation

import Data.List
import Toml.Data

export
suite : Test
suite =
  describe "Toml Data Tests" []


<|start_filename|>Client/Action/BuildDeps.idr<|end_filename|>
module Client.Action.BuildDeps

import Client.Action.CacheDeps
import Data.List
import Data.SortedMap as Map
import Data.SortedSet as Set
import Data.String
import Fmt
import Inigo.Async.Base
import Inigo.Async.Package
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Paths
import Inigo.PkgTree
import SemVar

buildIPkg : String -> Promise ()
buildIPkg path =
  do
    log (fmt "Compiling %s" (path </> inigoIPkgPath))
    debugLog "[\{path}]$ idris2 --build \{inigoIPkgPath}"
    0 <- system "idris2" ["--build", inigoIPkgPath] (Just path) False True
        | errno => reject "idris2 build error: \{show errno}"
    log (fmt "Compiled %s" (path </> inigoIPkgPath))

export
buildDeps : Bool -> Promise ()
buildDeps dev = do
    pkgs <- readDepCache
    pkg <- currPackage
    let ctxt = fromList pkgs
    log $ "Generating build order" ++ if dev then " with dev dependencies" else ""
    debugLog "Packages to build: \{show $ Set.toList $ keySet ctxt}"
    debugLog "Package context: \{show $ Map.toList $ getDeps {name=String} dev <$> ctxt}"
    build <- liftEither $ getBuildOrder dev ctxt (keySet ctxt)
    traverse_ buildIPkg build


<|start_filename|>Inigo/Package/PackageDeps.idr<|end_filename|>
module Inigo.Package.PackageDeps

import Data.List
import Data.Maybe
import Extra.Debug as Debug
import Extra.Either
import Extra.List
import Extra.Op
import Extra.String
import Inigo.Package.ParseHelpers
import Inigo.Package.Package
import SemVar
import Toml
import Toml.Data

||| Information about a package in the index
public export
record PackageDep where
  constructor MkPackageDep
  deps : List (List String, Requirement)
  dev : List (List String, Requirement)

public export
PackageDeps : Type
PackageDeps = List (Version, PackageDep)

public export
PackageDepTree : Type
PackageDepTree = List (List String, PackageDeps)

public export
Show PackageDep where
  show (MkPackageDep deps devDeps) =
    "MkPackageDep{deps=" ++ (show deps) ++ ",dev=" ++ (show devDeps) ++ "}"

public export
Eq PackageDep where
  (MkPackageDep deps0 dev0) == (MkPackageDep deps1 dev1) =
    deps0 == deps1 && dev0 == dev1

||| Helper function to group Toml values by the first part of each key
groupByHead : List (List String, Value) -> List (String, List (List String, Value))
groupByHead toml =
  let
    sorted = sortBy (\(k0, _), (k1, _) => compare k0 k1) toml
    results = foldl accumulate [] sorted
  in
    reverse $ map (\(head, vals) => (head, reverse vals)) results
  where
    accumulate : List (String, List (List String, Value)) -> (List String, Value) -> List (String, List (List String, Value))
    accumulate acc ([], _) = acc -- Skip empty keys
    accumulate [] (hd :: rest, val) = [(hd, [(rest, val)])]
    accumulate ((accKey, accValues) :: accRest) (hd :: rest, val) =
      if accKey == hd then
        (accKey, (rest, val) :: accValues) :: accRest
      else
        (hd, [(rest, val)]) :: (accKey, accValues) :: accRest

parsePackageDepsToml : Toml -> Either String PackageDeps
parsePackageDepsToml toml =
  map reverse $ collapse $ map parsePackageDep (groupByHead toml)
  where
    parsePackageDepToml : Toml -> Either String PackageDep
    parsePackageDepToml toml =
      do
        deps <- parseDeps ["deps"] toml
        devDeps <- parseDeps ["dev"] toml
        pure $ MkPackageDep deps devDeps

    parsePackageDep : (String, List (List String, Value)) -> Either String (Version, PackageDep)
    parsePackageDep (versionStr, depToml) =
      do
        version <- expect ("Invalid version: " ++ versionStr) (parseVersion versionStr)
        packageDep <- parsePackageDepToml depToml
        pure (version, packageDep)

export
parsePackageDeps : String -> Either String PackageDeps
parsePackageDeps pkgDepsToml =
  do
    toml <- expect "Failed to parse PackageDeps Toml" $ parseToml pkgDepsToml
    parsePackageDepsToml toml

export
parsePackageDepTree : String -> Either String PackageDepTree
parsePackageDepTree pkgDepsToml =
  do
    toml <- expect "Failed to parse PackageDeps Toml" $ parseToml pkgDepsToml
    foldl accumulate (Right []) (groupByHead toml)
  where
    accumulate : Either String PackageDepTree -> (String, Toml) -> Either String PackageDepTree
    accumulate (Left err) _ = Left err -- persist error
    accumulate (Right acc) (pkg, toml) =
      map (\packageDep => (split '.' pkg, packageDep) :: acc) (parsePackageDepsToml toml)

export
toToml : PackageDeps -> Toml
toToml =
  concat . map (\(version, (MkPackageDep deps dev)) =>
    showAllDeps version deps dev
    )
  where
    showDep : List String -> (List String, Requirement) -> (List String, Value)
    showDep keyHead (pkg, req) = (keyHead ++ pkg, Str $ show req)

    showDeps : Version -> String -> List (List String, Requirement) -> List (List String, Value)
    showDeps version key = map (showDep [show version, key])

    showAllDeps : Version -> List (List String, Requirement) -> List (List String, Requirement) -> List (List String, Value)
    showAllDeps version deps dev =
      (showDeps version "deps" deps) ++ 
      (showDeps version "dev" dev)

||| Encode a package, for instance, after adding a new dep
export
encodePackageDeps : PackageDeps -> String
encodePackageDeps = encode . toToml

export
fromPackage : Package -> PackageDep
fromPackage pkg =
  MkPackageDep (deps pkg) (devDeps pkg)

export
updatePackageDep : PackageDeps -> Package -> PackageDeps
updatePackageDep pkgDeps pkg =
  let
    pkgVersion = version pkg
    pkgDep = (pkgVersion, fromPackage pkg)
  in
    case break ((== pkgVersion) . fst) pkgDeps of
      (r, []) =>
        r ++ [pkgDep]
      (r, _ :: rest) =>
        r ++ (pkgDep :: rest)


<|start_filename|>Base/SemVar/SemVar/Lexer.idr<|end_filename|>
module SemVar.Lexer

import Text.Lexer
import Text.Token

import public SemVar.Tokens

%default total

private
semVarTokenMap : TokenMap SemVarToken
semVarTokenMap = toTokenMap $
  [ (is '~', Tilde)
  , (is '^', Caret)
  , (is '.', Dot)
  , (digits, Number)
  , (is '-', Hyphen)
  , (exact ">=", CmpGTE)
  , (exact "<=", CmpLTE)
  , (is '>', CmpGT)
  , (is '<', CmpLT)
  , (is '=', CmpEQ)
  , (exact "||", Pipe)
  , (is '+', Plus)
  , (some alphaNum, Text)
  , (is '*', Asterisk)
  , (spaces, Whitespace)
  ]

public export
lexSemVar : String -> Maybe (List $ WithBounds SemVarToken)
lexSemVar str
  = case lex semVarTokenMap str of
         (tokens, _, _, "") => Just $ tokens
         _ => Nothing


<|start_filename|>Server/Template/Template.idr<|end_filename|>
module Server.Template.Template

import Extra.String

-- Simple template library, can be vastly improved

ident : String -> String
ident k =
  "<%% " ++ k ++ " %%>"

export
template : String -> List (String, String) -> String
template tmpl =
  foldl (\acc, (k, v) => replace (ident k) v acc) tmpl


<|start_filename|>Base/Toml/Test/Suite.idr<|end_filename|>
module Test.Suite

import IdrTest.Test

import Test.Toml.DataTest
import Test.Toml.LexerTest
import Test.TomlTest

suite : IO ()
suite = do
  runSuites
    [ Test.Toml.LexerTest.suite
    , Test.Toml.DataTest.suite
    , Test.TomlTest.suite
    ]


<|start_filename|>Inigo/Async/CloudFlare/KV.idr<|end_filename|>
module Inigo.Async.CloudFlare.KV

import Inigo.Async.Promise
import Inigo.Async.Util

%foreign (promisifyPrim "(ns,key)=>this[ns] ? this[ns].get(key).then((r) => r || '') : Promise.reject('Unknown KV namespace ' + ns)")
read__prim : String -> String -> promise String

%foreign (promisifyPrim "(ns,key,value)=>this[ns] ? this[ns].put(key,value) : Promise.reject('Unknown KV namespace ' + ns)")
write__prim : String -> String -> String -> promise ()

%foreign (promisifyPrim "(ns,key,value,expirationTtl)=>this[ns] ? this[ns].put(key,value,{expirationTtl: expirationTtl}) : Promise.reject('Unknown KV namespace ' + ns)")
writeTTL__prim : String -> String -> String -> Int -> promise ()

export
read: String -> String -> Promise String
read ns key =
  promisify (read__prim ns key)

export
write: String -> String -> String -> Promise ()
write ns key value =
  promisify (write__prim ns key value)

export
writeTTL: String -> String -> String -> Int -> Promise ()
writeTTL ns key value ttl =
  promisify (writeTTL__prim ns key value ttl)


<|start_filename|>Client/Util.idr<|end_filename|>
module Client.Util

import Data.Buffer
import Extra.Buffer
import Fmt
import Inigo.Async.Base
import Inigo.Async.Promise
import System
import System.File
import System.Path

rejectStatus : String -> Int -> Buffer -> Promise a
rejectStatus url status buf =
  do
    contents <- liftIO $ readAll buf
    let extra = if status == 500 then " -- You may need to login again with `inigo login`" else ""
    reject (fmt "HTTP Failure (%d) from %s: \"%s\"%s" status url contents extra)

export
assertOk : String -> Promise (Int, Buffer) -> Promise Buffer
assertOk url result =
  do
    (200, buf) <- result
      | (status, res) => rejectStatus url status res
    pure buf


||| TODO: Improve home dir
export
getHomeDir : IO (Maybe String)
getHomeDir =
  do
    Nothing <- getEnv "INIGO_HOME"
      | Just home => pure $ Just home
    Nothing <- getEnv "HOME"
      | Just home => pure $ Just home
    pure Nothing

export
inigoSessionFile : IO (Maybe String)
inigoSessionFile =
  do
    Nothing <- getEnv "INIGO_SESSION"
      | Just sessionFile => pure (Just sessionFile)
    Just homeDir <- getHomeDir
      | Nothing => pure Nothing
    pure $ Just (homeDir </> ".inigo_session")

export
readSessionFile : IO (Maybe String)
readSessionFile =
  do
    Just sessionFile <- inigoSessionFile
      | Nothing => pure Nothing
    Right session <- readFile sessionFile
      | Left err => pure Nothing
    pure (Just session)

export
auth : String -> (String, String)
auth session =
  ("Authorization", "Basic " ++ session)


<|start_filename|>Base/Extra/Extra/Monad.idr<|end_filename|>
module Extra.Monad

||| Function to sequence two functors
||| TODO: Can we do this with applicative instead of monad?
export
map2 : Monad m => (a -> b -> c) -> m a -> m b -> m c
map2 f x y =
  join $ map (\x' => map (\y' => f x' y') y) x

||| Function to sequence three functors
export
map3 : Monad m => (a -> b -> c -> d) -> m a -> m b -> m c -> m d
map3 f x y z =
  (map2 f x y) <*> z


<|start_filename|>Base/SemVar/SemVar/Tokens.idr<|end_filename|>
module SemVar.Tokens

import public Text.Token

public export
data SemVarTokenKind
  = Tilde
  | Caret
  | Dot
  | Number
  | Hyphen
  | CmpGT
  | CmpLT
  | CmpEQ
  | CmpGTE
  | CmpLTE
  | Pipe
  | Plus
  | Text
  | Asterisk
  | Whitespace

public export
Eq SemVarTokenKind where
  (==) Tilde Tilde = True
  (==) Caret Caret = True
  (==) Dot Dot = True
  (==) Number Number = True
  (==) Hyphen Hyphen = True
  (==) CmpGT CmpGT = True
  (==) CmpLT CmpLT = True
  (==) CmpEQ CmpEQ = True
  (==) CmpGTE CmpGTE = True
  (==) CmpLTE CmpLTE = True
  (==) Pipe Pipe = True
  (==) Plus Plus = True
  (==) Text Text = True
  (==) Asterisk Asterisk = True
  (==) Whitespace Whitespace = True
  (==) _ _ = False

public export
SemVarToken : Type
SemVarToken = Token SemVarTokenKind

public export
TokenKind SemVarTokenKind where
  TokType Tilde = ()
  TokType Caret = ()
  TokType Dot = ()
  TokType Number = Int
  TokType Hyphen = ()
  TokType CmpGT = ()
  TokType CmpLT = ()
  TokType CmpEQ = ()
  TokType CmpGTE = ()
  TokType CmpLTE = ()
  TokType Pipe = ()
  TokType Plus = ()
  TokType Text = String
  TokType Asterisk = ()
  TokType Whitespace = ()

  tokValue Tilde x = ()
  tokValue Caret x = ()
  tokValue Dot x = ()
  tokValue Number x = cast x
  tokValue Hyphen x = ()
  tokValue CmpGT x = ()
  tokValue CmpLT x = ()
  tokValue CmpEQ x = ()
  tokValue CmpGTE x = ()
  tokValue CmpLTE x = ()
  tokValue Pipe x = ()
  tokValue Plus x = ()
  tokValue Text x = x
  tokValue Asterisk x = ()
  tokValue Whitespace x = ()

export
Show SemVarToken where
  show (Tok Tilde x) = "Tilde"
  show (Tok Caret x) = "Caret"
  show (Tok Dot x) = "Dot"
  show (Tok Number x) = "Number " ++ (show x)
  show (Tok Hyphen x) = "Hyphen"
  show (Tok CmpGT x) = "CmpGT"
  show (Tok CmpLT x) = "CmpLT"
  show (Tok CmpEQ x) = "CmpEQ"
  show (Tok CmpGTE x) = "CmpGTE"
  show (Tok CmpLTE x) = "CmpLTE"
  show (Tok Pipe x) = "Pipe"
  show (Tok Plus x) = "Plus"
  show (Tok Text x) = "Text " ++ x
  show (Tok Asterisk x) = "Asterisk"
  show (Tok Whitespace x) = "Whitespace"

export
Eq SemVarToken where
  (Tok Tilde x0) == (Tok Tilde x1) = True
  (Tok Caret x0) == (Tok Caret x1) = True
  (Tok Dot x0) == (Tok Dot x1) = True
  (Tok Number x0) == (Tok Number x1) = x0 == x1
  (Tok Hyphen x0) == (Tok Hyphen x1) = True
  (Tok CmpGT x0) == (Tok CmpGT x1) = True
  (Tok CmpLT x0) == (Tok CmpLT x1) = True
  (Tok CmpEQ x0) == (Tok CmpEQ x1) = True
  (Tok CmpGTE x0) == (Tok CmpGTE x1) = True
  (Tok CmpLTE x0) == (Tok CmpLTE x1) = True
  (Tok Pipe x0) == (Tok Pipe x1) = True
  (Tok Plus x0) == (Tok Plus x1) = True
  (Tok Text x0) == (Tok Text x1) = x0 == x1
  (Tok Asterisk x0) == (Tok Asterisk x1) = True
  (Tok Whitespace x0) == (Tok Whitespace x1) = True
  _ == _ = False


<|start_filename|>Inigo/Async/Compress/Brotli.idr<|end_filename|>
module Inigo.Async.Compress.Brotli

import Data.Buffer
import Extra.Buffer
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Async.Util

-- Compresses a String using Brotli, returning a Buffer
%foreign (promisifyPrim "(datum)=>{return require('util').promisify(require('zlib').brotliCompress)(datum)}")
brotli_compress__prim : Buffer -> promise Buffer

-- Decompresses a buffer encoded in Brotli, returning the original data
%foreign (promisifyPrim "(buf)=>require('util').promisify(require('zlib').brotliDecompress)(buf)")
brotli_decompress__prim : Buffer -> promise Buffer

export
compress: Buffer -> Promise Buffer
compress datum =
  promisify (brotli_compress__prim datum)

export
decompress: Buffer -> Promise Buffer
decompress buf =
  promisify (brotli_decompress__prim buf)

export
compressFile : String -> Promise Buffer
compressFile path =
  do
    contents <- fs_readFileBuf path
    compress contents


<|start_filename|>Base/SemVar/SemVar.idr<|end_filename|>
module SemVar

import SemVar.Lexer
import SemVar.Parser
import public SemVar.Data

import Text.Bounded

||| Parse a Version
export
parseVersion : String -> Maybe Version
parseVersion x = parseVersionToks !(lexSemVar x)

||| Parse a Requirement
export
parseRequirement : String -> Maybe Requirement
parseRequirement x = parseRequirementToks !(lexSemVar x)


<|start_filename|>Test/Suite.idr<|end_filename|>
module Test.Suite

import IdrTest.Test

import Test.Inigo.Account.AccountTest
import Test.Inigo.Archive.ArchiveTest
import Test.Inigo.Package.PackageDepsTest
import Test.Inigo.Package.PackageIndexTest
import Test.Inigo.Package.PackageTest
import Test.Server.Template.TemplateTest

suite : IO ()
suite = do
  runSuites
    [ Test.Inigo.Account.AccountTest.suite
    , Test.Inigo.Archive.ArchiveTest.suite
    , Test.Inigo.Package.PackageDepsTest.suite
    , Test.Inigo.Package.PackageIndexTest.suite
    , Test.Inigo.Package.PackageTest.suite
    , Test.Server.Template.TemplateTest.suite
    ]


<|start_filename|>Client/Client.idr<|end_filename|>
module Client.Client

import Client.Action.Archive
import Client.Action.Build
import Client.Action.BuildDeps
import Client.Action.Clean
import Client.Action.Check
import Client.Action.Exec
import Client.Action.FetchDeps
import Client.Action.Init
import Client.Action.Login
import Client.Action.Pull
import Client.Action.Push
import Client.Action.Register
import Client.Action.Repl
import Client.Action.Test
import Client.Server
import Client.Skeleton.Skeleton
import Client.Util
import Data.List
import Data.Maybe
import Data.String
import Extra.Either
import Extra.String
import Fmt
import Inigo.Account.Account
import Inigo.Async.Promise
import Inigo.Package.CodeGen
import SemVar
import System

||| TODO: Overall, this should be converted to a
|||       better dependently-typed CLI system
fail : String -> IO ()
fail str =
  do
    putStrLn str
    exitFailure

-- Note: not total
requirePrompt : String -> (String -> List String) -> IO String
requirePrompt prompt validator =
  do
    putStr prompt
    x <- map trim $ getLine
    case validator x of
      [] =>
        pure x
      errs =>
        do
          putStrLn (fmt "Invalid: %s\n" (join ", " errs))
          requirePrompt prompt validator

data Action : Type where
  Archive : String -> String -> Action
  Build : CodeGen -> Action
  BuildDeps : Bool -> Action
  Clean : Bool -> Action
  Check : Action
  Exec : CodeGen -> List String -> Action
  Extract : String -> String -> Action
  FetchDeps : Server -> Bool -> Bool -> Action
  Init :
    String -> -- template file
    String -> -- package ns
    String -> -- package name
    Action
  Login : Server -> Action
  Pull : Server -> String -> String -> (Maybe Version) -> Action
  Push : Server -> String -> Action
  Register : Server -> Action
  Repl : Action
  Test : CodeGen -> Action

fetchDepsAction : String -> Bool -> Bool -> Maybe Action
fetchDepsAction serverName includeDevDeps build =
  do
    server <- getServer serverName
    pure $ FetchDeps server includeDevDeps build

getAction : List String -> Maybe Action
getAction ["archive", packageFile, outFile] =
  Just (Archive packageFile outFile)

getAction ["extract", archiveFile, outPath] =
  Just (Extract archiveFile outPath)

getAction ("build-deps" :: args) =
  let
    dev = any (== "--dev") args
  in
    Just (BuildDeps dev)

getAction ["build", codeGen] =
  do
    codeGen <- getCodeGen codeGen
    pure $ Build codeGen

getAction ["build"] =
  Just (Build Node)

getAction ["clean"] =
  Just (Clean False)

getAction ["clean", "deps"] =
  Just (Clean True)

getAction ["check"] =
  Just Check

getAction ("exec" :: args) =
  do
    let (execArgs, progArgs) = splitArgs args
    case execArgs of
      [] => Just (Exec Node progArgs)
      [cg] => Just (Exec !(getCodeGen cg) progArgs)
      _ => Nothing
  where
    splitArgs : List String -> (List String, List String)
    splitArgs [] = ([], [])
    splitArgs ("--" :: args) = ([], args)
    splitArgs (arg :: args) = mapFst (arg ::) (splitArgs args)

getAction ("fetch-deps" :: serverName :: extraArgs) =
  let
    build = not $ any (== "--no-build") extraArgs
    includeDevDeps = any (== "--dev") extraArgs
  in
    fetchDepsAction serverName includeDevDeps build

getAction ["push", serverName, archive] =
  do
    server <- getServer serverName
    pure $ Push server archive

getAction ["pull", serverName, packageNS, packageName] =
  do
    server <- getServer serverName
    pure $ Pull server packageNS packageName Nothing

getAction ["pull", serverName, packageNS, packageName, versionStr] =
  do
    server <- getServer serverName
    version <- parseVersion versionStr
    pure $ Pull server packageNS packageName (Just version)

getAction ["test", codeGen] =
  do
    codeGen <- getCodeGen codeGen
    pure $ Test codeGen

getAction ["test"] =
  pure $ Test Node

getAction ["register", serverName] =
  do
    server <- getServer serverName
    pure $ Register server

getAction ["repl"] =
    pure Repl

getAction ["login", serverName] =
  do
    server <- getServer serverName
    pure $ Login server

getAction ["init", packageNS, packageName, tmplFile] =
  Just (Init tmplFile packageNS packageName)

getAction _ = Nothing

getActionIO : IO (Maybe Action)
getActionIO =
  map (getAction . drop 2) getArgs

runAction : Action -> IO ()
runAction (Archive packageFile outFile) =
  do
    putStrLn ("Archiving " ++ packageFile ++ " to " ++ outFile)
    run (buildArchive packageFile outFile)

runAction (Extract archiveFile outPath) =
  do
    putStrLn ("Extracting " ++ archiveFile ++ " from " ++ outPath)
    run (extractArchive archiveFile outPath)

runAction (BuildDeps dev) =
  run $ buildDeps dev

runAction (Build codeGen) =
  run (build codeGen)

runAction (Clean deps) =
  run (clean deps)

runAction Check =
  run check

runAction (Exec codeGen userArgs) =
  run (exec codeGen True userArgs) -- TODO: Make build a flag

runAction (FetchDeps server includeDevDeps build) =
  do
    putStrLn ("Feching deps from " ++ toString server ++ (if includeDevDeps then " including dev deps" else ""))
    run $ fetchAllDeps server includeDevDeps build

runAction (Push server archive) =
  do
    Just session <- readSessionFile
      | Nothing => fail "Must be logged in to push package."
    putStrLn ("Pushing " ++ archive ++ " to " ++ toString server)
    run (push server session archive)

runAction (Pull server packageNS packageName mVersion) =
  do
    putStrLn (fmt "Pulling %s.%s [%s] from %s" packageNS packageName (show mVersion) (toString server))
    run (pull server packageNS packageName mVersion)

runAction (Register server) =
  do
    putStrLn "Welcome to Inigo. Let's create an account."
    ns <- requirePrompt "Namespace [your username]: " nsValid
    email <- requirePrompt "Email: " emailValid
    passphrase <- requirePrompt "Passphrase: " passphraseValid
    putStrLn (fmt "Creating account %s..." ns)
    run (registerAccount server ns email passphrase)

runAction Repl = run repl

runAction (Login server) =
  do
    putStrLn "Welcome back to Inigo."
    ns <- requirePrompt "Namespace [your username]: " nsValid
    passphrase <- requirePrompt "Passphrase: " (const [])
    putStrLn "Logging in..."
    run (loginAccount server ns passphrase)

runAction (Init tmplFile packageNS packageName) = do
    putStrLn (fmt "Initializing new inigo application %s.%s from template %s" packageNS packageName tmplFile)
    run (init tmplFile packageNS packageName)

runAction (Test codeGen) =
  run (test codeGen)

short : Action -> String
short (Archive _ _)     = "archive <pkg_file> <out_file>: Archive a given package"
short (Build _)         = "build <code-gen=node>: Build program under given code gen"
short (BuildDeps _)     = "build-deps: Build all deps"
short (Clean _)         = "clean <deps?>: Clean package artifacts, optionally including deps"
short Check             = "check: Typecheck the project"
short (Exec _ _)        = "exec <code-gen=node> -- ...args: Execute program with given args"
short (Extract _ _)     = "extract <archive_file> <out_path>: Extract a given archive to directory"
short (FetchDeps _ _ _) = "fetch-deps <server>: Fetch and build all deps (opts: --no-build, --dev)"
short (Init _ _ _)      = "init <namespace> <package> <template.inigo>: Initialize a new project with given namespace and package name"
short (Login _)         = "login <server>: Login to an account"
short (Pull _ _ _ _)    = "pull <server> <package_ns> <package_name> <version?>: Pull a package from remote"
short (Push _ _)        = "push <server> <pkg_file>: Push a package to remote"
short (Register _)      = "register <server>: Register an account namespace"
short Repl              = "repl: Launch idris2 repl"
short (Test _)          = "test: Run tests via IdrTest"

usage : IO ()
usage =
  let
    descs = join "\n\t" $
      map short
        [ (Archive "" "")
        , (Build Node)
        , (BuildDeps False)
        , (Clean False)
        , Check
        , (Exec Node [])
        , (Extract "" "")
        , (FetchDeps Prod False False)
        , (Init "" "" "")
        , (Login Prod)
        , (Pull Prod "" "" Nothing)
        , (Push Prod "")
        , (Register Prod)
        , Repl
        , (Test Node)
        ]
  in
    fail ("usage: Inigo <command> <...args>\n\n\t" ++ descs)

main : IO ()
main =
  do
    Just action <- getActionIO
      | Nothing => usage
    runAction action


<|start_filename|>Client/Action/CacheDeps.idr<|end_filename|>
module Client.Action.CacheDeps

import Data.List
import Inigo.Async.Base
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Package.JSON
import Inigo.Paths
import Language.JSON
import SemVar

export
writeDepCache : List (String, Package) -> Promise ()
writeDepCache pkgWithSrcs = do
    fs_mkdir True inigoDepDir
    fs_writeFile inigoDepPkgCache json
  where
    encodeWithSrc : (String, Package) -> JSON
    encodeWithSrc (src, pkg) = JObject
        [ ("src", JString src)
        , ("package", encodePackage pkg)
        ]
    json : String
    json = show $ JArray $ encodeWithSrc <$> pkgWithSrcs

export
readDepCache : Promise (List (String, Package))
readDepCache = do
    inp <- fs_readFile inigoDepPkgCache
    let Just (JArray json) = parse inp
        | _ => reject "Corrupt dependency cache (\{inigoDepPkgCache}) (not an array)"
    let Just pkgWithSrc = the (Maybe (List (String, Package))) $ traverse decodeWithSrc json
        | _ => reject "Corrupt dependency cache (\{inigoDepPkgCache}) (couldn't parse packages)"
    pure pkgWithSrc
  where
    decodeWithSrc : JSON -> Maybe (String, Package)
    decodeWithSrc (JObject kvs) = do
        JString src <- lookup "src" kvs
            | _ => Nothing
        pkg <- lookup "package" kvs >>= parsePackage
        pure (src, pkg)
    decodeWithSrc _ = Nothing


<|start_filename|>Base/SemVar/Test/SemVar/LexerTest.idr<|end_filename|>
module Test.SemVar.LexerTest

import IdrTest.Test
import IdrTest.Expectation

import SemVar.Lexer

lexerSpecs : List (String, Maybe (List SemVarToken))
lexerSpecs =
  [
    (
      "1.2.3-prerelease+commit",
      Just $
      [ Tok Number "1"
      , Tok Dot "."
      , Tok Number "2"
      , Tok Dot "."
      , Tok Number "3"
      , Tok Hyphen "-"
      , Tok Text "prerelease"
      , Tok Plus "+"
      , Tok Text "commit"
      ]
    ),
    (
      "~1.2.3",
      Just $
      [ Tok Tilde "~"
      , Tok Number "1"
      , Tok Dot "."
      , Tok Number "2"
      , Tok Dot "."
      , Tok Number "3"
      ]
    ),
    (
      "^1.22.3",
      Just $
      [ Tok Caret "^"
      , Tok Number "1"
      , Tok Dot "."
      , Tok Number "22"
      , Tok Dot "."
      , Tok Number "3"
      ]
    ),
    (
      "1.*",
      Just $
      [ Tok Number "1"
      , Tok Dot "."
      , Tok Asterisk "*"
      ]
    ),
    (
      ">=1",
      Just $
      [ Tok CmpGTE ">="
      , Tok Number "1"
      ]
    ),
    (
      "1.2.3 - 2.3",
      Just $
      [ Tok Number "1"
      , Tok Dot "."
      , Tok Number "2"
      , Tok Dot "."
      , Tok Number "3"
      , Tok Whitespace " "
      , Tok Hyphen ""
      , Tok Whitespace " "
      , Tok Number "2"
      , Tok Dot "."
      , Tok Number "3"
      ]
    ),
    (
      "1.2.3 || 2.3",
      Just $
      [ Tok Number "1"
      , Tok Dot "."
      , Tok Number "2"
      , Tok Dot "."
      , Tok Number "3"
      , Tok Whitespace " "
      , Tok Pipe "||"
      , Tok Whitespace " "
      , Tok Number "2"
      , Tok Dot "."
      , Tok Number "3"
      ]
    )
  ]

export
suite : Test
suite =
  let
    lexerTests =
      map (\(text, result) =>
        test text (\_ => assertEq (lexSemVar text) result)
      ) lexerSpecs
  in
    describe "Lexer Tests"
      [ describe "Lexer Specs" lexerTests
      ]


<|start_filename|>Base/SemVar/Test/SemVar/SatTest.idr<|end_filename|>
module Test.SemVar.SatTest

import IdrTest.Test
import IdrTest.Expectation

import Data.List
import Data.Maybe
import Extra.List

import SemVar
import SemVar.Data
import SemVar.Parser
import SemVar.Sat

satSpecs : List (String, List (List String, (List (String, (List (List String, String))))), List (List String, String), Either String (List (List String, String)))
satSpecs =
  [
    (
      "Simple Dep Test",
      [ (["Dep1"],
          [ ("1.2.3", [(["Dep2"], "~3.0.0")])
          , ("1.2.4", [(["Dep2"], "~3.0.0")])
          , ("2.0.0", [(["Dep2"], "~3.1")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [])]
        )
      ],
      [ (["Dep1"], "^1.2.3")
      , (["Dep2"], "^3.0.0")
      ],
      Right [(["Dep1"], "1.2.3"), (["Dep2"], "3.0.0")]
    ),
    (
      "Simple Sub-Dep Test",
      [ (["Dep1"],
          [ ("1.2.3", [(["Dep2"], "~3.0.0")])
          , ("1.2.4", [(["Dep2"], "~3.0.0")])
          , ("2.0.0", [(["Dep2"], "~3.1")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [])]
        )
      ],
      [ (["Dep1"], "^1.2.3")
      ],
      Right [(["Dep1"], "1.2.3"), (["Dep2"], "3.0.0")]
    ),
    (
      "Simple Sub-Sub-Dep Test",
      [ (["Dep1"],
          [ ("1.2.3", [(["Dep2"], "~3.0.0")])
          , ("1.2.4", [(["Dep2"], "~3.0.0")])
          , ("2.0.0", [(["Dep2"], "~3.1")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [(["Dep3"], "=5.0.0")])]
        )
      , (["Dep3"],
          [ ("5.0.0", [])]
        )
      ],
      [ (["Dep1"], "^1.2.3")
      ],
      Right [(["Dep1"], "1.2.3"), (["Dep2"], "3.0.0"), (["Dep3"], "5.0.0")]
    ),
    -- This is where we can't just rely on head anymore
    (
      "More complex test where we force Dep2 and have to match Dep1",
      [ (["Dep1"],
          [ ("1.2.3", [(["Dep2"], "~3.0.0")])
          , ("1.2.4", [(["Dep2"], "~3.0.0")])
          , ("2.0.0", [(["Dep2"], "~3.1")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [])
          , ("3.1.0", [])
          ]
        )
      ],
      [ (["Dep1"], ">=0")
      , (["Dep2"], "=3.1.0")
      ],
      Right [(["Dep1"], "2.0.0"), (["Dep2"], "3.1.0")]
    ),
    (
      "Mutual constraints",
      [ (["Dep1"],
          [ ("1.2.3", [(["Dep2"], "~3.0.0")])
          , ("1.2.4", [(["Dep2"], "~3.0.0")])
          , ("2.0.0", [(["Dep2"], "~3.1")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [(["Dep1"], ">=0")])
          ]
        )
      ],
      [ (["Dep1"], ">=0")
      ],
      Right [(["Dep1"], "1.2.3"), (["Dep2"], "3.0.0")]
    ),
    (
      "Mutual incompatible constraints",
      [ (["Dep1"],
          [ ("1.0.0", [(["Dep2"], "=4.0.0")])
          , ("2.0.0", [(["Dep2"], "=3.0.0")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [(["Dep1"], "=1.0.0")])
          , ("4.0.0", [(["Dep1"], "=2.0.0")])
          ]
        )
      ],
      [ (["Dep1"], ">=0")
      ],
      Left "Package [\"Dep1\"] req =1.0.0 is incompatible"
    ),
    (
      "Simple Failing Dep",
      [ (["Dep1"],
          [ ("1.2.3", [(["Dep2"], "~3.0.0")])
          , ("1.2.4", [(["Dep2"], "~3.0.0")])
          , ("2.0.0", [(["Dep2"], "~3.1")])
          ]
        )
      , (["Dep2"],
          [ ("3.0.0", [])]
        )
      ],
      [ (["Dep1"], "^1.2.3")
      , (["Dep2"], "^4.0.0")
      ],
      Left "Cannot match [\"Dep2\"] req >=4.0.0 <5.0.0"
    )
  ]

mapSnd : (b -> c) -> List (a, b) -> List (a, c)
mapSnd f =
  map (\(x, y) => (x, f y))

liftTuple : (a, Maybe b) -> Maybe (a, b)
liftTuple (a, Just x) = Just (a, x)
liftTuple _ = Nothing

collapseEither : Either a (Maybe b) -> Maybe (Either a b)
collapseEither (Left x) = Just (Left x)
collapseEither (Right (Just y)) = Just (Right y)
collapseEither (Right Nothing) = Nothing

makeVersionNodes : List String -> List (String, List (List String, String)) -> Maybe (List (List String, Version, List (List String, Requirement)))
makeVersionNodes name versions =
  collapse $ map (mkVersion name) versions
  where
    mkVersion : List String -> (String, List (List String, String)) -> Maybe VersionNode
    mkVersion name (versionStr, reqStrList) =
      do
        version <- parseVersion versionStr
        reqs <- collapse $ map liftTuple $ mapSnd parseRequirement reqStrList
        pure (name, version, reqs)

||| TODO: Move to Extra
map2 : Monad m => (a -> b -> c) -> m a -> m b -> m c
map2 f x y =
  join $ map (\x' => map (\y' => f x' y') y) x

map3 : Monad m => (a -> b -> c -> d) -> m a -> m b -> m c -> m d
map3 f x y z =
  (map2 f x y) <*> z

compareBy : Ord b => (a -> b) -> (a -> a -> Ordering)
compareBy f =
  (\x, y => compare (f x) (f y))

export
suite : Test
suite =
  let
    satTests = map (\(name, versionSpec, reqSpec, expSpec) => 
      let
        mVersionNodes : Maybe (List VersionNode)
        mVersionNodes = foldl (\mAcc, (dep, versions) =>
            do
              acc <- mAcc
              x <- makeVersionNodes dep versions
              pure (x ++ acc)
          ) (the (Maybe (List VersionNode)) (Just [])) versionSpec

        mReqs : Maybe (List (List String, Requirement))
        mReqs = collapse $ map (\(dep, reqStr) => 
            map (\req => (dep, req)) $ parseRequirement reqStr
          ) reqSpec

        maybeParseDepReq : (List String, String) -> Maybe (List String, Version)
        maybeParseDepReq (dep, verStr) =
          map (\vers => (dep, vers)) $ parseVersion verStr

        mExp : Either String (Maybe (List (List String, Version)))
        mExp = map collapse (map (map maybeParseDepReq) expSpec)

        sort : Either String (List (List String, Version)) -> Either String (List (List String, Version))
        sort =
          map (sortBy (compareBy fst))
      in
        test name (\_ =>
          let
            t = map3 (\versionNodes, reqs, exp =>
              assertEq (sort $ satisfyAll versionNodes reqs) exp
              ) mVersionNodes mReqs (map sort $ collapseEither mExp)
            in
              fromMaybe (Just "Invalid set-up for test") t
        )
      ) satSpecs
  in
    describe "Sat Tests" satTests


<|start_filename|>Inigo/Package/Package.idr<|end_filename|>
module Inigo.Package.Package

import Data.List
import Data.Maybe
import Extra.Either
import Extra.List
import Extra.String
import Fmt
import public Inigo.Package.ExtraDep
import Inigo.Package.ParseHelpers
import Inigo.Paths
import Inigo.PkgTree
import SemVar
import System.Path
import Toml

public export
record Package where
  constructor MkPackage
  ns : String
  package : String
  version : Version
  description : Maybe String
  link : Maybe String
  readme : Maybe String
  modules : List String
  depends : List String
  license : Maybe String
  sourcedir : String
  main : Maybe String
  executable : Maybe String
  deps : List (List String, Requirement)
  devDeps : List (List String, Requirement)
  extraDeps : List ExtraDep

public export
Show Package where
  show pkg =
    "Package{" ++
      (join "" [
        "ns=", (show $ ns pkg),
        ", package=", (show $ package pkg),
        ", version=", (show $ version pkg),
        ", description=", (show $ description pkg),
        ", link=", (show $ link pkg),
        ", readme=", (limit 50 $ show $ readme pkg),
        ", modules=", (show $ modules pkg),
        ", depends=", (show $ depends pkg),
        ", license=", (show $ license pkg),
        ", sourcedir=", (show $ sourcedir pkg),
        ", main=", (show $ main pkg),
        ", executable=", (show $ executable pkg),
        ", deps=", (show $ deps pkg),
        ", dev-deps=", (show $ devDeps pkg),
        ", extra-deps=", (show $ extraDeps pkg)
      ]) ++ "}"

public export
Eq Package where
  (MkPackage ns0 package0 version0 description0 link0 readme0 modules0 depends0 license0 src0 main0 executable0 deps0 devDeps0 extraDeps0)
    == (MkPackage ns1 package1 version1 description1 link1 readme1 modules1 depends1 license1 src1 main1 executable1 deps1 devDeps1 extraDeps1) =
      ns0 == ns1 && package0 == package1 && version0 == version1 && description0 == description1 && link0 == link1 && readme0 == readme1 &&
      modules0 == modules1 && depends0 == depends1 && license0 == license1 && src0 == src1 && main0 == main1 && executable0 == executable1 &&
      deps0 == deps1 && devDeps0 == devDeps1 && extraDeps0 == extraDeps1

export
parseDeps : List String -> Toml -> Either String (List (List String, Requirement))
parseDeps key toml =
  foldl parseDepsAcc (Right []) (getToml key toml)
  where
    parseDepsAcc : Either String (List (List String, Requirement)) -> (List String, Value) -> Either String (List (List String, Requirement))
    parseDepsAcc accE (key, el) =
      case el of
        Str val =>
          do
            acc <- accE
            dep <- expect ("Invalid requirement: " ++ show key ++ "=" ++ show val) (parseRequirement val)
            pure $ (key, dep) :: acc
        _ =>
          Left ("Invalid dep found: " ++ show key)

||| Attempts to parse a package
export
parsePackage : String -> Either String Package
parsePackage pkgToml =
  do
    toml <- expect "failed to parse Toml" $ parseToml pkgToml
    ns <- string ["ns"] toml
    package <- string ["package"] toml
    versionStr <- string ["version"] toml
    version <- expect ("Invalid version: " ++ versionStr) (parseVersion versionStr)
    description <- maybe (string ["description"] toml)
    link <- maybe (string ["link"] toml)
    readme <- maybe (string ["readme"] toml)
    modules <- listStr ["modules"] toml
    depends <- listStr ["depends"] toml
    license <- maybe (string ["license"] toml)
    sourcedir <- withDefault "" (string ["sourcedir"] toml)
    main <- maybe (string ["main"] toml)
    executable <- maybe (string ["executable"] toml)
    deps <- parseDeps ["deps"] toml
    devDeps <- parseDeps ["dev-deps"] toml
    extraDeps <- parseExtraDeps toml
    pure (MkPackage ns package version description link readme modules depends license sourcedir main executable deps devDeps extraDeps)

-- TODO: Get deps better, e.g. pin instead of `&&`
export
toToml : Package -> Toml
toToml pkg =
  (mapMaybe id [
    Just (["ns"], Str (ns pkg)),
    Just (["package"], Str (package pkg)),
    Just (["version"], Str (show (version pkg))),
    map (\desc => (["description"], Str desc)) (description pkg),
    map (\link => (["link"], Str link)) (link pkg),
    map (\desc => (["readme"], Str desc)) (readme pkg),
    Just (["modules"], Lst (map Str (modules pkg))),
    Just (["depends"], Lst (map Str (depends pkg))),
    map (\license => (["license"], Str license)) (license pkg),
    Just (["sourcedir"], Str (sourcedir pkg)),
    map (\main => (["main"], Str main)) (main pkg),
    map (\executable => (["executable"], Str executable)) (executable pkg)
  ]) ++ (depsVal "deps" (deps pkg)) ++ (depsVal "dev-deps" (devDeps pkg))
  ++ toToml pkg.extraDeps
  where
    depsVal : String -> List (List String, Requirement) -> List (List String, Value)
    depsVal baseKey = map (\(key, req) => (baseKey :: key, Str (show req)))

||| Encode a package, for instance, after adding a new dep
export
encodePackage : Package -> String
encodePackage = encode . toToml

whenCons : Monoid a => List b -> a -> a
whenCons [] _ = neutral
whenCons _ x = x

-- ||| Generates an ipkg for compatibility with the native idris build system
export
generateIPkg : (includeExe : Bool) -> Maybe String -> Package -> String
generateIPkg exe depBuildDir pkg =
  let
    main = fromMaybe "" $ map ("\nmain = " ++) (main pkg)
    executable = if exe
        then fromMaybe "" $ map ("\nexecutable = " ++) (executable pkg)
        else ""
    modules' = whenCons pkg.modules $ fmt "modules = %s " $ join ", " (modules pkg)
    depends' = whenCons pkg.depends $ fmt "depends = %s " $ join ", " (depends pkg)
    buildDir = fromMaybe "build" depBuildDir
  in
    fmt """
package %s

%s
%s

sourcedir = %s
builddir = %s

version = %s%s%s
""" (package pkg) modules' depends' (quote pkg.sourcedir) (quote buildDir) (show $ version pkg) main executable

export
getDepsPackage : Bool -> Package -> List String
getDepsPackage dev pkg =
    let deps : List (List String, Requirement)
        deps = (if dev then pkg.devDeps else []) ++ pkg.deps
    in depsOnto pkg.extraDeps $ map ((inigoDepDir </>) . joinPath . Builtin.fst) deps
    where
    depsOnto : List ExtraDep -> List String -> List String
    depsOnto [] deps = deps
    depsOnto (ed :: eds) deps =
        let dir = getExtraDepDir ed
        in depsOnto eds $ map (dir </>) ed.subDirs ++ deps

export
HasDeps Package String where
    getDeps = getDepsPackage


<|start_filename|>Base/Color/Test/ColorTest.idr<|end_filename|>
module Test.ColorTest

import IdrTest.Test
import IdrTest.Expectation

import Color

simpleTest : Test
simpleTest =
  test "Red & Bold" (\_ => assertEq
    (decorate (Text Red <&> BG Blue <&> Bold) "Hello")
    "\ESC[31m\ESC[44m\ESC[1mHello\ESC[0m\ESC[0m\ESC[0m"
  )

export
suite : Test
suite =
  describe "Color Tests"
    [ simpleTest
    ]


<|start_filename|>Server/InigoStatic/localize.js<|end_filename|>
#!/bin/env node

const { promisify } = require('util');
const { resolve } = require('path');
const fs = require('fs');
const path = require('path');
const readdir = promisify(fs.readdir);
const stat = promisify(fs.stat);

let [_n, _f, dir, output] = process.argv;
let skipExt = !!process.env['SKIP_EXT'];

if (!dir || !output) {
  console.error("usage: ./localize.js <dir> <output>");
  console.error();
  process.exit(1);
}

async function getFiles(dir) {
  return await doGetFiles(dir, dir);
}

async function doGetFiles(dir, root) {
  const subdirs = await readdir(dir);
  const files = await Promise.all(subdirs.map(async (subdir) => {
    const res = resolve(dir, subdir);
    return (await stat(res)).isDirectory() ? doGetFiles(res, root) : path.relative(root, res);
  }));
  return files.reduce((a, f) => a.concat(f), []);
}

async function run(dir, output, skipExt) {
  let files = await getFiles(dir);
  let result = await files.reduce(async(acc, file) => {
    let contents = await fs.promises.readFile(path.join(dir, file), 'utf8');
    let key = '/' + file;
    if (skipExt) {
      key = key.replace(/[.].*$/, '');
    }
    return {
      ...await acc,
      [key]: contents
    }
  }, {});

  await fs.promises.writeFile(output, JSON.stringify(result, null, 2));

  console.log(`Updated ${output} with ${files.length} file(s)`);
}

run(dir, output, skipExt);


<|start_filename|>Client/Action/Exec.idr<|end_filename|>
module Client.Action.Exec

import Client.Action.Build
import Fmt
import Inigo.Async.Base
import Inigo.Async.Package
import Inigo.Async.Promise
import Inigo.Package.CodeGen as CodeGen
import Inigo.Package.Package
import System.Path

execDir : String
execDir =
  "build/exec"

-- TODO: Better handling of base paths
export
exec : CodeGen -> Bool -> List String -> Promise ()
exec codeGen build userArgs =
  do
    pkg <- Client.Action.Build.writeIPkgFile
    when build $ runBuild codeGen
    let Just e = executable pkg
      | Nothing => reject "No executable set in Inigo config"
    let (cmd, args) = CodeGen.cmdArgs codeGen (execDir </> e)
    log (fmt "Executing %s with args %s..." e (show userArgs))
    ignore $ systemWithStdIO cmd (args ++ userArgs) True True


<|start_filename|>Inigo/Paths.idr<|end_filename|>
module Inigo.Paths

import public System.Path

export
inigoTomlPath : String
inigoTomlPath = "Inigo.toml"

export
inigoDhallPath : String
inigoDhallPath = "Inigo.dhall"

export
inigoIPkgPath : String
inigoIPkgPath = "Inigo.ipkg"

export
inigoWorkDir : String
inigoWorkDir = "./.inigo-work"

export
inigoDepDir : String
inigoDepDir = inigoWorkDir </> "deps"

export
inigoDepPkgCache : String
inigoDepPkgCache = inigoWorkDir </> "deps.cache"

export
DEBUG : Bool
DEBUG = True


<|start_filename|>Inigo/Archive/Archive.idr<|end_filename|>
module Inigo.Archive.Archive

import Toml
import Data.List

export
encode : List (List String, String) -> String
encode =
	Toml.encode . map (\(k, v) => (k, Str v))

export
decode : String -> Maybe (List (List String, String))
decode toml =
	do
		doc <- parseToml toml
		res <- foldl accumulate (Just []) doc
		pure (reverse res)
	where
		accumulate : Maybe (List (List String, String)) -> (List String, Value) -> Maybe (List (List String, String))
		accumulate Nothing _ = Nothing
		accumulate (Just acc) (key, Str str) = Just ((key, str) :: acc)
		accumulate _ _ = Nothing


<|start_filename|>Base/Extra/Extra/Either.idr<|end_filename|>
module Extra.Either

import Data.Maybe

export
mapError : (a -> c) -> Either a b -> Either c b
mapError f e = either (Left . f) (Right . id) e

export
expect : a -> Maybe b -> Either a b
expect left =
  (fromMaybe $ Left left) . (map Right)

export
flipEither : Either a b -> Either b a
flipEither (Left x) = Right x
flipEither (Right x) = Left x


<|start_filename|>Base/Markdown/Markdown/Format/Html.idr<|end_filename|>
module Markdown.Format.Html

import Extra.String
import Markdown.Data

-- TODO: This probably isn't total
-- TODO: Make this safe
htmlElementProps : String -> List (String, String) -> String -> String
htmlElementProps el props contents =
  "<" ++ el ++ (showProps props) ++ ">" ++ contents ++ "</" ++ el ++ ">"
    where
      showProps : List (String, String) -> String
      showProps ps = -- Dunno why this wouldn't type check when I split function defs
        case ps of
          [] => ""
          p :: ps =>
            let (k, v) = p
            in " " ++ k ++ "=\"" ++ v ++ "\"" ++ (showProps ps)

htmlElement : String -> String -> String
htmlElement el contents =
  htmlElementProps el [] contents

||| TODO: Escape HTML-type elements
escapeText : String -> String
escapeText =
  (replace "<" "&lt;")
  . (replace ">" "&gt;")

mutual
  inlineToHtml : Inline -> String
  inlineToHtml (Text text) = text
  inlineToHtml (Pre text) = htmlElement "tt" (escapeText text)
  inlineToHtml (CodeBlock text _) = htmlElement "pre" (escapeText text)
  inlineToHtml (Italics inlines) = htmlElement "em" (inlinesToHtml inlines)
  inlineToHtml (Bold inlines) = htmlElement "strong" (inlinesToHtml inlines)
  inlineToHtml (Image alt src) = htmlElementProps "img" [("src", src), ("alt", alt)] ""
  inlineToHtml (Link desc href) = htmlElementProps "a" [("href", href)] desc
  inlineToHtml (Html tag inlines) = htmlElement tag (inlinesToHtml inlines)

  inlinesToHtml : List Inline -> String
  inlinesToHtml inlines =
    join "" (map inlineToHtml inlines)

blockToHtml : Block -> String
blockToHtml (Header level inlines) = htmlElement ("h" ++ (show level)) (inlinesToHtml inlines)
blockToHtml (Paragraph inlines) = htmlElement "p" (inlinesToHtml inlines)

||| Convert a Markdown value into Html
public export
toHtml : Markdown -> String
toHtml (Doc els) =
  join "\n" (map blockToHtml els)


<|start_filename|>Base/Extra/Test/Suite.idr<|end_filename|>
module Test.Suite

import IdrTest.Test

import Test.Extra.ListTest
import Test.Extra.StringTest

suite : IO ()
suite = do
  runSuites
    [ Test.Extra.ListTest.suite
    , Test.Extra.StringTest.suite
    ]


<|start_filename|>Inigo/Package/PackageDhall.idr<|end_filename|>
module Inigo.Package.PackageDhall

import Data.List
import Data.Maybe
import Extra.Either
import Extra.List
import Extra.String
import Fmt
import public Inigo.Package.ExtraDep
import Inigo.Package.Package
import Inigo.Package.ParseHelpers
import Inigo.Paths
import Inigo.PkgTree
import Inigo.Async.Promise
import SemVar
import System.Path
import Toml

import Idrall.API.V2
import Idrall.Parser
import Idrall.APIv1

import Language.Reflection
%language ElabReflection

record GitDep where
  constructor MkGitDep
  commit : String
  url : String
  subDirs : List String
%runElab (deriveFromDhall Record `{ GitDep })

Show GitDep where
  show (MkGitDep commit url subDirs) =
    "MkGitDep \{show commit} \{show url} \{show subDirs}"

gitDepDhallType : String
gitDepDhallType =
  "{ commit : Text, url : Text, subDirs : List Text }"

record DepPackage where
  constructor MkDepPackage
  ns : String
  name : String
  requirement : String
%runElab (deriveFromDhall Record `{ DepPackage })

Show DepPackage where
  show (MkDepPackage ns name requirement) =
    "{ ns = \{show ns}, name = \{show name}, requirement = \{show requirement} }"

public export
record PackageDhall where
  constructor MkPackageDhall
  depends : List String
  deps : List (DepPackage)
  description : Maybe String
  devDeps : List (DepPackage)
  executable : Maybe String
  license : Maybe String
  link : Maybe String
  main : Maybe String
  modules : List String
  ns : String
  package : String
  readme : Maybe String
  sourcedir : String
  version : String
  localDeps : List String
  gitDeps : List GitDep
%runElab (deriveFromDhall Record `{ PackageDhall })

depPackageDhallType : String
depPackageDhallType = "{ name : Text, ns : Text, requirement : Text }"

Show PackageDhall where
  show (MkPackageDhall {depends, deps, description, devDeps, executable, license, link, main, modules, ns, package, readme, sourcedir, version, localDeps, gitDeps}) =
    """
    { depends = \{show depends} : List Text
    , deps = \{show deps} : List \{ depPackageDhallType }
    , description = \{show description}
    , devDeps = \{show devDeps}
    , executable = \{show executable}
    , license = \{show license}
    , link = \{show link}
    , main = \{show main}
    , modules = \{show modules}
    , ns = \{show ns}
    , package = \{show package}
    , readme = \{show readme}
    , sourcedir = \{show sourcedir}
    , version = \{show version}
    , localDeps =
      \{show localDeps} : List String
    , gitDeps =
      \{show gitDeps} : List String
    }
    """

parsePackageDhall' : String -> IO $ Either String PackageDhall
parsePackageDhall' path = do
  Right package <- liftIOEither $ deriveFromDhallString {ty=PackageDhall} path
    | Left err => do
        pure $ Left $ show err
  pure $ Right package

inigoPackageFromDhall : PackageDhall -> Either String Package
inigoPackageFromDhall (MkPackageDhall {depends, deps, description, devDeps, executable, license, link, main, modules, ns, package, readme, sourcedir, version, localDeps, gitDeps}) =
  let packageVersion = !(versionFromDhall version)
      packageDeps = !(traverse depFromDhall deps)
      packageDevDeps = !(traverse depFromDhall devDeps)
      packageExtraDepsFromLocal = MkExtraDep SubDir () "." localDeps
      packageExtraDepsFromGit = map extraDepFromGit gitDeps
  in
  pure $ MkPackage
    { ns=ns
    , package=package
    , version=packageVersion
    , description=description
    , link=link
    , readme=readme
    , modules=modules
    , depends=depends
    , license=license
    , sourcedir=sourcedir
    , main=main
    , executable=executable
    , deps=packageDeps
    , devDeps=packageDevDeps
    , extraDeps=packageExtraDepsFromLocal :: packageExtraDepsFromGit
    }
  where
    requirementFromDhall : String -> Either String Requirement
    requirementFromDhall x =
      case parseRequirement x of
           Nothing => Left "Error parsing Requirement"
           (Just r) => pure r
    versionFromDhall : String -> Either String Version
    versionFromDhall x =
      case parseVersion x of
           Nothing => Left "Error parsing Version"
           (Just v) => pure v
    extraDepFromGit : GitDep -> ExtraDep
    extraDepFromGit (MkGitDep commit url subDirs) =
      MkExtraDep Git commit url subDirs
    depFromDhall : DepPackage -> Either String (List String, Requirement)
    depFromDhall (MkDepPackage ns name requirement) =
      pure ([ns, name], !(requirementFromDhall requirement))

export
parsePackageDhall : String -> Promise $ Either String Package
parsePackageDhall x = do
  Right package <- liftIO $ parsePackageDhall' x | Left err => pure $ Left err
  pure $ inigoPackageFromDhall package


<|start_filename|>Base/Toml/Test/Toml/LexerTest.idr<|end_filename|>
module Test.Toml.LexerTest

import IdrTest.Test
import IdrTest.Expectation

import Toml.Lexer

lexerSpecs : List (String, Maybe (List TomlToken))
lexerSpecs =
  [
    (
      "# This is a TOML document.\n\ntitle = \"TOML Example\"\n[owner]\nname = \"<NAME>\"",
      Just $
      [ Tok Comment "# This is a TOML document."
      , Tok Whitespace "\n\n"
      , Tok Keyword "title"
      , Tok Whitespace " "
      , Tok Equals "="
      , Tok Whitespace " "
      , Tok StringLit "\"TOML Example\""
      , Tok Whitespace "\n"
      , Tok LeftBracket "["
      , Tok Keyword "owner"
      , Tok RightBracket "]"
      , Tok Whitespace "\n"
      , Tok Keyword "name"
      , Tok Whitespace " "
      , Tok Equals "="
      , Tok Whitespace " "
      , Tok StringLit "\"<NAME>\""
      ]
    ),
    (
      "[a]\nb=1\nc.d=2\n[e.f]\ng=3",
      Just $
      [ Tok LeftBracket "["
      , Tok Keyword "a"
      , Tok RightBracket "]"
      , Tok Whitespace "\n"
      , Tok Keyword "b"
      , Tok Equals "="
      , Tok Number "1"
      , Tok Whitespace "\n"
      , Tok Keyword "c"
      , Tok Dot "."
      , Tok Keyword "d"
      , Tok Equals "="
      , Tok Number "2"
      , Tok Whitespace "\n"
      , Tok LeftBracket "["
      , Tok Keyword "e"
      , Tok Dot "."
      , Tok Keyword "f"
      , Tok RightBracket "]"
      , Tok Whitespace "\n"
      , Tok Keyword "g"
      , Tok Equals "="
      , Tok Number "3"
      ]
    ),
    (
      "[\"a.b\"]\n\"c.b\"=1",
      Just $
      [ Tok LeftBracket "["
      , Tok StringLit "\"a.b\""
      , Tok RightBracket "]"
      , Tok Whitespace "\n"
      , Tok StringLit "\"c.b\""
      , Tok Equals "="
      , Tok Number "1"
      ]
    )
  ]

export
suite : Test
suite =
  let
    lexerTests =
      map (\(text, result) =>
        test text (\_ => assertEq (lexToml text) result)
      ) lexerSpecs
  in
    describe "Toml Lexer Tests"
      [ describe "Lexer Specs" lexerTests
      ]


<|start_filename|>Test/Inigo/Archive/ArchiveTest.idr<|end_filename|>
module Test.Inigo.Archive.ArchiveTest

import IdrTest.Test
import IdrTest.Expectation

import Inigo.Archive.Archive

export
suite : Test
suite =
  describe "Encode" [
    test "Simple Encode" (\_ => assertEq
      (encode [(["a","b"], "bbb"), (["a","c"], "ccc")])
      "a.b=\"bbb\"\na.c=\"ccc\""
    ),
    test "Simple Decode" (\_ => assertEq
      (decode "a.b=\"bbb\"\na.c=\"ccc\"")
      (Just [(["a","b"], "bbb"), (["a","c"], "ccc")])
    )
  ]


<|start_filename|>Client/Server.idr<|end_filename|>
module Client.Server

import Inigo.Package.Package
import Extra.String
import SemVar

public export
data Server : Type where
  Dev : Server
  Prod : Server

export
toString : Server -> String
toString server =
  case server of
    Dev =>
      "dev"
    Prod =>
      "prod"

export
getServer : String -> Maybe Server
getServer str =
  case str of
    "dev" =>
      Just Dev
    "prod" =>
      Just Prod
    _ =>
      Nothing

export
host : Server -> String
host Dev = "http://localhost:3000/"
host Prod = "https://inigo.pm/"

export
getArchiveUrl : Package -> String
getArchiveUrl pkg =
  join "/"
    [ "api"
    , "archive"
    , ns pkg
    , package pkg
    , (show . version) pkg
    ]

export
postArchiveUrl : Package -> String
postArchiveUrl pkg =
  join "/"
    [ "api"
    , "archive"
    , ns pkg
    , package pkg
    , (show . version) pkg
    , "post"
    ]

export
postReadmeUrl : Package -> String
postReadmeUrl pkg =
  join "/"
    [ "api"
    , "readme"
    , ns pkg
    , package pkg
    , (show . version) pkg
    , "post"
    ]

export
postPackageUrl : Package -> String
postPackageUrl pkg =
  join "/"
    [ "api"
    , "packages"
    , ns pkg
    , package pkg
    , (show . version) pkg
    , "post"
    ]

export
getPackageUrl : String -> String -> String
getPackageUrl packageNS packageName =
  join "/"
    [ "api"
    , "packages"
    , packageNS
    , packageName
    , "conf"
    ]

export
getPackageVersionUrl : String -> String -> Version -> String
getPackageVersionUrl packageNS packageName version =
  join "/"
    [ "api"
    , "packages"
    , packageNS
    , packageName
    , show version
    , "conf"
    ]

export
getPackageDepTreeUrl : String -> String -> String
getPackageDepTreeUrl packageNS packageName =
  join "/"
    [ "api"
    , "packages"
    , packageNS
    , packageName
    , "deps"
    ]

export
accountPostUrl : String -> String
accountPostUrl ns =
  join "/"
    [ "api"
    , "account"
    , ns
    , "post"
    ]

export
accountLoginUrl : String -> String
accountLoginUrl ns =
  join "/"
    [ "api"
    , "account"
    , ns
    , "login"
    ]


<|start_filename|>Base/Fmt/Test/Suite.idr<|end_filename|>
module Test.Suite

import IdrTest.Test

import Test.FmtTest

suite : IO ()
suite = do
  runSuites
    [ Test.FmtTest.suite
    ]


<|start_filename|>Test/Inigo/Account/AccountTest.idr<|end_filename|>
module Test.Inigo.Account.AccountTest

import IdrTest.Test
import IdrTest.Expectation

import Inigo.Account.Account
import Inigo.Async.SubtleCrypto.SubtleCrypto

simpleAccount : Account
simpleAccount =
  MkAccount "tom" "<EMAIL>" (PBKDF2 Sha512 "salt" 1000) "aaa"

simpleAccountToml : String
simpleAccountToml ="""
ns=\"tom\"
email=\"<EMAIL>\"
kdf.type=\"PBKDF2\"
kdf.sha=\"SHA-512\"
kdf.salt=\"salt\"
kdf.iterations=1000
hash=\"aaa\"
"""

export
suite : Test
suite =
  describe "Account" [
    test "Account Encode" (\_ => assertEq
      (encode simpleAccount)
      simpleAccountToml
    ),
    test "Simple Decode" (\_ => assertEq
      (decode simpleAccountToml)
      (Just simpleAccount)
    )
  ]


<|start_filename|>Base/Extra/Extra/List.idr<|end_filename|>
module Extra.List

import Data.List
import Data.Maybe

export
dropPrefix : Eq a => List a -> List a -> List a
dropPrefix pre x =
  if isPrefixOf pre x
    then drop (length pre) x
    else x

export
collapse : Monad t => List (t a) -> t (List a)
collapse =
  foldl f (pure [])
    where
      fi : t a -> List a -> t (List a)
      fi el acc =
        map (\e => e :: acc) el

      f : t (List a) -> t a -> t (List a)
      f acc el =
        acc >>= fi el

export
range : Nat -> List Nat
range n =
  reverse (drop 1 (iterate next n))
    where
      next : Nat -> Maybe Nat
      next (S k) = Just k
      next Z = Nothing

export
zipWithIndex : List a -> List (a, Nat)
zipWithIndex l =
  zip l (range (length l))

export
repeat : a -> Nat -> List a
repeat _ Z = []
repeat x (S n) = x :: repeat x n

export
findAll : Eq a => List a -> List a -> List Nat
findAll l k =
  reverse (findAllHelper l k 0 [])
  where
    findAllHelper : List a -> List a -> Nat -> List Nat -> List Nat
    findAllHelper l k index acc =
      case l of
        [] =>
          acc
        _ =>
          let
            nextAcc =
              if isPrefixOf k l then
                (index :: acc)
              else
                acc
          in
            findAllHelper (drop 1 l) k (index + 1) nextAcc



export
replace : Eq a => List a -> List a -> List a -> List a
replace l k v =
  let
    matches = findAll l k
    repl = reverse v
    skipLen = case length k of
      Z =>
        0 -- This is really impossible but we haven't refined our types to say so
      (S Z) =>
        0
      (S k) =>
        k
  in
    reverse $ fst $ foldl (\(acc, skip), (c, i) =>
      case skip of
        Just (S k) =>
          (acc, Just k)
        _ =>
          if any (== i) matches then
            -- We need to insert a replacement and then skip N els
            (repl ++ acc, Just skipLen)
          else
            (c :: acc, Nothing)
    ) ([], (the (Maybe Nat) Nothing)) (zipWithIndex l)


<|start_filename|>Client/Action/Init.idr<|end_filename|>
module Client.Action.Init

import Client.Skeleton.Skeleton
import Data.List
import Fmt
import Inigo.Async.Base
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Template
import System.Path

export
init :
    String -> -- template
    String -> -- package namespace
    String -> -- package name
    Promise ()
init tmplFile packageNS packageName = do
    tmplInp <- fs_readFile tmplFile
    tmpl <- liftEither $ runTemplate packageNS packageName tmplFile tmplInp
    ignore $ all $ map writeTmplFile tmpl
    log (fmt "Successfully built %s" tmplFile)
  where
    ensureParent : String -> Promise ()
    ensureParent path = case parent path of
        Just parentPath => unless (parentPath == "") $ fs_mkdir True parentPath
        Nothing => pure ()

    writeTmplFile : (String, String) -> Promise ()
    writeTmplFile (path, contents) = do
        ensureParent path
        fs_writeFile path contents


<|start_filename|>Client/Action/Clean.idr<|end_filename|>
module Client.Action.Clean

import Client.Action.Build
import Data.List
import Data.String
import Inigo.Async.Base
import Inigo.Async.Promise
import Inigo.Async.FS
import Inigo.Package.Package
import Inigo.Paths

cleanIPkg : String -> Promise ()
cleanIPkg ipkg =
  ignore $ system "idris2" ["--clean", ipkg] Nothing False True

export
clean : Bool -> Promise ()
clean deps =
  do
    ignore writeIPkgFile
    ignore $ cleanIPkg inigoIPkgPath
    when (deps && !(fs_exists inigoDepDir)) $
      do
        files <- fs_getFilesR inigoDepDir
        let ipkgs = filter (isSuffixOf ".ipkg") files
        ignore $ all $ map cleanIPkg ipkgs


<|start_filename|>Inigo/PkgTree.idr<|end_filename|>
module Inigo.PkgTree

import Data.List
import Data.SortedMap
import Data.SortedSet as Set
import Inigo.Paths

%default total

public export
interface Ord name => HasDeps pkg name where
    getDeps : Bool -> pkg -> List name

-- DEBUG
export
Ord name => HasDeps (List name) name where
    getDeps _ deps = deps

parameters (dev : Bool)

    %inline
    lengthNotIn :
        (done : SortedSet name) ->
        (deps : SortedSet name) ->
        Nat
    lengthNotIn done deps = foldl go 0 deps
    where
        go : Nat -> name -> Nat
        go len dep = if contains dep done
            then len
            else 1 + len

    %inline
    %spec hasDeps
    lookupDeps :
        Show name =>
        (hasDeps : HasDeps pkg name) =>
        SortedMap name pkg ->
        name ->
        Either String (SortedSet name)
    lookupDeps ctxt n = case lookup n ctxt of
        Nothing => Left "Unkown package: \{show n}"
        Just pkg => Right $ fromList $ getDeps dev pkg

    %inline
    %spec hasDeps
    findLeaves :
        Show name =>
        (hasDeps : HasDeps pkg name) =>
        (ctxt : SortedMap name pkg) ->
        List name ->
        (done : SortedSet name) ->
        (todo : SortedSet name) ->
        Either String (List name)
    findLeaves ctxt build done todo = foldlM go [] todo
    where
        go : List name -> name -> Either String (List name)
        go leaves n = do
            deps <- lookupDeps ctxt n
            case lengthNotIn done deps of
                0 => Right $ n :: leaves
                _ => Right leaves

    deleteFrom :
        List a ->
        SortedSet a ->
        SortedSet a
    deleteFrom [] set = set
    deleteFrom (x :: xs) set = deleteFrom xs (delete x set)

    insertFrom :
        List a ->
        SortedSet a ->
        SortedSet a
    insertFrom [] set = set
    insertFrom (x :: xs) set = insertFrom xs (insert x set)

    export
    %spec hasDeps
    kahn :
        Show name =>
        (hasDeps : HasDeps pkg name) =>
        (ctxt : SortedMap name pkg) ->
        (build : List name) ->
        (done : SortedSet name) ->
        (todo : SortedSet name) ->
        Either String (List name)
    kahn ctxt build done todo = if null todo
        then Right $ reverse build
        else do
            leaves@(_ :: _) <- findLeaves ctxt build done todo
                | [] => do
                    let todoList = Set.toList todo
                    deps <- traverse (\pkg => (pkg,) . Set.toList <$> lookupDeps ctxt pkg) todoList
                    if DEBUG
                        then Left "Cyclic dependencies:\n\{show todoList},\ndeps: \{show deps},\nbuild so far: \{show $ reverse build}"
                        else Left "Cyclic dependencies: \{show todoList}"
            kahn ctxt (leaves ++ build) (insertFrom leaves done) (assert_smaller todo $ deleteFrom leaves todo)

    export
    %spec hasDeps
    %inline
    getBuildOrder :
        Show name =>
        (hasDeps : HasDeps pkg name) =>
        (ctxt : SortedMap name pkg) ->
        SortedSet name ->
        Either String (List name)
    getBuildOrder ctxt todo = kahn ctxt [] empty todo


<|start_filename|>Base/SemVar/SemVar/Data.idr<|end_filename|>
module SemVar.Data

import Data.String
import Data.List
import Data.Maybe

import Extra.String

%default total

public export
record Version where
  constructor MkVersion
  major : Int
  minor : Int
  patch : Int
  release : Maybe String
  metadata : Maybe String

%name Version version

export
Show Version where
  show version =
    join "" [ show (major version)
    , "."
    , show (minor version)
    , "."
    , show (patch version)
    , ((fromMaybe "") . map ((++) "-")) (release version)
    , ((fromMaybe "") . map ((++) "+")) (metadata version)
    ]

export
Eq Version where
  version0 == version1 =
    (major version0) == (major version1) &&
    (minor version0) == (minor version1) &&
    (patch version0) == (patch version1) &&
    (release version0) == (release version1) &&
    (metadata version0) == (metadata version1)

public export
data Requirement : Type where
  GT : Version -> Requirement
  GTE : Version -> Requirement
  LT : Version -> Requirement
  LTE : Version -> Requirement
  EQ : Version -> Requirement
  AND : Requirement -> Requirement -> Requirement
  OR : Requirement -> Requirement -> Requirement

%name Requirement requirement

-- TODO: Improve show with a pretty form, if possible
export
Show Requirement where
  show (AND req0 req1) = (show req0) ++ " " ++ (show req1)
  show (OR req0 req1) = (show req0) ++ " || " ++ (show req1)
  show (GT version) = ">" ++ (show version)
  show (GTE version) = ">=" ++ (show version)
  show (LT version) = "<" ++ (show version)
  show (LTE version) = "<=" ++ (show version)
  show (EQ version) = "=" ++ (show version)

export
Eq Requirement where
  (AND req0a req0b) == (AND req1a req1b) = req0a == req1a && req0b == req1b
  (OR req0a req0b) == (OR req1a req1b) = req0a == req1a && req0b == req1b
  (GT version0) == (GT version1) = version0 == version1
  (GTE version0) == (GTE version1) = version0 == version1
  (LT version0) == (LT version1) = version0 == version1
  (LTE version0) == (LTE version1) = version0 == version1
  (EQ version0) == (EQ version1) = version0 == version1
  _ == _ = False

export
nextMinor : Version -> Version
nextMinor version =
  MkVersion (major version) ((minor version) + 1) 0 Nothing Nothing

export
nextMajor : Version -> Version
nextMajor (MkVersion 0 minor _ _ _) =
  MkVersion 0 (minor + 1) 0 Nothing Nothing
nextMajor version =
  MkVersion ((major version) + 1) 0 0 Nothing Nothing

export
Ord Version where
  compare (MkVersion major0 minor0 patch0 release0 metadata0) (MkVersion major1 minor1 patch1 release1 metadata1) =
      case compare major0 major1 of
        EQ =>
          case compare minor0 minor1 of
            EQ =>
              case compare patch0 patch1 of
                EQ =>
                  case (release0, release1) of
                    (Just _, Nothing) =>
                      LT
                    (Nothing, Just _) =>
                      GT
                    _ =>
                      EQ
                els =>
                  els
            els =>
              els
        els =>
          els

gte : Version -> Version -> Bool
gte v0 v1 =
  let cmp = compare v0 v1
  in cmp == GT || cmp == EQ

lte : Version -> Version -> Bool
lte v0 v1 =
  let cmp = compare v0 v1
  in cmp == LT || cmp == EQ

-- TODO: We might want to make this dependently typed
export
satisfy : Requirement -> Version -> Bool
satisfy (AND reqA reqB) version = (satisfy reqA version) && (satisfy reqB version)
satisfy (OR reqA reqB) version = (satisfy reqA version) || (satisfy reqB version)
satisfy (GTE v0) v1 = v1 `gte` v0
satisfy (GT v0) v1 = compare v1 v0 == GT
satisfy (LTE v0) v1 = v1 `lte` v0
satisfy (LT v0) v1 = compare v1 v0 == LT
satisfy (EQ v0) v1 = compare v1 v0 == EQ
satisfy _ _ = False


<|start_filename|>Base/Fmt/Test/FmtTest.idr<|end_filename|>
module Test.FmtTest

import IdrTest.Test
import IdrTest.Expectation

import Fmt

simpleTest : Test
simpleTest =
  test "Simple test" (\_ => assertEq
    (fmt "Hello")
    "Hello"
  )

stringTest : Test
stringTest =
  test "String test" (\_ => assertEq
    (fmt "Hello %s" "world")
    "Hello world"
  )

intTest : Test
intTest =
  test "String test" (\_ => assertEq
    (fmt "Health %d" 99)
    "Health 99"
  )

mixedTest : Test
mixedTest =
  test "String test" (\_ => assertEq
    (fmt "Name %s Age %d" "Thomas" 50)
    "Name Thomas Age 50"
  )

export
suite : Test
suite =
  describe "Fmt Tests"
    [ simpleTest
    , stringTest
    , intTest
    , mixedTest
    ]


<|start_filename|>Client/Action/FetchDeps.idr<|end_filename|>
module Client.Action.FetchDeps

import Client.Action.BuildDeps
import Client.Action.CacheDeps
import Client.Action.Pull
import Client.Server
import Data.List
import Data.SortedSet as Set
import Extra.String
import Inigo.Async.Base
import Inigo.Async.Fetch
import Inigo.Async.FS
import Inigo.Async.Git
import Inigo.Async.Package
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Package.PackageDeps
import Inigo.Paths
import Inigo.Util.Url.Url
import SemVar
import SemVar.Sat

getPackageDepTree : Server -> String -> String -> Promise PackageDepTree
getPackageDepTree server packageNS packageName =
  do
    let url = toString (fromHostPath (host server) (getPackageDepTreeUrl packageNS packageName))
    log ("Requesting " ++ url ++ "...")
    contents <- fetch url
    Right packageDepTree <- lift (parsePackageDepTree contents)
      | Left err => reject ("Invalid package dep tree: " ++ err)
    pure packageDepTree

-- Responsible for pulling deps based on package conf

-- Note: we're currently going to ignore sub-deps entirely

splitDep : List String -> Maybe (String, String)
splitDep (ns :: dep) = Just (ns, join "." dep)
splitDep _ = Nothing

removeDups : Ord a => List a -> List a
removeDups = Set.toList . Set.fromList

collect : Bool -> PackageDepTree -> List VersionNode
collect includeDevDeps depTree =
  concat $ map (\(pkg, pkgDeps) =>
    map (\(version, pkgDep) =>
      (pkg, version, (deps pkgDep) ++ (if includeDevDeps then (dev pkgDep) else []))
    ) pkgDeps
  ) depTree

-- Okay, here's where the fun begins
-- We're going to grab all sub-dep trees via our new deps endpoint
-- and then we're going to cull dups and then pass it to semvar sat to try
-- and return us what deps we should fetch!
fetchDeps : Server -> Bool -> Bool -> Package -> Promise (List (String, Package))
fetchDeps server includeDevDeps build pkg =
  do
    -- We have a list of deps, so we basically just need to `pull` each
    -- but we need to know the versions...
    -- Let's start by just pulling the latest of each
    let allDeps = deps pkg ++ (if includeDevDeps then (devDeps pkg) else [])
    let depNames = map fst allDeps
    let splitDeps = mapMaybe splitDep depNames

    depTree <- all $ map (uncurry $ getPackageDepTree server) splitDeps
    let versionNodes = collect includeDevDeps (concat depTree)
    log ("Package Dep Tree: " ++ (show versionNodes))
    Right sat <- lift $ satisfyAll versionNodes allDeps
      | Left err => reject ("Error satisfying contraints: " ++ err)
    log ("Sat: " ++ (show sat))

    all $ map pullDep sat
    -- TODO: We should only build things which have changed
    -- TODO: How do we know what's changed?
    -- if build
    --   then buildDeps
    --   else pure ()
  where
    pullDep : (List String, Version) -> Promise (String, Package)
    pullDep (pkg, version) =
      case splitDep pkg of
        Nothing =>
          reject ("Invalid dep: " ++ show pkg)

        Just (packageNS, packageName) =>
          do
            pull server packageNS packageName (Just version)
            let src = inigoDepDir </> joinPath pkg
            pkg <- readPackage src
            pure (src, pkg)

||| Get all elems of the left list not present in the right list
total
difference : Eq a => List a -> List a -> List a
difference xs [] = xs
difference xs (y :: ys) = difference (delete y xs) ys

fetchExtraDeps : Bool -> Bool -> Package -> Promise (List (String, Package))
fetchExtraDeps devDeps build pkg = do
    deps <- fetchDeps [] pkg.extraDeps
    foldlM getExtraDepPkg [] deps
  where
    getSubDirPkg : String -> List (String, Package) -> String -> Promise (List (String, Package))
    getSubDirPkg depDir pkgs subDir = do
        let srcDir = depDir </> subDir
        pkg <- readPackage srcDir
        if any ((== pkg) . snd) pkgs
            then pure pkgs
            else pure ((srcDir, pkg) :: pkgs)

    getExtraDepPkg : List (String, Package) -> ExtraDep -> Promise (List (String, Package))
    getExtraDepPkg pkgs dep@(MkExtraDep _ _ _ subDirs) =
        foldlM (getSubDirPkg $ getExtraDepDir dep) pkgs subDirs

    genIPkg : String -> String -> Promise Package
    genIPkg dest subDir = do
        let buildDir = joinPath (".." <$ splitPath (dest </> subDir)) </> "build"
        let pkgdir = dest </> subDir
        let iPkgFile = dest </> subDir </> inigoIPkgPath
        pkg <- readPackage pkgdir
        fs_writeFile iPkgFile $ generateIPkg False (Just buildDir) pkg
        pure pkg

    fetchExtraDep : ExtraDep -> Promise (List Package)
    fetchExtraDep pkg@(MkExtraDep Git commit url subDirs) = do
        let dest = getExtraDepDir pkg
        log "Downloading package from \"\{url}\""
        ignore $ git_downloadTo url (Just commit) dest
        traverse (genIPkg dest) subDirs
    fetchExtraDep pkg@(MkExtraDep SubDir _ url subDirs) = do
        let dest = getExtraDepDir pkg
        log "Checking packages in \"\{url}\""
        traverse (genIPkg dest) subDirs

    fetchDeps : List ExtraDep -> List ExtraDep -> Promise (List ExtraDep) -- if this is too slow, use SortedSet
    fetchDeps done [] = pure done
    fetchDeps done (MkExtraDep _ _ _ [] :: todo) = fetchDeps done todo
    fetchDeps done (pkg@(MkExtraDep _ _ _ subDirs0) :: todo) = case find (eqIgnoreSubDirs pkg) done of
        Nothing => do -- doesn't exist yet, download and add dependencies
            pkgs <- fetchExtraDep pkg
            let todo' = foldl (\acc, pkg => pkg.extraDeps ++ acc) todo pkgs
            fetchDeps (pkg :: done) todo'
        Just pkg@(MkExtraDep method info url subDirs1) => case difference subDirs0 subDirs1 of
            [] => fetchDeps done todo -- no missing subdirs, move on
            missing => do
                let dest = getExtraDepDir pkg
                pkgs <- traverse (genIPkg dest) missing
                let todo' = foldl (\acc, pkg => pkg.extraDeps ++ acc) todo pkgs
                let done' = MkExtraDep method info url (missing ++ subDirs0) :: filter (not . eqIgnoreSubDirs pkg) done
                fetchDeps done' todo
export
fetchAllDeps : Server -> Bool -> Bool -> Promise ()
fetchAllDeps server devDeps build = do
    pkg <- currPackage
    deps <- fetchDeps server devDeps build pkg
    extraDeps <- fetchExtraDeps devDeps build pkg
    let allDeps = deps ++ extraDeps
    writeDepCache allDeps


<|start_filename|>Base/Extra/Extra/Debug.idr<|end_filename|>
module Extra.Debug

export
log : Show a => String -> a -> a
log msg x =
	let
		_ = unsafePerformIO (putStrLn $ msg ++ ": " ++ show x)
	in
		x


<|start_filename|>Test/Inigo/Package/PackageTest.idr<|end_filename|>
module Test.Inigo.Package.PackageTest

import IdrTest.Test
import IdrTest.Expectation

import Inigo.Async.Promise
import Inigo.Package.Package
import SemVar.Data

%default total

export
examplePackage : Package
examplePackage =
  MkPackage
    "Example"
    "Inigo"
    (MkVersion 0 0 1 (Just "pre") Nothing)
    (Just "My Description")
    (Just "http://example.com")
    (Just "README.md")
    ["MyDir"]
    ["idris2"]
    (Just "MIT")
    (Just "MyFile")
    (Just "MyExec")
    [
      (["MyDep"], (
        AND
          (GTE $ MkVersion 1 2 3 Nothing Nothing)
          (LT $ MkVersion 2 0 0 Nothing Nothing)
      ))
    ]
    [
      (["MyDevDep"], (
        EQ (MkVersion 2 0 0 Nothing Nothing)
      ))
    ]

examplePackageTest : Test
examplePackageTest =
  test "Parse Example Package" (\_ => assertEq
    (parsePackage """
      ns='Example'
      package='Inigo'
      version='0.0.1-pre'
      
      description='My Description'
      readme='README.md'
      link='http://example.com'
      modules=['MyDir']
      depends=['idris2']
      license='MIT'
      main='MyFile'
      executable='MyExec'
      
      [deps]
      MyDep='^1.2.3'
      
      [dev-deps]
      MyDevDep='2.0.0'
      """
    )
    (Right examplePackage)
  )

invalidVersionTest : Test
invalidVersionTest =
  test "Invalid version test" (\_ => assertEq
    (parsePackage
      """
      ns='Example'
      package='Inigo'
      version='0.0.1zz'
      """
    )
    (
      Left "Invalid version: 0.0.1zz"
    )
  )

-- Note: this is a little ugly, but it's technically correct
encodePackageTest : Test
encodePackageTest =
  test "Encode Example Package" (\_ => assertEq
    (encodePackage $
      MkPackage
        "Example"
        "Inigo"
        (MkVersion 0 0 1 (Just "pre") Nothing)
        (Just "My Description")
        (Just "http://example.com")
        (Just "README.md")
        ["MyDir"]
        ["idris2"]
        (Just "MIT")
        (Just "MyFile")
        (Just "MyExec")
        [
          (["MyDep"], (
            AND
              (GTE $ MkVersion 1 2 3 Nothing Nothing)
              (LT $ MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
        [
          (["MyDevDep"], (
            EQ (MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
    )
    (
      """
      ns=\"Example\"
      package=\"Inigo\"
      version=\"0.0.1-pre\"
      description=\"My Description\"
      link=\"http://example.com\"
      readme=\"README.md\"
      modules=[\"MyDir\"]
      depends=[\"idris2\"]
      license=\"MIT\"
      main=\"MyFile\"
      executable=\"MyExec\"
      deps.MyDep=\">=1.2.3 <2.0.0\"
      dev-deps.MyDevDep=\"=2.0.0\"
      """
    )
  )

generateIPkgTest : Test
generateIPkgTest =
  test "Encode IPkg" (\_ => assertEq
    (generateIPkg
      True $ MkPackage
        "Example"
        "Inigo"
        (MkVersion 0 0 1 (Just "pre") Nothing)
        (Just "My Description")
        (Just "http://example.com")
        (Just "README.md")
        ["MyDir"]
        ["idris2"]
        (Just "MIT")
        (Just "MyFile")
        (Just "MyExec")
        [
          (["MyDep"], (
            AND
              (GTE $ MkVersion 1 2 3 Nothing Nothing)
              (LT $ MkVersion 2 0 0 Nothing Nothing)
          ))
        ]
        []
    )
    (
      """
      package Inigo

      modules = MyDir
      depends = idris2

      sourcedir = \"Deps/Example/Inigo\"

      version = \"0.0.1-pre\"
      main = MyFile
      executable = MyExec
      """
    )
  )

export
suite : Test
suite =
  describe "Package" [
    examplePackageTest,
    invalidVersionTest,
    encodePackageTest,
    generateIPkgTest
  ]


<|start_filename|>Base/Markdown/Markdown/Format/Text.idr<|end_filename|>
module Markdown.Format.Text

import Extra.String
import Markdown.Data

-- toTextEl : MarkdownEl -> String
-- toTextEl (Header level text) = "#" ++ text -- TODO: Level
-- toTextEl (Paragraph text) = text

-- ||| Convert a Markdown value into its string representation.
-- public export
-- toText : Markdown -> String
-- toText (Doc els) =
--   join "\n" (map toTextEl els)

public export
toText : Markdown -> String
toText x = "TODO"


<|start_filename|>Base/SemVar/SemVar/Sat.idr<|end_filename|>
module SemVar.Sat

import Extra.Debug as Debug
import Data.List
import Data.Maybe
import Extra.Op
import Fmt
import SemVar.Data

public export
VersionNode : Type
VersionNode = (List String, Version, List (List String, Requirement))

compareBy : Ord b => (a -> b) -> (a -> a -> Ordering)
compareBy f =
  (\x, y => compare (f x) (f y))

versOf : VersionNode -> Version
versOf (_, v, _) = v

pkgVersOf : VersionNode -> (List String, Version)
pkgVersOf (p, v, _) = (p, v)

matchPkgVers : VersionNode -> VersionNode -> Bool
matchPkgVers x y =
  pkgVersOf x == pkgVersOf y

||| I think the idea is that we'll walk the list of requirements and
||| narrow down from the list of choices until either we've satisfied
||| all requirements or we've found one we can't solve.
||| Two caveats:
|||  a. We'll need to pick up new reqs as we go (for sub deps)
|||    i. Note: we can't let ourselves get into an infinite loop here and may have to track "completed"
|||  b. If we end up with multiple acceptable packages, we'll just choose the latest of all available options
satisfyAll_ : List VersionNode -> List (List String, Version) -> List (List String, Requirement) -> Either String (List (List String, Version))
satisfyAll_ versions pinned [] = Right pinned
satisfyAll_ versions pinned ((pkg, req) :: reqs) =
  -- let _ = Debug.log "Resolving req" (pkg, req, pinned) in
  case step pinned versions (pkg, req) of
    Left Nothing =>
      -- This current req is incompatible with current reqs
      Left (fmt "Package %s req %s is incompatible" (show pkg) (show req))
    Left (Just _) =>
      -- This current req is already satisfied
      -- let _ = Debug.log "Using existing package for" pkg in
      satisfyAll_ versions pinned reqs
    Right matches =>
      -- Let's see if any of these matches work
      let
        -- Try the highest versions first
        sorted = sortBy (compareBy versOf) matches
        -- This new req can't be satisfied, quit
        -- TODO: Show possible versions?
        baseErr = fmt "Cannot match %s req %s" (show pkg) (show req)
      in
        foldl tryVersion (Left baseErr) sorted
  where
    tryVersion : Either String (List (List String, Version)) -> VersionNode -> Either String (List (List String, Version))
    tryVersion (Right r) _ = Right r
    tryVersion (Left _) hd =
      case find (matchPkgVers hd) versions of
        Nothing =>
          -- TODO: Should we collect errors
          Left (fmt "Cannot find deps for %s" (show hd))

        Just (_, _, depReqs) =>
          -- Good, we found at least one potential match, let's start by just recursing on head
          -- TODO: We need to accumulate here, maybe?
          -- let _ = Debug.log " " hd in
          -- Non-TCO and non-total
          satisfyAll_ versions ((pkgVersOf hd) :: pinned) (reqs ++ depReqs)

    matchReq : List VersionNode -> (List String, Requirement) -> List VersionNode
    matchReq versions (pkg, req) =
      filter (\(name, version, _) => name == pkg && satisfy req version) versions

    step : List (List String, Version) -> List VersionNode -> (List String, Requirement) -> Either (Maybe Version) (List VersionNode)
    step pinned versions (pkg, req) =
      case find ((== pkg) . fst) pinned of
        Just (_, pin) =>
          if satisfy req pin then
            Left (Just pin)
          else
            Left Nothing
        Nothing =>
          Right $ matchReq versions (pkg, req)

export
satisfyAll : List VersionNode -> List (List String, Requirement) -> Either String (List (List String, Version))
satisfyAll versions reqs =
  satisfyAll_ versions [] reqs


<|start_filename|>Inigo/Package/JSON.idr<|end_filename|>
||| Module for serialising and deserialising Inigo packages
module Inigo.Package.JSON

import Data.List
import Data.Maybe
import Inigo.Package.Package
import Language.JSON
import SemVar

extraDepToJSON : ExtraDep -> JSON
extraDepToJSON (MkExtraDep Git commit url subDirs) = JObject
    [ ("download", JString "git")
    , ("commit", JString commit)
    , ("url", JString url)
    , ("subDirs", JArray (JString <$> subDirs))
    ]
extraDepToJSON (MkExtraDep SubDir _ url subDirs) = JObject
    [ ("download", JString "folder")
    , ("url", JString url)
    , ("subDirs", JArray (JString <$> subDirs))
    ]

nullable : Lazy (a -> JSON) -> Maybe a -> JSON
nullable = maybe JNull

export
encodePackage : Package -> JSON
encodePackage pkg = JObject
    [ ("ns", JString pkg.ns)
    , ("package", JString pkg.package)
    , ("version", JString (show pkg.version))
    , ("description", nullable JString pkg.description)
    , ("link", nullable JString pkg.link)
    , ("readme", nullable JString pkg.readme)
    , ("modules", JArray (JString <$> pkg.modules))
    , ("depends", JArray (JString <$> pkg.depends))
    , ("license", nullable JString pkg.license)
    , ("sourcedir", JString pkg.sourcedir)
    , ("main", nullable JString pkg.main)
    , ("executable", nullable JString pkg.executable)
    , ("deps", JArray (mkDep <$> pkg.deps))
    , ("dev-deps", JArray (mkDep <$> pkg.devDeps))
    , ("extra-deps", JArray (extraDepToJSON <$> pkg.extraDeps))
    ]
  where
    mkDep : (List String, Requirement) -> JSON
    mkDep (ns, semvar) = JObject
        [ ("name", JArray (JString <$> ns))
        , ("semvar", JString (show semvar))
        ]

export
encodeAsJSON : Package -> String
encodeAsJSON = show . JSON.encodePackage

namespace Parse

    key : String -> JSON -> Maybe JSON
    key k (JObject kvs) = lookup k kvs
    key _ _ = Nothing

    string : JSON -> Maybe String
    string (JString str) = Just str
    string _ = Nothing

    stringKey : String -> JSON -> Maybe String
    stringKey k json = key k json >>= \case
        JString str => Just str
        _ => Nothing

    arrayKey : String -> JSON -> Maybe (List JSON)
    arrayKey k json = key k json >>= \case
        JArray arr => Just arr
        _ => Nothing

    nullable : Maybe a -> Maybe (Maybe a)
    nullable (Just x) = Just (Just x)
    nullable Nothing = Just Nothing

    parseExtraDep : JSON -> Maybe ExtraDep
    parseExtraDep json = do
        url <- stringKey "url" json
        subDirs <- arrayKey "subDirs" json >>= traverse string
        download <- stringKey "download" json
        case download of
            "git" => do
                commit <- stringKey "commit" json
                Just $ MkExtraDep Git commit url subDirs
            "folder" => Just $ MkExtraDep SubDir () url subDirs
            _ => Nothing

    export
    parsePackage : JSON -> Maybe Package
    parsePackage json = do
        ns <- stringKey "ns" json
        package <- stringKey "package" json
        version <- stringKey "version" json >>= parseVersion
        description <- nullable $ stringKey "description" json
        link <- nullable $ stringKey "link" json
        readme <- nullable $ stringKey "readme" json
        modules <- arrayKey "modules" json >>= traverse string
        depends <- arrayKey "depends" json >>= traverse string
        license <- nullable $ stringKey "license" json
        sourcedir <- stringKey "sourcedir" json
        main <- nullable $ stringKey "main" json
        executable <- nullable $ stringKey "executable" json
        deps <- arrayKey "deps" json >>= traverse parseDep
        devDeps <- arrayKey "dev-deps" json >>= traverse parseDep
        extraDeps <- arrayKey "extra-deps" json >>= traverse parseExtraDep
        Just $ MkPackage
            { ns, package, version, description, link, readme
            , modules, depends, license, sourcedir
            , main, executable, deps, devDeps, extraDeps
            }
      where
        parseDep : JSON -> Maybe (List String, Requirement)
        parseDep json = do
            ns <- arrayKey "name" json >>= traverse string
            var <- stringKey "semvar" json >>= parseRequirement
            Just (ns, var)

export
decodeJSON : String -> Maybe Package
decodeJSON = parse >=> parsePackage


<|start_filename|>Inigo/Async/CloudFlare/Worker.idr<|end_filename|>
module Inigo.Async.CloudFlare.Worker

import Data.Buffer
import Data.List
import Inigo.Async.Promise

public export
Headers : Type
Headers = List (String, String)

public export
Response : Type
Response = (Int, String, Headers)

export
html : String -> Response
html content =
  (200, content, [("Content-Type", "text/html")])

-- Could maybe make use of `__prim_js2idris_array`
%foreign "javascript:lambda:(status,body,headers)=>{let toArray=((list)=>Object.fromEntries([...Array(list.h).keys()].map((i)=>{let x=list['a'+(i+1)];return [x.a1,x.a2]})));return new Response(body, {status: status, headers: toArray(headers)});}"
prim__response : Int -> String -> List (String, String) -> PrimIO ()

-- Note: can't use "Buffer" body here, needs to be an ArrayBuffer
%foreign "javascript:lambda:(handler,w)=>addEventListener('fetch',e=>e.respondWith(e.request.text().then((r)=>handler((url=new URL(e.request.url)).pathname)(r || '')(__prim_js2idris_array([...url.searchParams.entries()].flat()))(__prim_js2idris_array([...e.request.headers.entries()].flat()))(w))))"
prim__httpServer : (String -> String -> List String -> List String -> IO ()) -> PrimIO ()

handleResponse : (Int, String, Headers) -> PrimIO ()
handleResponse (status, err, headers) =
  prim__response status err headers

primHandler : Promise Response -> IO ()
primHandler handler =
  resolve handler (primIO . handleResponse) (primIO . (\err => handleResponse (500, err, [])))

pairList : List a -> List (a, a)
pairList =
  fst . foldl accumulate ([], Nothing) . Data.List.reverse
  where
    accumulate : (List (a, a), Maybe a) -> a -> (List (a, a), Maybe a)
    accumulate (acc, Nothing) x = (acc, Just x)
    accumulate (acc, Just y) x = ((x, y) :: acc, Nothing)

httpServer : (String -> String -> List (String, String) -> List (String, String) -> Promise Response) -> Promise ()
httpServer handler =
  do
    liftIO $ (primIO $ prim__httpServer ioHandler)
    pure ()
  where
    -- Not sure why this wouldn't compile in point-free style
    ioHandler : String -> String -> List String -> List String -> IO ()
    ioHandler path body params headers = primHandler (handler path body (pairList params) (pairList headers))

export
serve : (String -> String -> List (String, String) -> List (String, String) -> Promise Response) -> Promise ()
serve handler =
  httpServer handler


<|start_filename|>Client/Skeleton/BaseWithTest/Test/Test.idr<|end_filename|>
module Client.Skeleton.BaseWithTest.Test.Test

import Fmt

export
name : (String, String) -> List String
name (packageNS, packageName) = ["Test", packageName ++ "Test.idr"]

export
build : (String, String) -> String
build (packageNS, packageName) = fmt """
module Test.%sTest

import IdrTest.Test
import IdrTest.Expectation

import %s

export
suite : Test
suite =
  describe \"%s Tests\"
    [ test \"1 == 1\" (\\_ => assertEq 1 1 )
    ]
""" packageName packageName packageName


<|start_filename|>Inigo/Template.idr<|end_filename|>
module Inigo.Template

import Data.List1
import Data.SnocList
import Data.String
import Debug.Trace

public export
record Pos where
    constructor MkPos
    line : Int
    col : Int

Show Pos where
    show pos = "\{show pos.line}:\{show pos.col}"

initPos : Pos
initPos = MkPos 1 1

nextChar : Pos -> Pos
nextChar = record { col $= (+ 1) }

nextLine : Pos -> Pos
nextLine = record { line $= (+ 1), col = 1 }

advance : Char -> Pos -> Pos
advance '\n' = nextLine
advance _ = nextChar

data TempVar
    = Package
    | Namespace
    | File String

data TempPart : Type where
    Var : TempVar -> TempPart
    Text : String -> TempPart

data TempState : Type where
    InText : SnocList Char -> TempState
    InVar : SnocList Char -> TempState
    Escape : TempState

initState : TempState
initState = InText [<]

unknownVar : Either String a
unknownVar = Left "Unknown variable"

parseVar : List Char -> Maybe TempVar
parseVar ['P', 'a', 'c', 'k', 'a', 'g', 'e'] = Just Package
parseVar ['N', 'a', 'm', 'e', 's', 'p', 'a', 'c', 'e'] = Just Namespace
parseVar ('f' :: 'i' :: 'l' :: 'e' :: ' ' :: file) = Just $ File $ fastPack file
parseVar _ = Nothing

makeText : SnocList TempPart -> SnocList Char -> SnocList TempPart
makeText acc [<] = acc
makeText acc xs = acc :< Text (fastPack $ xs <>> [])

cleanStart : List TempPart -> List TempPart
cleanStart (Text t :: xs) = if "\n" `isPrefixOf` t
    then Text (assert_total $ strSubstr 1 (cast (length t) - 1) t) :: xs
    else Text t :: xs
cleanStart xs = xs

cleanEnd : SnocList TempPart -> SnocList TempPart
cleanEnd (xs :< Text t) = if "\n" `isSuffixOf` t
    then xs :< Text (assert_total $ strSubstr 0 (cast (length t) - 1) t)
    else xs :< Text t
cleanEnd xs = xs

parse :
    TempState -> -- state
    List Char -> -- input
    SnocList TempPart -> -- accumulator
    Pos -> -- position
    Either (Pos, String) (SnocList TempPart)
parse (InText xs) [] acc pos = Right $ makeText acc xs
parse (InText xs) ('\\' :: ys) acc pos = parse Escape ys (makeText acc xs) (nextChar pos)
parse (InText xs) (x :: ys) acc pos = parse (InText $ xs :< x) ys acc (advance x pos)

parse (InVar xs) [] acc pos = Left (pos, "Missing closing brace")
parse (InVar xs) ('}' :: ys) acc pos =
    let xs' = xs <>> []
     in case parseVar xs' of
        Nothing => Left (pos, "Unknown variable: \{fastPack xs'}")
        Just var@(File _) => parse initState ys (cleanEnd acc :< Var var) (nextChar pos)
        Just var => parse initState ys (acc :< Var var) (nextChar pos)
parse (InVar xs) (x :: ys) acc pos = parse (InVar $ xs :< x) ys acc (advance x pos)

parse Escape [] acc pos = Left (pos, "Trailing escape character")
parse Escape ('\\' :: xs) acc pos = parse initState xs (acc :< Text "\\") (nextChar pos)
parse Escape ('{' :: xs) acc pos = parse (InVar [<]) xs acc (nextChar pos)
parse Escape (x :: xs) acc pos = Left (pos, "Unknown escape character: \{show x}")

seperateFiles :
    SnocList TempPart -> -- input
    List TempPart -> -- accumulator for the file
    List (String, List TempPart) -> -- accumulator for the entire template
    Either String (List (String, List TempPart))
seperateFiles [<] _ acc = Right acc
seperateFiles (sx :< Var (File fp)) file acc = seperateFiles sx [] ((fp, cleanStart file) :: acc)
seperateFiles (sx :< x) xs ys = seperateFiles sx (x :: xs) ys

parameters (ns, pkg : String)

    renderVar : TempVar -> Either String String
    renderVar Package = Right pkg
    renderVar Namespace = Right ns
    renderVar (File x) = Left "Internal Error: Unexpected \\{file ...}"

    renderTemplate :
        List TempPart -> -- template
        SnocList String -> -- accumulator
        Either String (SnocList String)
    renderTemplate [] acc = Right acc
    renderTemplate (Var x :: xs) acc = case renderVar x of
        Left err => Left err
        Right v => renderTemplate xs (acc :< v)
    renderTemplate (Text x :: xs) acc = renderTemplate xs (acc :< x)

    render :
        List (String, List TempPart) ->
        List (String, String) ->
        Either String (List (String, String))
    render [] acc = Right acc
    render ((fp, temp) :: ts) acc = case renderTemplate temp [<] of
        Left err => Left err
        Right res => render ts $ (fp, fastConcat $ res <>> []) :: acc

    export
    runTemplate :
        String -> -- filepath
        String -> -- input
        Either String (List (String, String))
    runTemplate fp inp0 = do
        let Right inp1 = parse initState (fastUnpack inp0)  [<] initPos
            | Left (pos, err) => Left $ "Parse error in \{fp}, at \{show pos}: \{err}"
        let Right inp2 = seperateFiles inp1 [] []
            | Left err => Left $ "Parse error in \{fp}: \{err}"
        render inp2 []


<|start_filename|>Base/Extra/Test/Extra/StringTest.idr<|end_filename|>
module Test.Extra.StringTest

import IdrTest.Test
import IdrTest.Expectation

import Extra.String

export
suite : Test
suite =
  describe "String Extra Tests"
    [ test "Replace String" (\_ => assertEq
        (replace "abba" "oodle" "My String Yabba Dabba")
        "My String Yoodle Doodle"
      ),
      test "Quote String" (\_ => assertEq
        (quote "my string\nis cool")
        "\"my string\\nis cool\""
      ),
      test "Unquote String" (\_ => assertEq
        (unquote "\"my string\\nis cool\"")
        "my string\nis cool"
      ),
      test "Limit Limited" (\_ => assertEq
        (limit 4 "this is cool")
        "this..."
      ),
      test "Limit Unlimited" (\_ => assertEq
        (limit 40 "this is cool")
        "this is cool"
      )
    ]


<|start_filename|>Client/Action/Repl.idr<|end_filename|>
module Client.Action.Repl

import Inigo.Async.Base
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.CodeGen
import Inigo.Package.Package
import Inigo.Async.Package
import Inigo.Paths

writeIPkgNoExe : Promise ()
writeIPkgNoExe = do
    pkg <- currPackage
    fs_writeFile inigoIPkgPath (generateIPkg False Nothing pkg)

export
repl : Promise ()
repl = do
    writeIPkgNoExe
    ignore $ systemWithStdIO "idris2" ["--repl", inigoIPkgPath] True True


<|start_filename|>Inigo/Async/Util.idr<|end_filename|>
module Inigo.Async.Util

public export
toObject : String
toObject = "let toObject=((list)=>Object.fromEntries([...Array(list.h).keys()].map((i)=>{let x=list['a'+(i+1)];return [x.a1,x.a2]})));"

public export
toArray : String -> String
toArray str = "(function(){let toArray=(x)=>{if(x.h === 0){return []}else{return [x.a1].concat(toArray(x.a2))}};return " ++ str ++ "})()"

public export
promisifyPrim_ : String -> String
promisifyPrim_ str =
  "(...args)=>{let [w,err,ok,...fargs]=args.reverse();return (" ++ str ++ ")(...fargs.reverse()).then((x)=>ok(x)(w),(e)=>err(e)(w))}"

public export
promisifyPrim: String -> String
promisifyPrim str =
  "node:lambda:" ++ (promisifyPrim_ str)

public export
promisifyResolve: String -> String -> String
promisifyResolve res str =
  "node:lambda:" ++ promisifyPrim_ ( "(...inner)=>{(" ++ str ++ ")(...inner);return Promise.resolve(" ++ res ++ ");}" )


<|start_filename|>Makefile<|end_filename|>
include config.mk

all : inigo
.PHONY : bootstrap server idrall inigo install static local-server deploy-init deploy test clean distclean golden

define build_base_dep
	(cd Base/$(1) && idris2 --build Bootstrap.ipkg --build-dir ../../build)
endef

bootstrap :
	mkdir -p build
	$(call build_base_dep,Color)
	$(call build_base_dep,Extra)
	$(call build_base_dep,Fmt)
	$(call build_base_dep,IdrTest)
	$(call build_base_dep,Markdown)
	$(call build_base_dep,SemVar)
	$(call build_base_dep,Toml)
	$(MAKE) inigo

server :
	idris2 --build Server/InigoServer.ipkg --cg node

idrall :
	idris2 --build idrall/idrall.ipkg
	mkdir -p depends/idrall-0
	cp -r idrall/build/ttc/* depends/idrall-0/

inigo : idrall
	idris2 --build Inigo.ipkg --cg node
	echo '#!/usr/bin/env node' | cat - build/exec/inigo > temp && mv temp build/exec/inigo
	chmod +x build/exec/inigo
	@echo "Built \"build/exec/inigo\""

install : inigo
	cp build/exec/inigo $(INSTALL_DIR)
	chmod +x $(INSTALL_DIR)/inigo

static :
	env SKIP_EXT=true node Server/InigoStatic/localize.js Server/InigoStatic/Pages Server/InigoStatic/Local/pages.json
	node Server/InigoStatic/localize.js Server/InigoStatic/Static Server/InigoStatic/Local/static.json

local-server : server static
	cloudworker --debug \
		--kv-file "pages=./Server/InigoStatic/Local/pages.json" \
		--kv-file "static=./Server/InigoStatic/Local/static.json" \
		--kv-file "index=./Server/InigoStatic/Local/index.json" \
		--kv-file "packages=./Server/InigoStatic/Local/packages.json" \
		--kv-file "deps=./Server/InigoStatic/Local/deps.json" \
		--kv-file "archives=./Server/InigoStatic/Local/archives.json" \
		--kv-file "readme=./Server/InigoStatic/Local/readme.json" \
		--kv-file "accounts=./Server/InigoStatic/Local/accounts.json" \
		--kv-file "sessions=./Server/InigoStatic/Local/sessions.json" \
		build/exec/inigo-server

deploy-init :
	terraform init -upgrade -var-file=${HOME}/InigoStatic.tfvars InigoStatic

deploy : static server
	terraform apply -var-file=${HOME}/InigoStatic.tfvars Server/InigoStatic

test :
	idris2 --find-ipkg Test/Suite.idr --cg node -x suite

clean :
	idris2 --clean Inigo.ipkg
	idris2 --clean idrall/idrall.ipkg

testbin :
	${MAKE} -C golden testbin

golden : testbin
	${MAKE} -C golden only=$(only)

distclean : clean
	$(RM) -r build


<|start_filename|>Base/Markdown/Test/Suite.idr<|end_filename|>
module Test.Suite

import IdrTest.Test

import Test.Markdown.Format.HtmlTest
import Test.Markdown.LexerTest
import Test.MarkdownTest

suite : IO ()
suite = do
  runSuites
    [ Test.Markdown.LexerTest.suite
    , Test.MarkdownTest.suite
    , Test.Markdown.Format.HtmlTest.suite
    ]


<|start_filename|>Client/Skeleton/BaseWithTest/Package.idr<|end_filename|>
module Client.Skeleton.BaseWithTest.Package

import Fmt

export
name : (String, String) -> List String
name (packageNS, packageName) = [packageName ++ ".idr"]

export
build : (String, String) -> String
build (packageNS, packageName) = fmt """
module %s

main : IO ()
main =
  putStrLn \"Hello from %s.%s\"
""" packageName packageNS packageName


<|start_filename|>Base/SemVar/SemVar/Parser.idr<|end_filename|>
module SemVar.Parser

import SemVar.Lexer
import SemVar.Data
import Text.Parser
import Text.Token
import Data.List

import public SemVar.Tokens

%default total

release : Grammar _ SemVarToken True String
release =
  do
    match Hyphen
    match Text

metadata : Grammar _ SemVarToken True String
metadata =
  do
    match Plus
    match Text

dotOrDefault : Grammar _ SemVarToken False Int
dotOrDefault =
  option 0 (
    do
      match Dot
      match Number
  )

version : Grammar _ SemVarToken True Version
version =
  do
    major <- match Number
    minor <- dotOrDefault
    patch <- dotOrDefault
    release <- optional release
    metadata <- optional metadata
    pure (MkVersion major minor patch release metadata)

tilde : Grammar _ SemVarToken True Requirement
tilde =
  do
    match Tilde
    v <- version
    pure $ AND (GTE v) (LT $ nextMinor v)

pin : Grammar _ SemVarToken True Requirement
pin =
  do
    match Caret
    v <- version
    pure $ case v of
      MkVersion 0 0 patch Nothing Nothing =>
        EQ v
      _ =>
        AND (GTE v) (LT $ nextMajor v)

exact : Grammar _ SemVarToken True Requirement
exact =
  do
    ignore $ optional (match CmpEQ)
    v <- version
    pure $ EQ v

gt : Grammar _ SemVarToken True Requirement
gt =
  do
    ignore $ optional (match CmpGT)
    v <- version
    pure $ GT v

lt : Grammar _ SemVarToken True Requirement
lt =
  do
    ignore $ optional (match CmpLT)
    v <- version
    pure $ LT v

gte : Grammar _ SemVarToken True Requirement
gte =
  do
    ignore $ optional (match CmpGTE)
    v <- version
    pure $ GTE v

lte : Grammar _ SemVarToken True Requirement
lte =
  do
    ignore $ optional (match CmpLTE)
    v <- version
    pure $ LTE v

range : Grammar _ SemVarToken True Requirement
range =
  do
    v0 <- version
    ignore $ optional (match Whitespace)
    match Hyphen
    ignore $ optional (match Whitespace)
    v1 <- version
    pure $ AND (GTE v0) (LTE v1)

simpleRequirement : Grammar _ SemVarToken True Requirement
simpleRequirement =
  (
        range
    <|> tilde
    <|> pin
    <|> exact
    <|> gte
    <|> gt
    <|> lte
    <|> lt
  )

conj : Grammar _ SemVarToken True Requirement
conj =
  do
    v0 <- simpleRequirement
    match Whitespace
    v1 <- simpleRequirement
    pure $ AND v0 v1

disjuction : Grammar _ SemVarToken True Requirement
disjuction =
  do
    v0 <- simpleRequirement
    ignore $ optional (match Whitespace)
    ignore $ match Pipe
    ignore $ optional (match Whitespace)
    v1 <- simpleRequirement
    pure $ OR v0 v1

requirement : Grammar _ SemVarToken True Requirement
requirement =
  (
        conj
    <|> disjuction
    <|> simpleRequirement
  )

export
parseVersionToks : List (WithBounds SemVarToken) -> Maybe Version
parseVersionToks toks = case parse version toks of
                      Right (j, []) => Just j
                      _ => Nothing

export
parseRequirementToks : List (WithBounds SemVarToken) -> Maybe Requirement
parseRequirementToks toks = case parse requirement toks of
                      Right (j, []) => Just j
                      _ => Nothing


<|start_filename|>Base/SemVar/Test/SemVar/DataTest.idr<|end_filename|>
module Test.SemVar.DataTest

import IdrTest.Test
import IdrTest.Expectation

import Data.List

import SemVar
import SemVar.Data
import SemVar.Parser

repeat : a -> Nat -> List a
repeat _ Z = []
repeat x (S n) = x :: repeat x n

satisfySpecs : List (String, List String, List String)
satisfySpecs =
  [
    (
      "~1.2.3",
      ["1.2.3", "1.2.99"],
      ["1.2.3-prerelease+commit", "1.3.0", "1.3.1"]
    ),
    (
      "^1.2.3",
      ["1.2.3", "1.3.99"],
      ["1.2.3-prerelease+commit", "2.0.0", "5.3.1"]
    )
  ]

export
suite : Test
suite =
  let
    satisfyTests =
      concat $ map (\(reqText, sat, unsat) =>
        let
          reqM = parseRequirement reqText
          satZ = zip sat (repeat True (length sat))
          unsatZ = zip unsat (repeat False (length unsat))
        in
          map (\(v, isSat) =>
            let
              verb = if isSat then " satisfies " else " does not satisfy "
              testName = v ++ verb ++ reqText
            in
              case (parseVersion v, reqM) of
                (Just version, Just req) =>
                  test testName (\_ => assertEq (desc isSat) (desc (satisfy req version)))
                _ =>
                  test testName (\_ => assertEq "Failed to parse test" "")
          )
          (satZ ++ unsatZ)
      ) satisfySpecs
  in
    describe "Data Tests"
      [ describe "Satisfy Specs" satisfyTests
      ]
  where
    desc : Bool -> String
    desc True = "sat"
    desc False = "unsat"


<|start_filename|>Inigo/Util/Url/Url.idr<|end_filename|>
module Inigo.Util.Url.Url

-- TODO: Improve here
public export
record Url where
  constructor MkUrl
  host : String
  path : String

export
fromHostPath : String -> String -> Url
fromHostPath host path =
  MkUrl host path

export
toString : Url -> String
toString url =
  host url ++ path url


<|start_filename|>Test/Inigo/Package/PackageIndexTest.idr<|end_filename|>
module Test.Inigo.Package.PackageIndexTest

import IdrTest.Test
import IdrTest.Expectation

import Data.List
import Inigo.Async.Promise
import Inigo.Package.PackageIndex
import SemVar.Data
import Test.Inigo.Package.PackageTest
import Toml

exampleIndexToml : String
exampleIndexToml = """
[[pkg]]
ns=\"Example\"
package=\"Cool\"
description=\"cool package\"
version=\"1.2.3\"

[[pkg]]
ns=\"Example\"
package=\"Funk\"
description=\"funky package\"
version=\"10.0.0\"
"""

exampleIndex : PackageIndex
exampleIndex =
  [ MkPackageMeta "Example" "Cool" (Just "cool package") (MkVersion 1 2 3 Nothing Nothing)
  , MkPackageMeta "Example" "Funk" (Just "funky package") (MkVersion 10 0 0 Nothing Nothing)
  ]

exampleIndexExp : PackageIndex
exampleIndexExp =
  [ MkPackageMeta "Example" "Cool" (Just "cool package") (MkVersion 1 2 3 Nothing Nothing)
  , MkPackageMeta "Example" "Inigo" (Just "what pkg") (MkVersion 0 10 0 Nothing Nothing)
  , MkPackageMeta "Example" "Funk" (Just "funky package") (MkVersion 10 0 0 Nothing Nothing)
  ]

exampleInigoMeta : PackageMeta
exampleInigoMeta =
  MkPackageMeta "Example" "Inigo" (Just "My Description") (MkVersion 0 0 1 (Just "pre") Nothing)

toTomlTest : Test
toTomlTest =
  test "To Toml" (\_ => assertEq
    (toToml exampleIndex)
    [(["pkg"],
      ArrTab
        [
          [ (["ns"], Str "Example")
          , (["package"], Str "Cool")
          , (["description"], Str "cool package")
          , (["version"], Str "1.2.3")
          ],
          [ (["ns"], Str "Example")
          , (["package"], Str "Funk")
          , (["description"], Str "funky package")
          , (["version"], Str "10.0.0")
          ]
        ]
    )]
  )

encodePackageIndexTest : Test
encodePackageIndexTest =
  test "Encode package index" (\_ => assertEq
    (encodePackageIndex exampleIndex)
    exampleIndexToml
  )

toPackageMetaTest : Test
toPackageMetaTest =
  test "fromPackage" (\_ => assertEq
    (fromPackage examplePackage)
    exampleInigoMeta
  )

updatePackageMetaNewTest : Test
updatePackageMetaNewTest =
  test "updatePackageMeta New Package" (\_ => assertEq
    (
      updatePackageMeta
        exampleIndex
        examplePackage
    )
    (snoc exampleIndex exampleInigoMeta)
  )

updatePackageMetaExistingTest : Test
updatePackageMetaExistingTest =
  test "updatePackageMeta Existing Package" (\_ => assertEq
    (
      updatePackageMeta
        exampleIndexExp
        examplePackage
    )
    [ MkPackageMeta "Example" "Cool" (Just "cool package") (MkVersion 1 2 3 Nothing Nothing)
    , MkPackageMeta "Example" "Inigo" (Just "My Description") (MkVersion 0 0 1 (Just "pre") Nothing)
    , MkPackageMeta "Example" "Funk" (Just "funky package") (MkVersion 10 0 0 Nothing Nothing)
    ]
  )

export
suite : Test
suite =
  describe "Package Index"
    [ test "Parse Example Index" (\_ => assertEq
        (parsePackageIndex exampleIndexToml)
        (Right exampleIndex)
      )
    , test "Search Index" (\_ => assertEq
        (((map $ searchPackageIndex "fun") . parsePackageIndex) exampleIndexToml)
        (Right $ 
          [ MkPackageMeta "Example" "Funk" (Just "funky package") (MkVersion 10 0 0 Nothing Nothing)
          ]
        )
      )
    , toTomlTest
    , encodePackageIndexTest
    , toPackageMetaTest
    , updatePackageMetaNewTest
    , updatePackageMetaExistingTest
    ]


<|start_filename|>Base/SemVar/Test/SemVar/ParserTest.idr<|end_filename|>
module Test.SemVar.ParserTest

import IdrTest.Test
import IdrTest.Expectation

import SemVar
import SemVar.Data
import SemVar.Parser

versionSpecs : List (String, Maybe Version)
versionSpecs =
  [
    (
      "1.2.3-prerelease+commit",
      Just (MkVersion 1 2 3 (Just "prerelease") (Just "commit"))
    ),
    (
      "1.2.3",
      Just (MkVersion 1 2 3 Nothing Nothing)
    )
  ]

-- TODO: Build a lot more examples from https://devhints.io/semver
-- TODO: Cover wildcards and partial ranges
reqSpecs : List (String, Maybe Requirement)
reqSpecs =
  [
    (
      "~1.2.3",
      Just (
        AND
          (GTE $ MkVersion 1 2 3 Nothing Nothing)
          (LT $ MkVersion 1 3 0 Nothing Nothing)
      )
    ),
    (
      "^1.2.3",
      Just (
        AND
          (GTE $ MkVersion 1 2 3 Nothing Nothing)
          (LT $ MkVersion 2 0 0 Nothing Nothing)
      )
    ),
    (
      "^0.2.3",
      Just (
        AND
          (GTE $ MkVersion 0 2 3 Nothing Nothing)
          (LT $ MkVersion 0 3 0 Nothing Nothing)
      )
    ),
    (
      "^0.0.1",
      Just (
        EQ $ MkVersion 0 0 1 Nothing Nothing
      )
    ),
    (
      "^1.2",
      Just (
        AND
          (GTE $ MkVersion 1 2 0 Nothing Nothing)
          (LT $ MkVersion 2 0 0 Nothing Nothing)
      )
    ),
    (
      "~1.2",
      Just (
        AND
          (GTE $ MkVersion 1 2 0 Nothing Nothing)
          (LT $ MkVersion 1 3 0 Nothing Nothing)
      )
    ),
    (
      "^1",
      Just (
        AND
          (GTE $ MkVersion 1 0 0 Nothing Nothing)
          (LT $ MkVersion 2 0 0 Nothing Nothing)
      )
    ),
    -- (
    --   "~1",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 0 0 Nothing Nothing)
    --       (LT $ MkVersion 2 0 0 Nothing Nothing)
    --   )
    -- ),
    -- (
    --   "1.x",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 0 0 Nothing Nothing)
    --       (LT $ MkVersion 2 0 0 Nothing Nothing)
    --   )
    -- ),
    -- (
    --   "1",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 0 0 Nothing Nothing)
    --       (LT $ MkVersion 2 0 0 Nothing Nothing)
    --   )
    -- ),
    -- (
    --   "*",
    --   Just (
    --     GTE $ MkVersion 0 0 0 Nothing Nothing
    --   )
    -- ),
    -- (
    --   "x",
    --   Just (
    --     GTE $ MkVersion 0 0 0 Nothing Nothing
    --   )
    -- ),
    -- (
    --   "1.2.x",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 2 0 Nothing Nothing)
    --       (LT $ MkVersion 1 3 0 Nothing Nothing)
    --   )
    -- ),
    -- (
    --   ">= 1.2.x",
    --   Just (
    --     GTE $ MkVersion 1 2 0 Nothing Nothing
    --   )
    -- ),
    -- (
    --   "<= 2.x",
    --   Just (
    --     LT $ MkVersion 3 0 0 Nothing Nothing
    --   )
    -- ),
    -- (
    --   "~1.2.x",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 2 0 Nothing Nothing)
    --       (LT $ MkVersion 1 3 0 Nothing Nothing)
    --   )
    -- ),
    (
      "1.2.3",
      Just (
        EQ $ MkVersion 1 2 3 Nothing Nothing
      )
    ),
    (
      "=1.2.3",
      Just (
        EQ $ MkVersion 1 2 3 Nothing Nothing
      )
    ),
    (
      ">1.2.3",
      Just (
        GT $ MkVersion 1 2 3 Nothing Nothing
      )
    ),
    (
      "<1.2.3",
      Just (
        LT $ MkVersion 1 2 3 Nothing Nothing
      )
    ),
    (
      ">=1.2.3",
      Just (
        GTE $ MkVersion 1 2 3 Nothing Nothing
      )
    ),
    (
      "1.2.3 -  2.3.4",
      Just (
        AND
          (GTE $ MkVersion 1 2 3 Nothing Nothing)
          (LTE $ MkVersion 2 3 4 Nothing Nothing)
      )
    ),
    -- (
    --   "1.2.3 - 2.3",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 2 3 Nothing Nothing)
    --       (LT $ MkVersion 2 4 0 Nothing Nothing)
    --   )
    -- ),
    -- (
    --   "1.2.3 - 2",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 2 3 Nothing Nothing)
    --       (LT $ MkVersion 3 0 0 Nothing Nothing)
    --   )
    -- ),
    -- (
    --   "1.2 - 2.3.0",
    --   Just (
    --     AND
    --       (GTE $ MkVersion 1 2 0 Nothing Nothing)
    --       (LTE $ MkVersion 2 3 0 Nothing Nothing)
    --   )
    -- ),
    (
      ">=0.14 <16",
      Just (
        AND
          (GTE $ MkVersion 0 14 0 Nothing Nothing)
          (LT $ MkVersion 16 0 0 Nothing Nothing)
      )
    ),
    (
      "0.14.0 || 15.0.0",
      Just (
        OR
          (EQ $ MkVersion 0 14 0 Nothing Nothing)
          (EQ $ MkVersion 15 0 0 Nothing Nothing)
      )
    )
    -- (
    --   "0.14.x || 15.x.x",
    --   Just (
    --     OR
    --       (AND
    --         (GTE $ MkVersion 0 14 0 Nothing Nothing)
    --         (LT $ MkVersion 16 0 0 Nothing Nothing)
    --       )
    --       (AND
    --         (GTE $ MkVersion 0 14 0 Nothing Nothing)
    --         (LT $ MkVersion 16 0 0 Nothing Nothing)
    --       )
    --   )
    -- )
  ]

export
suite : Test
suite =
  let
    versionTests =
      map (\(text, result) =>
        test text (\_ => assertEq (parseVersion text) result)
      ) versionSpecs

    reqTests =
      map (\(text, result) =>
        test text (\_ => assertEq (parseRequirement text) result)
      ) reqSpecs
  in
    describe "Parser Tests"
      [ describe "Version Specs" versionTests
      , describe "Requirement Specs" reqTests
      ]


<|start_filename|>Base/Extra/Extra/String.idr<|end_filename|>
module Extra.String

import Data.List
import Data.List1
import Data.Maybe
import Data.String
import Extra.List
import Extra.Op

public export
join : String -> List String -> String
join joiner strs =
  foldl (++) "" (Data.List.intersperse joiner strs)

export
findAll : String -> String -> List Nat
findAll str lookup =
  findAll (unpack str) (unpack lookup)

export
replace : String -> String -> String -> String
replace k v str =
  pack (Extra.List.replace (unpack str) (unpack k) (unpack v))

export
wrap : String -> String -> String
wrap sym str =
  sym ++ str ++ sym

export
filter : (Char -> Bool) -> String -> String
filter test =
  pack . filter test . unpack

export
showList : (a -> String) -> List a -> String
showList f els =
  "[" ++ (join "," (map f els)) ++ "]"

export
listOp : (List Char -> List Char) -> String -> String
listOp op =
  pack . op . unpack

export
split : Char -> String -> List String
split c =
  ( map pack ) . Data.List1.forget . (Data.List.split (== c)) . unpack

export
includesAny : String -> String -> Bool
includesAny search =
  let
    searchChars = unpack search
  in
     any (\c => c `elem` searchChars) . unpack

export
quote : String -> String
quote =
  (wrap "\"")
  . (replace "\n" "\\n")
  . (replace "\"" "\\\"")

export
unquote : String -> String
unquote =
  (replace "\\n" "\n") .
  (listOp (reverse . drop 1 . reverse . drop 1))

export
limit : Nat -> String -> String
limit len str =
  if length str > len then
    (strSubstr 0 (cast len) str) ++ "..."
  else
    str


<|start_filename|>Client/Skeleton/BaseWithTest/InigoTOML.idr<|end_filename|>
module Client.Skeleton.BaseWithTest.InigoTOML

import Fmt

export
name : (String, String) -> List String
name = const ["Inigo.toml"]

export
build : (String, String) -> String
build (packageNS, packageName) = fmt """
ns=\"%s\"
package=\"%s\"
version=\"0.0.1\"

description=\"\"
link=\"\"
readme=\"\"
modules=[\"%s\"]
depends=[]
license=\"\"
main=\"%s\"
executable=\"%s\"

[deps]

[dev-deps]
Base.IdrTest=\"~0.0.1\"
""" packageNS packageName packageName packageName packageName


<|start_filename|>golden/Makefile<|end_filename|>
INIGO_LOCAL_PATH=../../../build/exec/inigo

INTERACTIVE ?= --interactive

.PHONY: testbin test

test:
	./build/exec/runtests $(INIGO_LOCAL_PATH) $(INTERACTIVE) --failure-file failures --only $(only)

retest:
	@touch failures
	./build/exec/runtests $(INIGO_LOCAL_PATH) $(INTERACTIVE) --failure-file failures --only-file failures --only $(only)

testbin:
	idris2 --build tests.ipkg

clean:
	$(RM) -r build
	@find . -type f -name 'output' -exec rm -rf {} \;
	@find . -type f -name '*.ttc' -exec rm -f {} \;
	@find . -type f -name '*.ttm' -exec rm -f {} \;
	@find . -type f -name '*.ibc' -exec rm -f {} \;


<|start_filename|>Client/Action/Pull.idr<|end_filename|>
module Client.Action.Pull

import Client.Server
import Data.Buffer
import Extra.Buffer
import Fmt
import Inigo.Archive.Path
import Inigo.Async.Archive
import Inigo.Async.Base
import Inigo.Async.Fetch
import Inigo.Async.FS
import Inigo.Async.Promise
import Inigo.Package.Package
import Inigo.Util.Url.Url
import System.Path
import SemVar

getPath : String -> String -> (Maybe Version) -> String
getPath ns package Nothing = getPackageUrl ns package
getPath ns package (Just version) = getPackageVersionUrl ns package version

getPackage : Server -> String -> String -> (Maybe Version) -> Promise Package
getPackage server packageNS packageName maybeVersion =
  do
    let path = getPath packageNS packageName maybeVersion
    let url = toString (fromHostPath (host server) path)
    log ("Requesting " ++ url ++ "...")
    contents <- fetch url
    let Right package = parsePackage contents
      | Left err => reject ("Invalid package: " ++ err)
    pure package

getArchive : Server -> Package -> Promise Buffer
getArchive server pkg =
  do
    let url = toString (fromHostPath (host server) (getArchiveUrl pkg))
    log ("Requesting " ++ url ++ "...")
    contents <- fetchBuf url
    pure contents

export
pull : Server -> String -> String -> (Maybe Version) -> Promise ()
pull server packageNS packageName maybeVersion =
  do
    pkg <- getPackage server packageNS packageName maybeVersion
    archive <- getArchive server pkg
    let depPath = Archive.Path.depPath pkg
    extractArchive archive depPath
    let iPkgFile = depPath </> "Inigo.ipkg"
    log (fmt "Writing %s..." iPkgFile)
    fs_writeFile iPkgFile (Package.Package.generateIPkg False (Just "../../../../build") pkg)


<|start_filename|>Inigo/Async/FS.idr<|end_filename|>
module Inigo.Async.FS

import Inigo.Async.Promise
import Inigo.Async.Util
import Data.Buffer
import Extra.Buffer
import System.Path

%foreign (promisifyPrim "(path)=>require('fs').promises.readFile(path,'utf8')")
fs_readFile__prim : String -> promise String

%foreign (promisifyPrim "(path)=>require('fs').promises.readFile(path)")
fs_readFileBuf__prim : String -> promise Buffer

%foreign (promisifyPrim "(path,contents)=>require('fs').promises.writeFile(path,contents)")
fs_writeFile__prim : String -> String -> promise ()

%foreign (promisifyPrim "(path,contents)=>require('fs').promises.writeFile(path,contents)")
fs_writeFileBuf__prim : String -> Buffer -> promise ()

%foreign (promisifyPrim "(path,r)=>require('fs').promises.mkdir(path,{recursive: r === 1})")
fs_mkdir__prim : String -> Int -> promise ()

%foreign (promisifyPrim "(path,r)=>require('fs').promises.rmdir(path,{recursive: r === 1})")
fs_rmdir__prim : String -> Int -> promise ()

%foreign (promisifyPrim "(path)=>require('fs').promises.readdir(path).then(__prim_js2idris_array)")
fs_getFiles__prim : String -> promise (List String)

%foreign (promisifyPrim "(path)=>require('fs').promises.stat(path).then((s)=>s.isDirectory() ? 1 : 0)")
fs_isDir__prim : String -> promise Int

%foreign (promisifyPrim "(path)=>require('fs').promises.access(path).then(()=>1).catch(()=>0)")
fs_exists__prim : String -> promise Int

export
fs_readFile : String -> Promise String
fs_readFile path =
  promisify (fs_readFile__prim path)

export
fs_writeFile : String -> String -> Promise ()
fs_writeFile path contents =
  promisify (fs_writeFile__prim path contents)

export
fs_readFileBuf : String -> Promise Buffer
fs_readFileBuf path =
  promisify (fs_readFileBuf__prim path)

export
fs_writeFileBuf : String -> Buffer -> Promise ()
fs_writeFileBuf path contents =
  promisify (fs_writeFileBuf__prim path contents)

export
fs_mkdir : Bool -> String -> Promise ()
fs_mkdir recursive path =
  promisify (fs_mkdir__prim path (boolToInt recursive))

export
fs_rmdir : Bool -> String -> Promise ()
fs_rmdir recursive path =
  promisify (fs_rmdir__prim path (boolToInt recursive))

export
fs_getFiles : String -> Promise (List String)
fs_getFiles path =
  promisify (fs_getFiles__prim path)

export
fs_isDir : String -> Promise Bool
fs_isDir path =
  intToBool <$> promisify (fs_isDir__prim path)

export
fs_exists : String -> Promise Bool
fs_exists path =
  intToBool <$> promisify (fs_exists__prim path)

export
fs_getFilesR : String -> Promise (List String)
fs_getFilesR path =
  doGetFilesR path
  where
  doGetFilesR : String -> Promise (List String)
  doGetFilesR path =
    do
      isDir <- fs_isDir path
      if isDir
        then do
          entries <- fs_getFiles path
          let fullEntries = map (path </>) entries
          allFiles <- all (map doGetFilesR fullEntries)
          pure (concat allFiles)
        else
          pure [path]
