0 | module Collie.Parser
 1 |
 2 | import Data.List
 3 | import Data.String
 4 | import Data.Either
 5 | import Data.Maybe
 6 | import Data.Fun
 7 | import Data.Record
 8 | import Collie.Core
 9 |
10 | %default total
11 |
12 | public export
13 | parseCommand : (cmd : Command nm) -> List String ->
14 |   ParsedCommandT Maybe Maybe nm cmd -> Error (ParsedCommandT Maybe Maybe nm cmd)
15 |
16 | public export
17 | parseModifier : (cmd : Command nm) -> {modName : String} ->
18 |   (pos : modName `IsField` cmd.modifiers) -> (rest : List String) ->
19 |   ParsedCommandT Maybe Maybe nm cmd ->
20 |   (factory : ParsedModifierT Prelude.id Prelude.id (snd $ field pos) ->
21 |              Error (ParsedModifiersT Maybe Maybe cmd.modifiers)) ->
22 |   Error (ParsedCommandT Maybe Maybe nm cmd)
23 |
24 | parseCommand cmd [] old = pure old
25 | parseCommand cmd ("--" :: xs) old = do
26 |   u <- cmd.arguments.parse old.arguments xs
27 |   pure $ { arguments := u } old
28 |
29 | parseCommand cmd (x :: xs) old
30 |   = case x `isField` cmd.modifiers of
31 |       No  _   => do u <- old.arguments.update x
32 |                     parseCommand cmd xs $ { arguments := u} old
33 |       Yes pos => parseModifier cmd pos xs old (old.modifiers.update pos)
34 |
35 | parseModifier  cmd pos rest old factory with (snd $ field pos)
36 |  parseModifier cmd pos rest old factory | MkFlag   flg = do
37 |     mods <- factory True
38 |     parseCommand cmd rest $ { modifiers := mods } old
39 |  parseModifier cmd pos rest old factory | MkOption opt
40 |    = case rest of
41 |        []      => throwE (MissingOptArg modName)
42 |        x :: xs => do args <- (opt.project "arguments").parser x
43 |                      mods <- factory args
44 |                      parseCommand cmd xs $ { modifiers := mods} old
45 |
46 | public export
47 | parse : (cmd : Command nm) -> List String -> Error $ ParseTreeT Maybe Maybe cmd
48 | parse cmd [] = pure (Here initParsedCommand)
49 | parse cmd xs@("--" :: _) = Here <$> parseCommand cmd xs initParsedCommand
50 | parse cmd ys@(x :: xs) = case x `isField` cmd.subcommands of
51 |                            Yes pos => There pos <$> parse (snd $ field pos) xs
52 |                            No  _   => Here <$> parseCommand cmd ys initParsedCommand
53 |