├── agdARGS.agda-lib ├── doc ├── TTT-2017.pdf ├── screenshot.png ├── 2015-03-18-IIM.pdf ├── Makefile ├── Sum.tex ├── 2017-01-06.tex ├── 2017-01-15.tex ├── 2015-03-18-IIM.tex ├── TTT-2017.tex ├── TTT-2017.bib ├── agda.sty └── WordCount.tex ├── .gitignore ├── Makefile ├── agdARGS ├── all.sh ├── System │ ├── Environment │ │ ├── Arguments.agda │ │ └── Arguments │ │ │ └── Primitive.agda │ └── Console │ │ ├── CLI │ │ ├── Usual.agda │ │ ├── Parser.agda │ │ ├── Examples.agda │ │ └── Usage.agda │ │ ├── Options │ │ ├── Domain.agda │ │ ├── Usage.agda │ │ ├── Usual.agda │ │ └── Instances.agda │ │ ├── Modifiers.agda │ │ ├── CLI.agda │ │ └── Options.agda ├── Data │ ├── UniqueSortedList │ │ ├── Usual.agda │ │ ├── Examples.agda │ │ └── SmartConstructors.agda │ ├── Maybe.agda │ ├── Sum.agda │ ├── Record │ │ ├── Usual.agda │ │ ├── Properties.agda │ │ ├── Examples.agda │ │ └── SmartConstructors.agda │ ├── Error.agda │ ├── Integer │ │ └── Read.agda │ ├── List.agda │ ├── String.agda │ ├── Nat │ │ └── Read.agda │ ├── Table.agda │ ├── UniqueSortedList.agda │ ├── Infinities.agda │ └── Record.agda ├── Examples │ ├── Git.agda │ ├── Echo.agda │ ├── Grep.agda │ ├── Repl.agda │ ├── Sum.agda │ └── WordCount.agda ├── Algebra │ ├── Monoid.agda │ └── Magma.agda └── Relation │ └── Nullary.agda └── README.md /agdARGS.agda-lib: -------------------------------------------------------------------------------- 1 | name: agdARGS 2 | include: . 3 | depend: standard-library 4 | -------------------------------------------------------------------------------- /doc/TTT-2017.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gallais/agdARGS/HEAD/doc/TTT-2017.pdf -------------------------------------------------------------------------------- /doc/screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gallais/agdARGS/HEAD/doc/screenshot.png -------------------------------------------------------------------------------- /doc/2015-03-18-IIM.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gallais/agdARGS/HEAD/doc/2015-03-18-IIM.pdf -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai 2 | *~ 3 | *.aux 4 | *latexmk 5 | *.log 6 | *.nav 7 | *.out 8 | *.snm 9 | *.toc 10 | *.vrb 11 | *.sty 12 | __build/ 13 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | ./build.sh agdARGS/Examples/Sum.agda 3 | ./build.sh agdARGS/Examples/WordCount.agda 4 | ./build.sh agdARGS/Examples/Echo.agda 5 | 6 | clean: 7 | rm -rf __build/ 8 | -------------------------------------------------------------------------------- /agdARGS/all.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | echo "module agdARGS.All where\n" > All.agda 4 | git ls-tree --full-tree -r --name-only HEAD | grep "\.agda$" | sed "s/\.agda$//" | sed "s|^|open import |" | sed "s|/|.|g" | sort >> All.agda 5 | -------------------------------------------------------------------------------- /agdARGS/System/Environment/Arguments.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Environment.Arguments where 2 | 3 | open import Data.List 4 | open import Data.String 5 | open import IO 6 | import agdARGS.System.Environment.Arguments.Primitive as Prim 7 | 8 | getArgs : IO (List String) 9 | getArgs = lift Prim.getArgs 10 | -------------------------------------------------------------------------------- /agdARGS/Data/UniqueSortedList/Usual.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.UniqueSortedList.Usual where 2 | 3 | open import Data.String 4 | 5 | open import agdARGS.Data.UniqueSortedList strictTotalOrder as USL public 6 | open import agdARGS.Data.UniqueSortedList.SmartConstructors strictTotalOrder public 7 | open USL.withEqDec _≟_ public -------------------------------------------------------------------------------- /agdARGS/Examples/Git.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Examples.Git where 2 | 3 | open import agdARGS.System.Console.CLI.Examples 4 | open import agdARGS.System.Console.CLI.Usual 5 | open import agdARGS.System.Console.CLI.Usage 6 | open import Function 7 | open import IO 8 | 9 | main = withCLI git $ const $ putStrLn $ usage git 10 | -------------------------------------------------------------------------------- /agdARGS/Data/Maybe.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Maybe where 2 | 3 | open import Level 4 | open import Data.Unit 5 | open import Data.Empty 6 | open import Data.Maybe 7 | open import Function 8 | 9 | fromJust : ∀ {ℓ : Level} {A : Set ℓ} (a : Maybe A) {pr : maybe′ (const ⊤) ⊥ a} → A 10 | fromJust (just a) = a 11 | fromJust nothing {()} 12 | -------------------------------------------------------------------------------- /agdARGS/Data/Sum.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Sum where 2 | 3 | open import Level 4 | open import Data.Sum 5 | open import Function 6 | open import Category.Monad 7 | 8 | monad : {ℓᵃ : Level} (A : Set ℓᵃ) {ℓᵇ : Level} → 9 | RawMonad ((Set (ℓᵃ ⊔ ℓᵇ) → Set (ℓᵃ ⊔ ℓᵇ)) ∋ _⊎_ A ) 10 | monad A {ℓᵇ} = 11 | record { return = inj₂ 12 | ; _>>=_ = [ flip (const inj₁) , flip _$_ ]′ } -------------------------------------------------------------------------------- /agdARGS/Data/Record/Usual.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Record.Usual where 2 | 3 | open import Data.String 4 | 5 | open import agdARGS.Data.UniqueSortedList.Usual public 6 | hiding (module NeverFail) 7 | open import agdARGS.Data.Record strictTotalOrder as Rec public 8 | open import agdARGS.Data.Record.SmartConstructors strictTotalOrder as SC 9 | hiding (module withEqDec) public 10 | open SC.withEqDec _≟_ public 11 | -------------------------------------------------------------------------------- /agdARGS/System/Environment/Arguments/Primitive.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Environment.Arguments.Primitive where 2 | 3 | open import IO.Primitive 4 | open import Data.List 5 | open import Data.String 6 | 7 | {-# FOREIGN GHC import qualified System.Environment #-} 8 | {-# FOREIGN GHC import qualified Data.Text #-} 9 | 10 | postulate 11 | getArgs : IO (List String) 12 | 13 | {-# COMPILE GHC getArgs = fmap Data.Text.pack <$> System.Environment.getArgs #-} 14 | -------------------------------------------------------------------------------- /agdARGS/Data/UniqueSortedList/Examples.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.UniqueSortedList.Examples where 2 | 3 | open import Data.String 4 | open import agdARGS.Data.UniqueSortedList strictTotalOrder 5 | open import agdARGS.Data.UniqueSortedList.SmartConstructors strictTotalOrder 6 | 7 | Characteristics : USL 8 | Characteristics = let open MayFail in "name" `∷ "age" `∷ "idcard" `∷ `[] 9 | 10 | Characteristics′ : USL 11 | Characteristics′ = let open NeverFail in "name" `∷ "age" `∷ "idcard" `∷ `[] 12 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | LATEX=latexmk -pdf -use-make -e '$$pdflatex=q/xelatex --shell-escape %O %S/' 2 | PAPER=TTT-2017 3 | SLIDES=2017-01-06 4 | # latexmk -bibtex -pdf -e '$$pdflatex=q/xelatex --shell-espace %O %S/' 5 | 6 | all: paper slides 7 | 8 | prepare: 9 | mkdir -p __build/ 10 | cp *.tex *.bib *.sty *.cls *.png __build/ 11 | 12 | paper: prepare 13 | cd __build/ && ${LATEX} ${PAPER}.tex 14 | ln -sf __build/${PAPER}.pdf 15 | 16 | slides: prepare 17 | cd __build/ && ${LATEX} ${SLIDES}.tex 18 | ln -sf __build/${SLIDES}.pdf 19 | 20 | clean: 21 | rm -rf ${SLIDES}.pdf ${PAPER}.pdf __build/ 22 | -------------------------------------------------------------------------------- /agdARGS/Data/Error.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Error where 2 | 3 | open import Level 4 | open import Data.Sum 5 | open import Data.String 6 | open import Function 7 | 8 | Error : ∀ {ℓ} → Set ℓ → Set ℓ 9 | Error = String ⊎_ 10 | 11 | throw : ∀ {ℓ} {A : Set ℓ} → String → Error A 12 | throw = inj₁ 13 | 14 | return : ∀ {ℓ} {A : Set ℓ} → A → Error A 15 | return = inj₂ 16 | 17 | infixr 0 _>>=_ 18 | _>>=_ : ∀ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} → Error A → (A → Error B) → Error B 19 | inj₁ err >>= f = inj₁ err 20 | inj₂ a >>= f = f a 21 | 22 | infixl 1 _<$>_ 23 | _<$>_ : ∀ {ℓ ℓ′} {A : Set ℓ} {B : Set ℓ′} → (A → B) → Error A → Error B 24 | f <$> ma = ma >>= return ∘ f 25 | -------------------------------------------------------------------------------- /agdARGS/System/Console/CLI/Usual.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.CLI.Usual where 2 | 3 | open import Level 4 | open import IO 5 | open import Data.Unit 6 | open import Data.Sum 7 | open import Data.String 8 | open import Coinduction 9 | open import Function 10 | 11 | open import agdARGS.System.Console.CLI 12 | open import agdARGS.System.Console.CLI.Parser 13 | open import agdARGS.System.Environment.Arguments 14 | 15 | error : String → IO _ 16 | error = putStrLn ∘ ("*** Error: " ++_) 17 | 18 | withCLI : ∀ {ℓ} (c : CLI ℓ) (k : ParsedCommand (exec c) → IO ⊤) → _ 19 | withCLI c k = run $ 20 | ♯ getArgs >>= λ args → ♯ [ error , k ]′ (parseInterface c args) 21 | -------------------------------------------------------------------------------- /agdARGS/Data/Integer/Read.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Integer.Read where 2 | 3 | open import Data.Char 4 | open import Data.String as String 5 | open import Data.Sum as Sum 6 | open import Data.List 7 | open import Function 8 | 9 | open import Data.Nat 10 | open import Data.Integer 11 | open import agdARGS.Data.Nat.Read 12 | 13 | parseℤ : String → String ⊎ ℤ 14 | parseℤ z = [ const failure , inj₂ ]′ $ go $ toList z where 15 | 16 | failure : String ⊎ ℤ 17 | failure = inj₁ $ "Invalid Integer: " String.++ z 18 | 19 | go : List Char → String ⊎ ℤ 20 | go ('-' ∷ n) = Sum.map id (0 ⊖_) $ parseℕ $ fromList n 21 | go n = Sum.map id (+_) $ parseℕ z 22 | 23 | -------------------------------------------------------------------------------- /agdARGS/Algebra/Monoid.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Algebra.Monoid where 2 | 3 | open import Level 4 | open import Data.Maybe 5 | open import agdARGS.Algebra.Magma 6 | 7 | record RawMonoid (ℓ : Level) : Set (suc ℓ) where 8 | field 9 | Carrier : Set ℓ 10 | ε : Carrier 11 | _∙_ : Carrier → Carrier → Carrier 12 | 13 | fromMagma : ∀ {ℓ} → RawMagma ℓ → RawMonoid ℓ 14 | fromMagma mg = record { Carrier = Maybe (RawMagma.Carrier mg) ; ε = nothing ; _∙_ = product } 15 | module FromMagma where 16 | product : Maybe _ → Maybe _ → Maybe _ 17 | product x nothing = x 18 | product nothing y = y 19 | product (just x) (just y) = just (RawMagma._∙_ mg x y) 20 | -------------------------------------------------------------------------------- /agdARGS/Data/List.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.List where 2 | 3 | open import Level using (Level) 4 | open import Data.Bool 5 | open import Data.Product 6 | open import Data.List 7 | open import Function 8 | 9 | init : {ℓ : Level} {A : Set ℓ} (xs : List A) → List A 10 | init [] = [] 11 | init (x ∷ []) = [] 12 | init (x ∷ xs) = x ∷ init xs 13 | 14 | breakOn : {ℓ : Level} {A : Set ℓ} (P? : A → Bool) (xs : List A) → List (List A) 15 | breakOn {A = A} P? xs = 16 | let (hd , tl) = foldr step ([] , []) xs 17 | in (if null hd then id else _∷_ hd) tl 18 | where 19 | 20 | step : A → (List A × List (List A)) → (List A × List (List A)) 21 | step a (xs , xss) = if (P? a) then [] , xs ∷ xss else a ∷ xs , xss 22 | -------------------------------------------------------------------------------- /agdARGS/Relation/Nullary.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Relation.Nullary where 2 | 3 | open import Data.Bool 4 | open import Function 5 | open import Relation.Nullary 6 | 7 | dec : ∀ {ℓ ℓ′} {A : Set ℓ} {P : Dec A → Set ℓ′} d → (∀ p → P (yes p)) → (∀ ¬p → P (no ¬p)) → P d 8 | dec (yes p) y n = y p 9 | dec (no ¬p) y n = n ¬p 10 | 11 | dec′ : ∀ {ℓ ℓ′} {A : Set ℓ} {P : Set ℓ′} (d : Dec A) → (∀ p → P) → (∀ ¬p → P) → P 12 | dec′ = dec 13 | 14 | toBool : ∀ {ℓ} {A : Set ℓ} → Dec A → Bool 15 | toBool d = dec′ d (const true) (const false) 16 | 17 | toSet : ∀ {ℓ} {A : Set ℓ} → Dec A → Set 18 | toSet = T ∘ toBool 19 | 20 | fromYes : ∀ {ℓ} {A : Set ℓ} (d : Dec A) {pr : toSet d} → A 21 | fromYes (yes p) = p 22 | fromYes (no ¬p) {} 23 | -------------------------------------------------------------------------------- /agdARGS/Algebra/Magma.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Algebra.Magma where 2 | 3 | open import Level 4 | 5 | record RawMagma (ℓ : Level) : Set (suc ℓ) where 6 | field 7 | Carrier : Set ℓ 8 | _∙_ : Carrier → Carrier → Carrier 9 | 10 | module List where 11 | 12 | open import Data.List 13 | 14 | rawMagma : {ℓ : Level} (A : Set ℓ) → RawMagma ℓ 15 | rawMagma A = record { Carrier = List A ; _∙_ = _++_ } 16 | 17 | module String where 18 | 19 | open import Data.String 20 | 21 | rawMagma : RawMagma zero 22 | rawMagma = record { Carrier = String ; _∙_ = _++_ } 23 | 24 | module Unit where 25 | 26 | open import Data.Unit 27 | open import Function 28 | 29 | rawMagma : RawMagma zero 30 | rawMagma = record { Carrier = ⊤ ; _∙_ = const $ const tt } 31 | -------------------------------------------------------------------------------- /agdARGS/Examples/Echo.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Examples.Echo where 2 | 3 | open import IO 4 | open import Data.Maybe 5 | open import Function 6 | open import agdARGS.System.Console.CLI 7 | open import agdARGS.System.Console.CLI.Usual 8 | open import agdARGS.System.Console.Options.Usual 9 | open import agdARGS.System.Console.Modifiers 10 | 11 | echo : CLI _ 12 | echo = record 13 | { name = "echo" 14 | ; exec = record 15 | { description = "Repeat its argument" 16 | ; subcommands = noSubCommands 17 | ; arguments = string 18 | ; modifiers = noModifiers 19 | } 20 | } 21 | 22 | main = withCLI echo handler where 23 | 24 | handler : ParsedInterface echo → _ 25 | handler (theCommand _ a) = putStrLn (maybe id "" a) 26 | handler (subCommand () _) 27 | -------------------------------------------------------------------------------- /agdARGS/Data/UniqueSortedList/SmartConstructors.agda: -------------------------------------------------------------------------------- 1 | open import Level 2 | open import Relation.Binary 3 | 4 | module agdARGS.Data.UniqueSortedList.SmartConstructors 5 | {ℓᵃ ℓᵉ ℓʳ : Level} 6 | (STO : StrictTotalOrder ℓᵃ ℓᵉ ℓʳ) 7 | where 8 | 9 | open import agdARGS.Data.Maybe 10 | open import agdARGS.Data.Infinities 11 | open import agdARGS.Data.UniqueSortedList STO 12 | 13 | USL : Set (ℓʳ ⊔ ℓᵃ) 14 | USL = UniqueSortedList -∞ +∞ 15 | 16 | `[] : USL 17 | `[] = -∞<+∞ ■ 18 | 19 | module MayFail where 20 | infixr 5 _`∷_ 21 | _`∷_ : ∀ x (xs : USL) {pr : _} → USL 22 | (x `∷ xs) {pr} = fromJust (insert x (-∞<↑ x) ↑ x <+∞ xs) {pr} 23 | 24 | module NeverFail where 25 | infixr 5 _`∷_ 26 | _`∷_ : ∀ x (xs : USL) → USL 27 | x `∷ xs = insert′ x (-∞<↑ x) ↑ x <+∞ xs 28 | 29 | infix 6 `[_] 30 | `[_] : ∀ x → USL 31 | `[ x ] = fromJust (insert x (-∞<↑ x) ↑ x <+∞ `[]) 32 | 33 | -------------------------------------------------------------------------------- /agdARGS/Data/Record/Properties.agda: -------------------------------------------------------------------------------- 1 | open import Level 2 | open import Relation.Binary 3 | 4 | module agdARGS.Data.Record.Properties 5 | {ℓᵃ ℓᵉ ℓʳ : Level} 6 | (STO : StrictTotalOrder ℓᵃ ℓᵉ ℓʳ) 7 | where 8 | 9 | open import Function 10 | open import agdARGS.Data.Record STO 11 | open import agdARGS.Data.UniqueSortedList STO 12 | open import Relation.Binary.PropositionalEquality 13 | 14 | [lookupTabulate] : 15 | {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 16 | (ρ : {arg : _} (pr : arg ∈ args) → Set ℓ) 17 | {arg : _} (pr : arg ∈ args) → [lookup] pr ([tabulate] args ρ) ≡ ρ pr 18 | [lookupTabulate] ρ z = refl 19 | [lookupTabulate] ρ (s pr) = [lookupTabulate] (ρ ∘ s) pr 20 | 21 | lookupTabulate : 22 | {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 23 | (ρ : {arg : _} (pr : arg ∈ args) → Set ℓ) 24 | {arg : _} (pr : arg ∈ args) → lookup pr (tabulate ρ) ≡ ρ pr 25 | lookupTabulate = [lookupTabulate] 26 | -------------------------------------------------------------------------------- /agdARGS/System/Console/Options/Domain.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.Options.Domain where 2 | 3 | open import Level 4 | open import Data.Sum 5 | open import Data.Unit 6 | open import Data.Product 7 | open import Data.Maybe 8 | open import Data.String 9 | open import Function 10 | 11 | open import agdARGS.Algebra.Magma 12 | open import agdARGS.Data.Error 13 | 14 | data Domain (ℓ : Level) : Set (suc ℓ) where 15 | Some : (S : Set ℓ) → Domain ℓ 16 | ALot : (M : RawMagma ℓ) → Domain ℓ 17 | 18 | elimDomain : 19 | {ℓ ℓᵖ : Level} {P : Domain ℓ → Set ℓᵖ} 20 | (dSome : ∀ S → P (Some S)) (dALot : ∀ M → P (ALot M)) → 21 | (d : Domain ℓ) → P d 22 | elimDomain dSome dALot = λ { (Some S) → dSome S 23 | ; (ALot M) → dALot M } 24 | 25 | Carrier : {ℓ : Level} → Domain ℓ → Set ℓ 26 | Carrier = elimDomain id RawMagma.Carrier 27 | 28 | Parser : {ℓ : Level} → Domain ℓ → Set ℓ 29 | Parser d = String → Error $ Carrier d 30 | -------------------------------------------------------------------------------- /agdARGS/Examples/Grep.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Examples.Grep where 2 | 3 | open import Data.Product 4 | open import Data.String 5 | open import agdARGS.System.Console.CLI 6 | open import agdARGS.System.Console.CLI.Usual 7 | open import agdARGS.System.Console.CLI.Usage 8 | open import agdARGS.System.Console.Options.Domain 9 | open import agdARGS.System.Console.Modifiers 10 | open import agdARGS.System.Console.Options.Usual 11 | open import agdARGS.Data.UniqueSortedList.Usual 12 | open import Function 13 | open import IO 14 | 15 | Grep : CLI _ 16 | Grep = record 17 | { name = "grep" 18 | ; exec = record 19 | { description = "Print lines matching a regexp" 20 | ; subcommands = noSubCommands 21 | ; arguments = lotsOf filePath 22 | ; modifiers = 23 | , "-v" ∷= flag "Invert match" 24 | ⟨ "-i" ∷= flag "Ignore case" 25 | ⟨ "-e" ∷= option "Regexp" regexp 26 | ⟨ ⟨⟩ 27 | }} 28 | 29 | main = withCLI Grep $ const $ putStrLn $ usage Grep 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # agdARGS 2 | Dealing with Flags and Options 3 | 4 | I gave a talk about agdARGS in St Andrews on 2015-03-15. The 5 | [slides](https://github.com/gallais/agdARGS/blob/master/doc/2015-03-18-IIM.pdf) 6 | are a good starting point to have an idea of how agdARGS is 7 | implemented. Beware: the terminology varies slightly from the 8 | one now used in the project. 9 | 10 | I have implemented two simple examples showcasing the library (flags, options, 11 | arguments parsing and usage): 12 | 13 | * [WordCount](https://github.com/gallais/agdARGS/blob/master/agdARGS/Examples/WordCount.agda) 14 | is a `wc`-like utility, 15 | 16 | * and [Sum](https://github.com/gallais/agdARGS/blob/master/agdARGS/Examples/Sum.agda) 17 | is a simple example of a hierarchical cli: it has two sub-commands ("nat" and "int" 18 | respectively) which sum the list of numbers (nats and ints respectively) they are 19 | given. 20 | 21 | ## Dependencies 22 | 23 | This work has been tested using: 24 | 25 | * Agda version 2.5.3 26 | * The [standard library](http://github.com/agda/agda-stdlib) version 0.15 27 | -------------------------------------------------------------------------------- /agdARGS/System/Console/Options/Usage.agda: -------------------------------------------------------------------------------- 1 | open import Level using (Level) 2 | 3 | module agdARGS.System.Console.Options.Usage (ℓ : Level) where 4 | 5 | open import agdARGS.System.Console.Options 6 | private module Opts = Options ℓ 7 | open Opts 8 | open Option 9 | 10 | open import Data.Nat 11 | open import Data.Product 12 | open import Data.Char 13 | open import Data.String as String hiding (unlines) 14 | open import agdARGS.Data.String 15 | open import Function 16 | 17 | open import Data.List as List using (List) 18 | import agdARGS.Data.List as List 19 | 20 | usage : Options → String 21 | usage args = let (n , f) = go args in 22 | unlines $ "Flags and Options:" List.∷ f n 23 | where 24 | 25 | go : {lb ub : _} (args : UniqueSortedList lb ub) → ℕ × (ℕ → List String) 26 | go (lt ■) = 0 , const List.[] 27 | go (hd , lt ∷ args) = 28 | let m = length $ flag hd 29 | (n , f) = go args 30 | g n = (" " ++ flag hd ++ replicate (2 + n ∸ m) ' ' ++ name hd ++ ": " ++ description hd) 31 | List.∷ f n 32 | in (m ⊔ n , g) -------------------------------------------------------------------------------- /agdARGS/System/Console/Options/Usual.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.Options.Usual where 2 | 3 | open import Level 4 | open import Data.Nat using (ℕ) 5 | open import agdARGS.Data.Nat.Read 6 | open import Data.Integer using (ℤ) 7 | open import agdARGS.Data.Integer.Read 8 | open import Data.Empty 9 | open import Data.Product 10 | open import Data.String 11 | open import Data.List 12 | open import Function 13 | open import Data.Sum 14 | open import agdARGS.Algebra.Magma 15 | open import agdARGS.Data.Error 16 | open import agdARGS.System.Console.Options.Domain public 17 | 18 | Arguments : (ℓ : Level) → Set (suc ℓ) 19 | Arguments ℓ = Σ[ d ∈ Domain ℓ ] Parser d 20 | 21 | none : ∀ {ℓ} → Arguments ℓ 22 | none = Some (Lift ⊥) , const (throw "Argument provided when none expected") 23 | 24 | lotsOf : ∀ {ℓ} → Arguments ℓ → Arguments ℓ 25 | lotsOf {ℓ} (d , p) = ALot (List.rawMagma (Carrier d)) , ([_] <$>_) ∘ p 26 | 27 | Regex = String 28 | 29 | regex : Arguments zero 30 | regex = Some Regex , inj₂ 31 | 32 | string : Arguments zero 33 | string = Some String , inj₂ 34 | 35 | FilePath = String 36 | filePath : Arguments zero 37 | filePath = Some FilePath , inj₂ 38 | 39 | Regexp = String 40 | regexp : Arguments zero 41 | regexp = Some Regexp , inj₂ 42 | 43 | Url = String 44 | url : Arguments zero 45 | url = Some Url , inj₂ 46 | 47 | Nat : Arguments zero 48 | Nat = Some ℕ , parseℕ 49 | 50 | Int : Arguments zero 51 | Int = Some ℤ , parseℤ 52 | -------------------------------------------------------------------------------- /agdARGS/Data/String.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.String where 2 | 3 | open import Level 4 | open import Data.Nat 5 | open import Data.Bool 6 | open import Data.Sum 7 | open import agdARGS.Data.Sum as Sum 8 | open import Data.Char as Char 9 | open import Data.String hiding (unlines) 10 | open import Data.List as List using (List) 11 | open import Data.Vec as Vec using (Vec) 12 | import agdARGS.Data.List as List 13 | open import agdARGS.Relation.Nullary 14 | open import Category.Monad 15 | open import Function 16 | 17 | fromVec : {n : ℕ} → Vec Char n → String 18 | fromVec = fromList ∘ Vec.toList 19 | 20 | concatList : List String → String 21 | concatList = List.foldr _++_ "" 22 | 23 | concatVec : {n : ℕ} → Vec String n → String 24 | concatVec = Vec.foldr _ _++_ "" 25 | 26 | unlines : List String → String 27 | unlines = concatList ∘ List.intersperse "\n" 28 | 29 | replicate : ℕ → Char → String 30 | replicate n = fromList ∘ List.replicate n 31 | 32 | length : String → ℕ 33 | length = List.length ∘ toList 34 | 35 | lines : String → List String 36 | lines = List.map fromList ∘ List.breakOn isNewLine ∘ toList 37 | where 38 | isNewLine : Char → Bool 39 | isNewLine y = dec (y Char.≟ '\n') (const true) (const false) 40 | 41 | parseAll : {ℓ : Level} {A : Set ℓ} (p : String → String ⊎ A) → 42 | List String → String ⊎ List A 43 | parseAll p = List.foldl (λ res str → p str >>= (λ a → List._∷_ a <$> res)) (inj₂ List.[]) 44 | where open RawMonad (Sum.monad String) 45 | -------------------------------------------------------------------------------- /agdARGS/System/Console/Options/Instances.agda: -------------------------------------------------------------------------------- 1 | open import Level 2 | 3 | module agdARGS.System.Console.Options.Instances (ℓ : Level) where 4 | 5 | open import Data.Unit 6 | open import Data.Bool 7 | open import Data.Sum as Sum 8 | open import Data.List 9 | open import Data.String 10 | open import Function 11 | 12 | open import agdARGS.Algebra.Magma 13 | open import agdARGS.System.Console.Options.Domain 14 | open import agdARGS.System.Console.Options 15 | private module Opts = Options ℓ 16 | open Opts 17 | 18 | flag : Option ℓ 19 | flag = 20 | record { name = "Default name" 21 | ; description = "Default Description" 22 | ; flag = "" 23 | ; optional = true 24 | ; domain = None 25 | ; parser = lift tt 26 | } 27 | 28 | lotsOf : {A : Set ℓ} → (String → String ⊎ A) → Option ℓ 29 | lotsOf {A} p = 30 | record { name = "Default name" 31 | ; description = "Default Description" 32 | ; flag = "" 33 | ; optional = true 34 | ; domain = ALot (List.rawMagma A) 35 | ; parser = Sum.map id [_] ∘ p 36 | } 37 | 38 | option : {A : Set ℓ} → (String → String ⊎ A) → Option ℓ 39 | option {A} p = 40 | record { name = "Default name" 41 | ; description = "Default Description" 42 | ; flag = "" 43 | ; optional = true 44 | ; domain = Some A 45 | ; parser = p 46 | } -------------------------------------------------------------------------------- /agdARGS/System/Console/CLI/Parser.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.CLI.Parser where 2 | 3 | open import Data.List 4 | open import Data.String 5 | open import Data.Sum 6 | open import Data.Product 7 | open import Data.Maybe 8 | open import Function 9 | open import agdARGS.Relation.Nullary 10 | 11 | open import agdARGS.Data.Error 12 | open import agdARGS.Data.UniqueSortedList.Usual 13 | open import agdARGS.Data.Record.Usual 14 | open import agdARGS.System.Console.CLI 15 | 16 | mutual 17 | 18 | parseSubCommand : ∀ {ℓ s} (c : Command ℓ s) {x} → List String → 19 | x ∈ proj₁ (subcommands c) → Error $ ParsedCommand c 20 | parseSubCommand (mkCommand _ (subs , commands cs) _ _) xs pr = 21 | (λ s → subCommand pr s) <$> parseCommand (project′ pr cs) xs 22 | 23 | parseCommand : ∀ {ℓ s} (c : Command ℓ s) → List String → Error $ ParsedCommand c 24 | parseCommand c [] = theCommand dummy 25 | <$> parseArguments (arguments c) [] nothing 26 | parseCommand c ("--" ∷ xs) = theCommand dummy 27 | <$> parseArguments (arguments c) xs nothing 28 | parseCommand c (x ∷ []) = 29 | let dummyPD = inj₂ (theCommand dummy nothing) in 30 | dec (x ∈? proj₁ (subcommands c)) (parseSubCommand c []) $ λ _ → 31 | dec (x ∈? proj₁ (modifiers c)) (parseModifier c dummyPD dummyPD) $ 32 | const $ parseArgument c dummyPD x 33 | parseCommand c (x ∷ y ∷ xs) = 34 | dec (x ∈? proj₁ (subcommands c)) (parseSubCommand c (y ∷ xs)) $ λ _ → 35 | let recyxs = parseCommand c (y ∷ xs) 36 | recxs = parseCommand c xs 37 | in dec (x ∈? proj₁ (modifiers c)) (parseModifier c recyxs recxs) $ 38 | const $ parseArgument c recyxs x 39 | 40 | parseInterface : ∀ {ℓ} (c : CLI ℓ) → List String → Error $ ParsedInterface c 41 | parseInterface c = parseCommand (exec c) 42 | -------------------------------------------------------------------------------- /agdARGS/System/Console/CLI/Examples.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.CLI.Examples where 2 | 3 | open import Level 4 | open import Data.Unit 5 | open import Data.Empty 6 | open import Data.String 7 | open import Data.Product 8 | open import Data.List 9 | open import Data.Sum 10 | 11 | open import agdARGS.Data.Record.Usual 12 | open import agdARGS.Data.UniqueSortedList.Usual 13 | open import agdARGS.System.Console.Options.Domain 14 | open import agdARGS.System.Console.Options.Usual 15 | open import agdARGS.System.Console.Modifiers 16 | open import agdARGS.System.Console.CLI 17 | open import agdARGS.System.Console.CLI.Usual 18 | open import agdARGS.Algebra.Magma 19 | 20 | open import Function 21 | 22 | git-exec : Command zero "git" 23 | git-exec = record 24 | { description = "A distributed revision control system with an emphasis on speed,\ 25 | \ data integrity, and support for distributed, non-linear workflows" 26 | ; subcommands = , < "add" ∷= record (basic $ lotsOf filePath) { description = "Add file contents to the index" } 27 | ⟨ "clone" ∷= record (basic url) { description = "Clone a repository into a new directory" } 28 | ⟨ "push" ∷= git-push 29 | ⟨ ⟨⟩ 30 | ; modifiers = noModifiers 31 | ; arguments = lotsOf filePath } where 32 | 33 | git-push = record 34 | { description = "Update remote refs along with associated objects" 35 | ; subcommands = noSubCommands 36 | ; modifiers = , "--force" ∷= flag $ "Usually, the command refuses to update a remote ref that\ 37 | \ is not an ancestor of the local ref used to overwrite it. This\ 38 | \ flag disables the check. This can cause the remote repository\ 39 | \ to lose commits; use it with care." 40 | ⟨ ⟨⟩ 41 | ; arguments = none 42 | } 43 | 44 | git : CLI zero 45 | git = record { name = "git" ; exec = git-exec } 46 | -------------------------------------------------------------------------------- /agdARGS/Data/Nat/Read.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Nat.Read where 2 | 3 | open import Data.Nat 4 | open import Data.Char 5 | open import Data.String as Str 6 | open import Data.Sum 7 | open import Data.Maybe as Maybe 8 | open import Data.List 9 | open import Category.Monad 10 | open import Function 11 | open import agdARGS.Relation.Nullary 12 | open import Relation.Nullary.Decidable using (True) 13 | 14 | parseBase : 15 | (base : ℕ) {base≥2 : True (2 ≤? base)} {base≤16 : True (base ≤? 16)} → 16 | Char → Maybe ℕ 17 | parseBase base c = 18 | parseDigit c >>= λ d → dec (suc d ≤? base) (const $ just d) (const nothing) 19 | where 20 | open RawMonad Maybe.monad 21 | 22 | parseDigit : Char → Maybe ℕ 23 | parseDigit '0' = just 0 24 | parseDigit '1' = just 1 25 | parseDigit '2' = just 2 26 | parseDigit '3' = just 3 27 | parseDigit '4' = just 4 28 | parseDigit '5' = just 5 29 | parseDigit '6' = just 6 30 | parseDigit '7' = just 7 31 | parseDigit '8' = just 8 32 | parseDigit '9' = just 9 33 | parseDigit 'A' = just 10 34 | parseDigit 'B' = just 11 35 | parseDigit 'C' = just 12 36 | parseDigit 'D' = just 13 37 | parseDigit 'E' = just 14 38 | parseDigit 'F' = just 15 39 | parseDigit _ = nothing 40 | 41 | parseℕ : String → String ⊎ ℕ 42 | parseℕ str = maybe′ inj₂ failure $ goBase $ toList str 43 | 44 | where 45 | failure = inj₁ $ "Invalid Natural Number: " Str.++ str 46 | 47 | open RawMonad Maybe.monad 48 | 49 | go : (base : ℕ) {base≥2 : True (2 ≤? base)} {base≤16 : True (base ≤? 16)} → 50 | List Char → Maybe ℕ 51 | go base {b2} {b16} = foldl step $ just 0 52 | where 53 | step : Maybe ℕ → Char → Maybe ℕ 54 | step acc c = acc >>= λ ds → 55 | parseBase base {b2} {b16} c >>= λ d → 56 | return $ ds * base + d 57 | 58 | goBase : List Char → Maybe ℕ 59 | goBase ('0' ∷ 'x' ∷ xs) = go 16 xs 60 | goBase ('0' ∷ 'b' ∷ xs) = go 2 xs 61 | goBase xs = go 10 xs 62 | 63 | 64 | private 65 | 66 | test : _ 67 | test = parseℕ "0bFF1" 68 | 69 | -------------------------------------------------------------------------------- /agdARGS/System/Console/CLI/Usage.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.CLI.Usage where 2 | 3 | open import Level 4 | open import Data.Nat as Nat 5 | open import Data.Product 6 | open import Data.List as List hiding (replicate) 7 | open import Data.String as String hiding (unlines) 8 | open import agdARGS.Data.String as aString 9 | open import Function 10 | 11 | open import agdARGS.Data.UniqueSortedList.Usual as UU 12 | open import agdARGS.Data.Record.Usual as RU 13 | open import agdARGS.System.Console.CLI 14 | 15 | Printer : Set 16 | Printer = ℕ → List String -- indentation level 17 | 18 | indent : ℕ → String → String 19 | indent i str = replicate i ' ' String.++ str 20 | 21 | open import agdARGS.System.Console.Modifiers 22 | 23 | namedString : String → String → ℕ → String 24 | namedString name str width = name String.++ indent pad str 25 | where pad = 1 + width ∸ aString.length name 26 | 27 | usageModifier : {ℓ : Level} (name : String) (cs : Modifier ℓ name) → ℕ → Printer 28 | usageModifier name mod i width = (indent i $ namedString name (display mod) width) ∷ [] where 29 | 30 | display : Modifier _ _ → String 31 | display (mkFlag f) = lower $ `project "description" f 32 | display (mkOption o) = lower $ `project "description" o 33 | 34 | usageModifiers : ∀ {ℓ} {names : USL} → Record names (toFields ℓ) → Printer 35 | usageModifiers r = 36 | let width = RU.foldr (λ {n} _ _ → aString.length n Nat.⊔_) 0 r in 37 | RU.foldr (λ _ mod p i → usageModifier _ mod i width List.++ p i) (const []) r 38 | 39 | mutual 40 | 41 | usageCommand : ∀ {ℓ i} (name : String) (r : Command ℓ name {i}) → Printer 42 | usageCommand name r i = 43 | indent i (namedString name (description r) (aString.length name)) 44 | List.∷ usageCommands (proj₂ $ subcommands r) (2 + i) 45 | List.++ usageModifiers (proj₂ $ modifiers r) (2 + i) 46 | 47 | 48 | usageCommands : ∀ {ℓ i} {names : USL} (cs : Commands ℓ names {i}) → Printer 49 | usageCommands (commands (mkRecord cs)) = 50 | RU.[foldr] (λ _ c p i → usageCommand _ c i List.++ p i) (const []) cs 51 | 52 | usage : {ℓ : Level} (cli : CLI ℓ) → String 53 | usage cli = unlines ∘ (_$ 0) ∘ usageCommand (name cli) $ exec cli 54 | -------------------------------------------------------------------------------- /agdARGS/Examples/Repl.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Examples.Repl where 2 | 3 | open import Data.Nat as Nat 4 | open import Data.Integer as Int 5 | 6 | open import Level as Level 7 | open import Data.Empty 8 | open import Data.Product 9 | open import Data.Bool 10 | open import Data.Maybe 11 | open import Data.Sum as Sum 12 | open import Data.String as String 13 | open import agdARGS.Data.String as Str 14 | open import Data.List as List hiding ([_]) 15 | import agdARGS.Data.List as List 16 | open import Function 17 | open import agdARGS.Relation.Nullary 18 | 19 | 20 | open import agdARGS.System.Console.CLI 21 | open import agdARGS.System.Console.CLI.Usual 22 | open import agdARGS.System.Console.CLI.Usage 23 | 24 | open import agdARGS.Data.Error 25 | open import agdARGS.Algebra.Magma 26 | open import agdARGS.Data.Nat.Read 27 | open import agdARGS.Data.Integer.Read 28 | open import agdARGS.Data.UniqueSortedList.Usual 29 | open import agdARGS.Data.Record.Usual 30 | 31 | open import agdARGS.System.Console.Options.Domain 32 | open import agdARGS.System.Console.Modifiers 33 | open import agdARGS.System.Console.Options.Usual 34 | 35 | cli : CLI _ 36 | cli = record 37 | { name = "agda-scheme" 38 | ; exec = record 39 | { description = "Scheme, in Agda!" 40 | ; subcommands = 41 | , < "eval" ∷= record (basic string) { description = "Evaluate a line" } 42 | ⟨ "repl" ∷= record (basic none) { description = "Read-eval-print loop" } 43 | ⟨ ⟨⟩ 44 | ; modifiers = 45 | , "-h" ∷= flag "Display this help" 46 | ⟨ "--help" ∷= flag "Display this help" 47 | ⟨ "--parse-only" ∷= flag "Parse but don't execute" 48 | ⟨ "--version" ∷= flag "Output version information and exit" 49 | ⟨ ⟨⟩ 50 | ; arguments = none 51 | } 52 | } 53 | 54 | open import IO 55 | open import Coinduction 56 | import Data.Nat.Show as NatShow 57 | open import agdARGS.System.Environment.Arguments 58 | 59 | main : _ 60 | main = withCLI cli $ putStrLn ∘ success where 61 | 62 | success : ParsedInterface cli → String 63 | success (theCommand mods args) = 64 | if lower (mods ‼ "--help") ∨ lower (mods ‼ "-h") 65 | then usage cli 66 | else "Hello Here" 67 | success (subCommand name subc) = "Hello There" 68 | -------------------------------------------------------------------------------- /agdARGS/Data/Table.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Table where 2 | 3 | open import Level using (Level) 4 | open import Data.Nat 5 | open import Data.Product hiding (map) 6 | open import Data.List as List using (List ; _∷_ ; []) 7 | open import Data.Vec as Vec hiding (zipWith ; _⊛_) 8 | import Data.Vec.Categorical as Vec 9 | open import Data.String as Str hiding (show) 10 | open import agdARGS.Data.String as String 11 | open import Function 12 | open import Category.Functor 13 | open import Category.Applicative 14 | 15 | Table : (m n : ℕ) {ℓ : Level} (A : Set ℓ) → Set ℓ 16 | Table m n A = Vec (Vec A n) m 17 | 18 | infixr 3 _∥_ 19 | _∥_ : {m n p : ℕ} {ℓ : Level} {A : Set ℓ} → Table m n A → Table m p A → Table m (n + p) A 20 | xs ∥ ys = Vec.zipWith Vec._++_ xs ys 21 | 22 | functor : {m n : ℕ} {ℓ : Level} → RawFunctor (Table m n {ℓ}) 23 | functor = record { _<$>_ = map ∘ map } 24 | 25 | infixl 3 _⊛_ 26 | _⊛_ : {ℓᵃ ℓᵇ : Level} {A : Set ℓᵃ} {B : Set ℓᵇ} 27 | {m n : ℕ} (fs : Table m n (A → B)) (as : Table m n A) → Table m n B 28 | fs ⊛ as = map Vec._⊛_ fs Vec.⊛ as 29 | 30 | applicative : {m n : ℕ} {ℓ : Level} → RawApplicative (Table m n {ℓ}) 31 | applicative {m} {n} {ℓ}= 32 | record { pure = VecM.pure ∘ VecN.pure 33 | ; _⊛_ = _⊛_ } 34 | where 35 | module VecM = RawApplicative (Vec.applicative {ℓ} {m}) 36 | module VecN = RawApplicative (Vec.applicative {ℓ} {n}) 37 | 38 | zipWith : {ℓᵃ ℓᵇ ℓᶜ : Level} {A : Set ℓᵃ} {B : Set ℓᵇ} {C : Set ℓᶜ} 39 | {m n : ℕ} (f : A → B → C) → Table m n A → Table m n B → Table m n C 40 | zipWith f ta tb = RawApplicative.pure applicative f ⊛ ta ⊛ tb 41 | 42 | show : {m n : ℕ} → Table m n String → String 43 | show {n = n} tb = String.unlines $ uncurry (flip _$_) res 44 | where 45 | P : Set 46 | P = Vec ℕ n × (Vec ℕ n → List String) 47 | 48 | showCell : String → ℕ → String 49 | showCell str n = str Str.++ (fromVec $ Vec.replicate {n = (2 + n) ∸ length str} ' ') 50 | 51 | cons : {m : ℕ} → Vec String n → P → P 52 | cons row (ms , str) = 53 | let strs-lengths = Vec.map String.length row 54 | ns = Vec.zipWith _⊔_ ms strs-lengths 55 | in ns , λ ls → (concatVec $ Vec.zipWith showCell row ls) ∷ str ls 56 | 57 | res : P 58 | res = foldr (const P) (λ {m} → cons {m}) (Vec.replicate 0 , const []) tb 59 | 60 | -------------------------------------------------------------------------------- /agdARGS/Examples/Sum.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Examples.Sum where 2 | 3 | open import Data.Nat as Nat 4 | open import Data.Integer as Int 5 | 6 | open import Level as Level 7 | open import Data.Empty 8 | open import Data.Product 9 | open import Data.Bool 10 | open import Data.Maybe 11 | open import Data.Sum as Sum 12 | open import Data.String as String 13 | open import agdARGS.Data.String as Str 14 | open import Data.List as List 15 | import agdARGS.Data.List as List 16 | open import Function 17 | open import agdARGS.Relation.Nullary 18 | 19 | 20 | open import agdARGS.System.Console.CLI 21 | open import agdARGS.System.Console.CLI.Usage 22 | 23 | open import agdARGS.Data.Error 24 | open import agdARGS.Algebra.Magma 25 | open import agdARGS.Data.Nat.Read 26 | open import agdARGS.Data.Integer.Read 27 | open import agdARGS.Data.UniqueSortedList.Usual 28 | open import agdARGS.Data.Record.Usual 29 | 30 | open import agdARGS.System.Console.Options.Domain 31 | open import agdARGS.System.Console.Modifiers 32 | open import agdARGS.System.Console.Options.Usual 33 | 34 | sum-cli : CLI Level.zero 35 | sum-cli = record { name = "sum" ; exec = record 36 | { description = "Takes a list of number as an input and sums it" 37 | ; subcommands = , < "nat" ∷= record (basic $ lotsOf Nat) { description = "The inputs will be nats" } 38 | ⟨ "int" ∷= record (basic $ lotsOf Int) { description = "The inputs will be ints" } 39 | ⟨ ⟨⟩ 40 | ; modifiers = , "--version" ∷= flag "Output version information and exit" 41 | ⟨ "-h" ∷= flag "Display this help" 42 | ⟨ ⟨⟩ 43 | ; arguments = none 44 | } } 45 | 46 | open import IO 47 | open import Coinduction 48 | import Data.Nat.Show as NatShow 49 | open import agdARGS.System.Console.CLI.Usual 50 | open import agdARGS.System.Environment.Arguments 51 | 52 | main : _ 53 | main = withCLI sum-cli $ putStrLn ∘ success where 54 | 55 | sumNat : Maybe (List ℕ) → ℕ 56 | sumNat = maybe (List.foldr Nat._+_ 0) 0 57 | 58 | sumInt : Maybe (List ℤ) → ℤ 59 | sumInt = maybe (List.foldr Int._+_ (+ 0)) (+ 0) 60 | 61 | success : ParsedInterface sum-cli → String 62 | success ([ ._ ∷= m & _ ]) = 63 | if lower (m ‼ "--version") then "Sum version: 0.1" 64 | else if lower (m ‼ "-h") then usage sum-cli 65 | else "" 66 | success ([ ."int" [ z ]∙ ._ ∷= _ & vs ]) = Int.show $ sumInt vs 67 | success ([ ."nat" [ s z ]∙ ._ ∷= _ & vs ]) = NatShow.show $ sumNat vs 68 | 69 | -- empty cases 70 | success ([ ."int" [ z ]∙ _ [ () ]∙ _) 71 | success ([ ."nat" [ s z ]∙ _ [ () ]∙ _) 72 | success ([ _ [ s (s ()) ]∙ _) 73 | -------------------------------------------------------------------------------- /agdARGS/Data/Record/Examples.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Record.Examples where 2 | 3 | open import Level as Level 4 | open import Data.Unit 5 | open import Data.Bool 6 | open import Data.Nat as Nat 7 | open import Data.String 8 | open import Data.Product 9 | open import Data.Maybe 10 | open import Category.Monad 11 | open import agdARGS.Relation.Nullary 12 | 13 | open import agdARGS.Data.UniqueSortedList.Examples 14 | open import agdARGS.Data.Record.Usual 15 | 16 | open import Function 17 | 18 | -- We can apply this new method to Characteristics for instance 19 | 20 | Attributes : Fields Level.zero Characteristics 21 | Attributes = Type $ "age" ∷= ℕ 22 | ⟨ "name" ∷= String 23 | ⟨ "idcard" ∷= Bool 24 | ⟨ ⟨⟩ 25 | 26 | -- A Person is then modelled as a record of attributes for each one 27 | -- her characterics 28 | 29 | Person : Set 30 | Person = Record Characteristics Attributes 31 | 32 | -- We may either build the nested tuple directly but that 33 | -- requires understanding the internal representation: 34 | --|| "age" :: "name" :: "idcard" :: [] 35 | -- has been sorted to 36 | --|| "age" :: "idcard" :: "name" :: [] 37 | 38 | john : Person 39 | john = mkRecord $ 17 , true , "john" , lift tt 40 | 41 | -- Or, given that equality on Strings is decidable, we may 42 | -- rely on a decision procedure to generate this information 43 | -- and write the simpler (note that the order in which we set 44 | -- the fields does not matter): 45 | 46 | june : Person 47 | june = "age" ∷= 20 48 | ⟨ "name" ∷= "june" 49 | ⟨ "idcard" ∷= true 50 | ⟨ ⟨⟩ 51 | 52 | julie : Person 53 | julie = "idcard" ∷= false 54 | ⟨ "name" ∷= "julie" 55 | ⟨ "age" ∷= 22 56 | ⟨ ⟨⟩ 57 | 58 | -- Once we have our Persons, we can write an (applicative) validator 59 | -- by specifying validators for each one of the fields. Here we 60 | -- assume they want to get in a pub. To do that, they need to: 61 | -- - be over 18 62 | -- - be carrying an id 63 | 64 | getsInThePub : Record Characteristics (Attributes ⟶ Maybe [ Attributes ]) 65 | getsInThePub = "age" ∷= checkAge 66 | ⟨ "name" ∷= AM.pure 67 | ⟨ "idcard" ∷= checkId 68 | ⟨ ⟨⟩ 69 | where 70 | module AM = RawMonad monad 71 | 72 | checkAge : ℕ → Maybe ℕ 73 | checkAge age = dec (18 Nat.≤? age) (const $ AM.pure age) (const $ nothing) 74 | 75 | checkId : Bool → Maybe Bool 76 | checkId b = if b then just b else nothing 77 | 78 | -- the validator then runs the various tests 79 | 80 | pubValidator : Person → Maybe Person 81 | pubValidator = seqA AM.rawIApplicative ∘ app getsInThePub 82 | where module AM = RawMonad monad 83 | 84 | -- We can now check for each one of them whether they will be 85 | -- able to get in the pub. Looks like june is going to have to 86 | -- drink alone... 87 | 88 | johnInThePub : Maybe Person 89 | johnInThePub = pubValidator john 90 | 91 | juneInThePub : Maybe Person 92 | juneInThePub = pubValidator june 93 | 94 | julieInThePub : Maybe Person 95 | julieInThePub = pubValidator julie 96 | -------------------------------------------------------------------------------- /agdARGS/System/Console/Modifiers.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.Modifiers where 2 | 3 | open import Level 4 | open import Data.Unit 5 | open import Data.Bool 6 | open import Data.String 7 | open import Data.Product 8 | open import Data.Maybe 9 | open import Data.List 10 | open import Data.String 11 | open import Function 12 | open import agdARGS.Algebra.Monoid 13 | open import agdARGS.Data.String 14 | open import agdARGS.Data.Error as Error hiding (return) 15 | open import agdARGS.Data.Record.Usual as RU public 16 | open import agdARGS.System.Console.Options.Domain 17 | 18 | Flag : (ℓ : Level) → Fields (suc ℓ) _ 19 | Flag ℓ = Type $ "description" ∷= Lift String 20 | ⟨ ⟨⟩ 21 | 22 | Option : (ℓ : Level) → Fields (suc ℓ) _ 23 | Option ℓ = Type $ "description" ∷= Lift String 24 | ⟨ "arguments" ∷= Σ[ d ∈ Domain ℓ ] Parser d 25 | ⟨ ⟨⟩ 26 | 27 | data Modifier (ℓ : Level) (name : String) : Set (suc ℓ) where 28 | mkFlag : Record _ (Flag ℓ) → Modifier ℓ name 29 | mkOption : Record _ (Option ℓ) → Modifier ℓ name 30 | 31 | flag : ∀ {ℓ name} → String → Modifier ℓ name 32 | flag str = mkFlag $ "description" ∷= lift str ⟨ ⟨⟩ 33 | 34 | option : ∀ {ℓ name} → String → Σ[ d ∈ Domain ℓ ] Parser d → Modifier ℓ name 35 | option n p = mkOption $ "description" ∷= lift n 36 | ⟨ "arguments" ∷= p 37 | ⟨ ⟨⟩ 38 | 39 | toFields : ∀ ℓ {lb ub} {names : UniqueSortedList lb ub} → Fields (suc ℓ) names 40 | toFields ℓ = RU.tabulate $ λ {s} → const (Modifier ℓ s) 41 | 42 | Modifiers : ∀ ℓ → Set (suc ℓ) 43 | Modifiers ℓ = Σ[ names ∈ USL ] Record names (toFields ℓ) 44 | 45 | noModifiers : ∀ {ℓ} → Modifiers ℓ 46 | noModifiers = , ⟨⟩ 47 | 48 | ParsedModifier : {ℓ : Level} {name : String} → Modifier ℓ name → Set ℓ 49 | ParsedModifier (mkFlag f) = Lift Bool 50 | ParsedModifier (mkOption o) = Maybe (Carrier $ proj₁ $ `project "arguments" o) 51 | 52 | ParsedModifiers : ∀ {ℓ} {names : USL} (mods : Record names (toFields ℓ)) → Set ℓ 53 | ParsedModifiers {names = names} mods = 54 | Record names (Type $ RU.map (const ParsedModifier) mods) 55 | 56 | updateModifier : 57 | {ℓ : Level} {names : USL} {mods : Record names (toFields ℓ)} (ps : ParsedModifiers mods) → 58 | {name : String} (pr : name ∈ names) (p : ParsedModifier (project′ pr mods)) → 59 | Error (ParsedModifiers mods) 60 | updateModifier {ℓ} ps pr p = mkRecord <$> go (content ps) pr p 61 | 62 | where 63 | 64 | go : {lb ub : _} {names : UniqueSortedList lb ub} {mods : Record names (toFields ℓ)} → 65 | let fs = fields $ (Type $ RU.map (const ParsedModifier) mods) in 66 | (ps : [Record] names fs) {name : String} (pr : name ∈ names) (p : ParsedModifier (project′ pr mods)) → 67 | Error $ [Record] names fs 68 | go (q , ps) (s pr) p = (λ ps → q , ps) <$> go ps pr p 69 | go {mods = mkRecord (mkFlag _ , _)} (q , ps) z p = Error.return (p , ps) 70 | go {mods = mkRecord (mkOption _ , _)} (nothing , ps) z p = Error.return (p , ps) 71 | go {mods = mkRecord (mkOption o , _)} (just q , ps) {name} z p = (_, ps) <$> 72 | let dom = proj₁ $ `project "arguments" o 73 | in (case dom return (λ d → Maybe (Carrier d) → Carrier d → Error (Maybe (Carrier d))) of λ 74 | { (Some _) → λ _ _ → throw $ concatList $ "MkOption " ∷ name ∷ " set twice" ∷ [] 75 | ; (ALot m) → λ p q → Error.return $ let open RawMonoid (fromMagma m) in p ∙ just q 76 | }) p q 77 | -------------------------------------------------------------------------------- /agdARGS/Data/UniqueSortedList.agda: -------------------------------------------------------------------------------- 1 | open import Level 2 | open import Relation.Binary 3 | 4 | module agdARGS.Data.UniqueSortedList 5 | {ℓᵃ ℓᵉ ℓʳ : Level} 6 | (STO : StrictTotalOrder ℓᵃ ℓᵉ ℓʳ) 7 | where 8 | 9 | open import Function 10 | open import Data.Empty 11 | open import Data.Sum 12 | open import Data.Product 13 | open import Data.Maybe as Maybe 14 | open import agdARGS.Relation.Nullary 15 | open import Relation.Nullary 16 | open import Category.Monad 17 | open import agdARGS.Data.Infinities 18 | 19 | module ISTO = StrictTotalOrder (StrictTotalOrderT STO) 20 | open ISTO 21 | open ISTO using (_<_ ; compare) public 22 | 23 | infix 7 _■ 24 | infixr 6 _,_∷_ 25 | data UniqueSortedList (lb ub : Carrier) : Set (ℓᵃ ⊔ ℓʳ) where 26 | _■ : .(lt : lb < ub) → UniqueSortedList lb ub 27 | _,_∷_ : ∀ hd .(lt : lb < ↑ hd) (tl : UniqueSortedList (↑ hd) ub) → UniqueSortedList lb ub 28 | 29 | weaken : ∀ {a b c} .(pr : a < b) → UniqueSortedList b c → UniqueSortedList a c 30 | weaken le₁ (le₂ ■) = trans le₁ le₂ ■ 31 | weaken le₁ (hd , le₂ ∷ xs) = hd , trans le₁ le₂ ∷ xs 32 | 33 | insert : ∀ a {lb ub} .(lt₁ : lb < ↑ a) .(lt₂ : ↑ a < ub) → 34 | UniqueSortedList lb ub → Maybe $ UniqueSortedList lb ub 35 | insert a lt₁ lt₂ (_ ■) = just (a , lt₁ ∷ lt₂ ■) 36 | insert a lt₁ lt₂ (hd , lt′ ∷ xs) with compare (↑ a) (↑ hd) 37 | ... | tri< lt ¬eq ¬gt = just (a , lt₁ ∷ hd , lt ∷ xs) 38 | ... | tri≈ ¬lt eq ¬gt = nothing 39 | ... | tri> ¬lt ¬eq gt = Maybe.map (_,_∷_ hd lt′) (insert a gt lt₂ xs) 40 | 41 | insert′ : ∀ a {lb ub} .(lt₁ : lb < ↑ a) .(lt₂ : ↑ a < ub) → 42 | UniqueSortedList lb ub → UniqueSortedList lb ub 43 | insert′ a lt₁ lt₂ (_ ■) = a , lt₁ ∷ lt₂ ■ 44 | insert′ a lt₁ lt₂ (hd , lt′ ∷ xs) with compare (↑ a) (↑ hd) 45 | ... | tri< lt ¬eq ¬gt = a , lt₁ ∷ hd , lt ∷ xs 46 | ... | tri≈ ¬lt eq ¬gt = hd , lt′ ∷ xs 47 | ... | tri> ¬lt ¬eq gt = hd , lt′ ∷ insert′ a gt lt₂ xs 48 | 49 | import Data.List as List 50 | open List using (List) 51 | 52 | fromList : List (StrictTotalOrder.Carrier STO) → Maybe $ UniqueSortedList -∞ +∞ 53 | fromList = List.foldr (λ el xs → xs >>= insert el (-∞<↑ el) ↑ el <+∞) $ just (-∞<+∞ ■) 54 | where open RawMonad Maybe.monad 55 | 56 | infix 5 _∈_ 57 | data _∈_ (a : _) {lb ub : Carrier} : UniqueSortedList lb ub → Set (ℓᵉ ⊔ ℓʳ) where 58 | z : ∀ {xs} .{lt} → a ∈ a , lt ∷ xs 59 | s : ∀ {b xs} .{lt} → a ∈ xs → a ∈ b , lt ∷ xs 60 | 61 | open import Relation.Binary.PropositionalEquality 62 | 63 | ∈∷-inj : ∀ {a lb hd} .{le : lb < ↑ hd} {ub} {xs : UniqueSortedList (↑ hd) ub} → 64 | a ∈ hd , le ∷ xs → a ≡ hd ⊎ a ∈ xs 65 | ∈∷-inj z = inj₁ refl 66 | ∈∷-inj (s pr) = inj₂ pr 67 | 68 | 69 | search : {ℓ₁ ℓ₂ : Level} {A : Set ℓ₁} {R : Rel A ℓ₂} (d : Decidable R) (f : _ → A) 70 | (a : A) {lb ub : _} (xs : UniqueSortedList lb ub) → Dec (Σ[ el ∈ _ ] (el ∈ xs × R (f el) a)) 71 | search d f a (le ■) = no $ λ { (_ , () , _) } 72 | search {R = R} d f a (hd , lt ∷ xs) with d (f hd) a | search d f a xs 73 | ... | yes p | _ = let open IsEquivalence (StrictTotalOrder.isEquivalence STO) 74 | in yes (hd , z , p) 75 | ... | _ | yes (el , p , r) = yes (el , s p , r) 76 | ... | no ¬p | no ¬q = no (λ { (el , p⊎q , r) → [ (λ p → ¬p (subst (λ x → R (f x) a) p r)) 77 | , (λ q → ¬q (el , q , r)) ]′ (∈∷-inj p⊎q) }) 78 | 79 | module withEqDec 80 | (eqDec : Decidable ((StrictTotalOrder.Carrier STO → _ → Set ℓᵃ) ∋ _≡_)) 81 | where 82 | 83 | _∈?_ : (a : _) {lb ub : Carrier} (as : UniqueSortedList lb ub) → Dec (a ∈ as) 84 | a ∈? as with search eqDec id a as 85 | ... | yes (.a , pr , refl) = yes pr 86 | ... | no ¬pr = no $ λ pr → ¬pr $ _ , pr , refl 87 | -------------------------------------------------------------------------------- /agdARGS/Examples/WordCount.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Examples.WordCount where 2 | 3 | open import Level 4 | open import Coinduction 5 | open import IO 6 | open import Data.Bool 7 | open import Data.Nat as Nat 8 | open import Data.Nat.Show as NatShow 9 | open import Data.Product 10 | open import Data.Sum 11 | open import Data.Maybe 12 | open import Data.String as String 13 | open import Data.Vec as Vec hiding (_>>=_) 14 | open import Data.List as List 15 | open import Data.Char 16 | open import Function 17 | import agdARGS.Data.String as Str 18 | open import agdARGS.Data.Error using (Error) 19 | open import agdARGS.Data.Table as Table 20 | open import agdARGS.System.Environment.Arguments 21 | open import agdARGS.System.Console.CLI 22 | open import agdARGS.System.Console.CLI.Usual 23 | open import agdARGS.System.Console.CLI.Usage 24 | 25 | open import agdARGS.System.Console.Modifiers 26 | open import agdARGS.System.Console.Options.Usual 27 | 28 | open import agdARGS.Data.Record.Usual as RU hiding (_∷=_⟨_) 29 | 30 | WordCount : Command _ "WordCount" 31 | WordCount = record 32 | { description = "Print newline, and word counts for each file" 33 | ; subcommands = noSubCommands 34 | ; modifiers = , "-l" ∷= flag "Print the newline count" 35 | ⟨ "-w" ∷= flag "Print the word count" 36 | ⟨ "--help" ∷= flag "Display this help" 37 | ⟨ "--version" ∷= flag "Output version information and exit" 38 | ⟨ ⟨⟩ 39 | ; arguments = lotsOf filePath } 40 | 41 | cli : CLI Level.zero 42 | cli = record 43 | { name = "WordCount" 44 | ; exec = WordCount } 45 | 46 | record count : Set where 47 | field 48 | nb-words : ℕ 49 | nb-lines : ℕ 50 | open count 51 | 52 | count0 : count 53 | nb-words count0 = 0 54 | nb-lines count0 = 0 55 | 56 | _∙_ : count → count → count 57 | nb-words (c ∙ d) = (_+_ on nb-words) c d 58 | nb-lines (c ∙ d) = (_+_ on nb-lines) c d 59 | 60 | showCounts : ParsedModifiers (proj₂ (modifiers WordCount)) → 61 | List (FilePath × count) → String 62 | showCounts mods xs = 63 | -- Lines (resp. Words) are counted if the -l (resp. -w) flag is set 64 | -- or none at all are set. 65 | let keepLines = lower (mods ‼ "-l") ∨ not (lower (mods ‼ "-w")) 66 | keepWords = lower (mods ‼ "-w") ∨ not (lower (mods ‼ "-l")) 67 | total = List.foldr (_∙_ ∘ proj₂) count0 xs 68 | xs = xs List.∷ʳ ("Total" , total) 69 | in Table.show $ showCol true "FilePath" proj₁ xs 70 | ∥ showCol keepLines "Lines" (NatShow.show ∘ nb-lines ∘ proj₂) xs 71 | ∥ showCol keepWords "Words" (NatShow.show ∘ nb-words ∘ proj₂) xs 72 | where 73 | showCol : (b : Bool) (str : String) (f : (FilePath × count) → String) → 74 | (xs : List (FilePath × count)) → 75 | Table (Nat.suc $ List.length xs) (if b then 1 else 0) String 76 | showCol true str f xs = (str ∷ []) ∷ Vec.map (Vec.[_] ∘ f) (Vec.fromList xs) 77 | showCol false str f xs = [] ∷ Vec.map (const []) (Vec.fromList xs) 78 | 79 | wc : List Char → count 80 | wc = proj₁ ∘ List.foldl (uncurry cons) nil 81 | where 82 | cons : (C : count) (f : Bool) (c : Char) → Σ count (λ _ → Bool) 83 | cons C f ' ' = C , false 84 | cons C f '\t' = C , false 85 | cons C f '\n' = record C { nb-lines = 1 + nb-lines C } , false 86 | cons C f c = (if f then C else record C { nb-words = 1 + nb-words C }) , true 87 | nil : count × Bool 88 | nil = count0 , false 89 | 90 | infix 5 _onFiniteFiles_ 91 | _onFiniteFiles_ : {A : Set} (f : String → A) → List FilePath → IO (List (FilePath × A)) 92 | f onFiniteFiles [] = return [] 93 | f onFiniteFiles (fp ∷ fps) = 94 | ♯ readFiniteFile fp >>= λ content → 95 | ♯ (♯ (f onFiniteFiles fps) >>= λ rest → 96 | ♯ return ((fp , f content) ∷ rest)) 97 | 98 | main : _ 99 | main = withCLI cli success where 100 | 101 | treatFiles : ParsedModifiers (proj₂ (modifiers WordCount)) → List FilePath → IO _ 102 | treatFiles opts fps = 103 | ♯ (wc ∘ String.toList onFiniteFiles fps) >>= λ counts → 104 | ♯ (putStrLn $ showCounts opts counts) 105 | 106 | success : ParsedInterface cli → IO _ 107 | success (theCommand mods args) = 108 | if lower (mods ‼ "--version") then putStrLn "WordCount: version 0.1" 109 | else if lower (mods ‼ "--help") then putStrLn (usage cli) 110 | else maybe (treatFiles mods) (error "No file provided") args 111 | success (subCommand () _) 112 | -------------------------------------------------------------------------------- /agdARGS/System/Console/CLI.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.CLI where 2 | 3 | open import Level 4 | open import Size 5 | open import Data.Unit 6 | open import Data.Bool 7 | open import Data.Empty 8 | open import Data.Product 9 | open import Data.String 10 | open import agdARGS.Algebra.Magma using (module RawMagma) 11 | open import agdARGS.Data.String as String 12 | open import Data.Maybe 13 | 14 | open import agdARGS.Data.UniqueSortedList.Usual as UU hiding (_,_∷_) 15 | open import agdARGS.Data.Record.Usual as RU 16 | 17 | open import agdARGS.System.Console.Options.Domain 18 | open import agdARGS.System.Console.Options.Usual 19 | open import agdARGS.System.Console.Modifiers 20 | open import Function 21 | 22 | ParsedArgument : {ℓ : Level} (p : Σ[ d ∈ Domain ℓ ] Parser d) → Set ℓ 23 | ParsedArgument (d , p) = Carrier d 24 | 25 | ParsedArguments : {ℓ : Level} (p : Σ[ d ∈ Domain ℓ ] Parser d) → Set ℓ 26 | ParsedArguments (d , p) = Maybe $ Carrier d 27 | 28 | infix 4 commands_ 29 | mutual 30 | 31 | record Command (ℓ : Level) (name : String) {i : Size} : Set (suc ℓ) where 32 | inductive 33 | constructor mkCommand 34 | field 35 | description : String 36 | subcommands : SubCommands ℓ {i} 37 | modifiers : Modifiers ℓ 38 | arguments : Arguments ℓ 39 | 40 | SubCommands : ∀ ℓ {i : Size} → Set (suc ℓ) 41 | SubCommands ℓ {i} = ∃ λ names → Commands ℓ names {i} 42 | 43 | data Commands (ℓ : Level) (names : USL) : {i : Size} → Set (suc ℓ) where 44 | commands_ : ∀ {i} → Record names (tabulate (λ {s} _ → Command ℓ s {i})) → Commands ℓ names {↑ i} 45 | 46 | noSubCommands : ∀ {ℓ} → SubCommands ℓ 47 | noSubCommands = , commands ⟨⟩ 48 | 49 | infix 4 commandsSugar 50 | commandsSugar : ∀ {ℓ names} → Record names _ → Commands ℓ names 51 | commandsSugar = commands_ 52 | syntax commandsSugar t = < t 53 | 54 | basic : {ℓ : Level} {s : String} → Arguments ℓ → Command ℓ s 55 | basic {s = str} args = mkCommand str (, commands ⟨⟩) (, ⟨⟩) args 56 | 57 | record CLI (ℓ : Level) : Set (suc ℓ) where 58 | field 59 | name : String 60 | exec : Command ℓ name 61 | open CLI public 62 | open Command public 63 | 64 | open import Data.List 65 | open import agdARGS.Data.Infinities 66 | open import agdARGS.Data.Record.Properties strictTotalOrder 67 | open import Relation.Binary.PropositionalEquality 68 | 69 | mutual 70 | 71 | data ParsedCommand {ℓ s} : (c : Command ℓ s) → Set (suc ℓ) where 72 | theCommand : {descr : String} 73 | {subs : Σ[ names ∈ USL ] Commands ℓ names} 74 | {modNames : USL} {mods : Record modNames (toFields ℓ)} 75 | (parsedMods : ParsedModifiers mods) 76 | {args : Σ[ d ∈ Domain ℓ ] Parser d} 77 | (parsedArgs : ParsedArguments args) 78 | → ParsedCommand (mkCommand descr subs (modNames , mods) args) 79 | 80 | subCommand : {descr : String} 81 | {sub : String} {subs : USL} (pr : sub ∈ subs) {cs : Record subs _} 82 | {mods : Σ[ names ∈ USL ] Record names (toFields ℓ)} → 83 | (parsedSub : ParsedCommand (project′ pr cs)) 84 | {args : Σ[ d ∈ Domain ℓ ] Parser d} 85 | → ParsedCommand (mkCommand descr (subs , commands cs) mods args) 86 | 87 | ParsedInterface : ∀ {ℓ} → CLI ℓ → Set (suc ℓ) 88 | ParsedInterface i = ParsedCommand (exec i) 89 | 90 | infix 1 [_ 91 | infixr 2 _[_]∙_ 92 | infix 3 _∷=_&_] 93 | pattern [_ p = p 94 | pattern _∷=_&_] descr mods args = theCommand {descr} mods args 95 | pattern _[_]∙_ desc pr sub = subCommand {sub = desc} pr sub 96 | 97 | open import agdARGS.Data.Error as Error hiding (return) 98 | open import Data.Sum 99 | 100 | updateArgument : 101 | {ℓ : Level} (d : Domain ℓ) (p : Parser d) (ps : ParsedArguments (d , p)) → 102 | String → Error $ ParsedArguments (d , p) 103 | updateArgument (Some S) p (just _) _ = throw "Too Many arguments: only one expected" 104 | updateArgument (Some S) p nothing x = just <$> p x 105 | updateArgument (ALot M) p ps x = maybe′ (λ p q → just (RawMagma._∙_ M p q)) just ps <$> p x 106 | 107 | parseArguments : {ℓ : Level} (p : Σ[ d ∈ Domain ℓ ] Parser d) → List String 108 | → ParsedArguments p → Error $ ParsedArguments p 109 | parseArguments p str dft = foldl (cons p) (inj₂ dft) str 110 | where 111 | 112 | cons : (p : _) → Error (ParsedArguments p) → String → Error (ParsedArguments p) 113 | cons p (inj₁ str) _ = inj₁ str 114 | cons p (inj₂ nothing) str = just <$> proj₂ p str 115 | cons p (inj₂ (just v)) str with proj₁ p | proj₂ p 116 | ... | Some _ | _ = inj₁ "Too many arguments: only one expected" 117 | ... | ALot m | parser = parser str >>= λ w → Error.return (just (v ∙ w)) 118 | where open RawMagma m 119 | 120 | [dummy] : {ℓ : Level} {lb ub : _} (args : UniqueSortedList lb ub) 121 | (mods : Record args (RU.tabulate (λ {s} _ → Modifier ℓ s))) → 122 | [Record] args (fields $ Type $ RU.map (const ParsedModifier) mods) 123 | [dummy] (_ ■) m = lift tt 124 | [dummy] (_ UU., _ ∷ args) (mkRecord (mkFlag _ , ms)) = lift false , [dummy] args (mkRecord ms) 125 | [dummy] (_ UU., _ ∷ args) (mkRecord (mkOption _ , ms)) = nothing , [dummy] args (mkRecord ms) 126 | 127 | dummy : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {mods : Record args (toFields ℓ)} → 128 | Record args (Type $ RU.map (const ParsedModifier) mods) 129 | dummy = mkRecord $ [dummy] _ _ 130 | 131 | open import agdARGS.Relation.Nullary 132 | open import agdARGS.Data.UniqueSortedList.Usual 133 | 134 | parseModifier : ∀ {ℓ s} (c : Command ℓ s) {x : String} (recyxs recxs : Error (ParsedCommand c)) 135 | → x ∈ proj₁ (modifiers c) → Error $ ParsedCommand c 136 | parseModifier (mkCommand descr (subs , commands cs) mods args) {x} recyxs recxs pr = 137 | (case (project′ pr (proj₂ $ mods)) return (λ m → Error (ParsedModifier m)) of λ 138 | { (mkFlag f) → Error.return $ lift true 139 | ; (mkOption o) → just <$> proj₂ (`project "arguments" o) x 140 | }) 141 | >>= λ p → recyxs >>= λ rec → 142 | case rec of λ 143 | { (theCommand mods args) → (λ m → theCommand m args) <$> updateModifier mods pr p 144 | ; (subCommand _ _) → throw "Found a mkFlag for command XXX with subcommand YYY" } 145 | 146 | parseArgument : ∀ {ℓ s} (c : Command ℓ s) → Error (ParsedCommand c) → 147 | String → Error $ ParsedCommand c 148 | parseArgument (mkCommand descr (sub , commands subs) mods (d , p)) recyxs x = 149 | recyxs >>= λ rec → 150 | case rec of λ 151 | { (theCommand mods args) → theCommand mods <$> updateArgument d p args x 152 | ; (subCommand _ _) → throw "Found and argument for command XXX with subcommand YYY" 153 | } 154 | -------------------------------------------------------------------------------- /agdARGS/Data/Record/SmartConstructors.agda: -------------------------------------------------------------------------------- 1 | open import Level 2 | open import Relation.Binary 3 | 4 | module agdARGS.Data.Record.SmartConstructors 5 | {ℓᵃ ℓᵉ ℓʳ : Level} 6 | (STO : StrictTotalOrder ℓᵃ ℓᵉ ℓʳ) 7 | where 8 | 9 | open import Data.Unit 10 | open import Data.Empty 11 | open import Data.Bool 12 | open import Data.Product as Prod 13 | open import Data.Maybe 14 | open import Function 15 | open import Category.Monad 16 | open import agdARGS.Relation.Nullary 17 | open import agdARGS.Data.Infinities 18 | open import agdARGS.Data.UniqueSortedList STO as USL hiding (module withEqDec) 19 | open import agdARGS.Data.UniqueSortedList.SmartConstructors STO 20 | open import agdARGS.Data.Record STO as Rec 21 | 22 | 23 | ⟨⟩ : ∀ {ℓ} → Record {ℓ} `[] _ 24 | ⟨⟩ = _ 25 | 26 | infixr 5 _∷=_⟨_ 27 | _∷=_⟨_ : ∀ {ℓ} {args : USL} {f : Fields ℓ args} arg {S : Set ℓ} → S → 28 | Record args f → Record _ _ 29 | arg ∷= v ⟨ r = let open Rec.NeverFail in Rinsert arg (-∞<↑ arg) ↑ arg <+∞ v r 30 | 31 | {- 32 | [⟨⟩] : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : [Fields] ℓ args} → [MRecord] args f 33 | [⟨⟩] {args = _ ■} = lift tt 34 | [⟨⟩] {args = hd , lt ∷ args} = nothing , [⟨⟩] 35 | 36 | ⟨⟩ : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} → MRecord args f 37 | ⟨⟩ = mkMRecord [⟨⟩] 38 | 39 | infixr 5 [_at_∷=_⟨]_ _at_∷=_⟨_ 40 | [_at_∷=_⟨]_ : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : [Fields] ℓ args} 41 | arg (pr : arg ∈ args) (v : [lookup] pr f) → 42 | [MRecord] args f → [MRecord] args f 43 | [ a at z ∷= v ⟨] (_ , r) = just v , r 44 | [ a at s pr ∷= v ⟨] (w , r) = w , [ a at pr ∷= v ⟨] r 45 | 46 | _at_∷=_⟨_ : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} 47 | arg (pr : arg ∈ args) (v : lookup pr f) → 48 | MRecord args f → MRecord args f 49 | a at pr ∷= v ⟨ r = mkMRecord $ [ a at pr ∷= v ⟨] mcontent r 50 | 51 | 52 | [weaken] : ∀ {ℓ hd lb ub} {args : UniqueSortedList lb ub} .(lt : hd < lb) → 53 | [Fields] ℓ args → [Fields] ℓ (weaken lt args) 54 | [weaken] {args = lt ■} lt′ f = f 55 | [weaken] {args = hd , lt ∷ args} lt′ (S , f) = S , f 56 | 57 | [Weaken] : 58 | ∀ {ℓ hd lb ub} {args : UniqueSortedList lb ub} .(lt : hd < lb) {f : [Fields] ℓ args} → 59 | [Record] args f → [Record] (weaken lt args) ([weaken] lt f) 60 | [Weaken] {args = lt ■} lt′ mr = lift tt 61 | [Weaken] {args = hd , lt ∷ args} lt′ mr = mr 62 | 63 | [freeze] : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : [Fields] ℓ args} → 64 | [MRecord] args f → Maybe ([Record] args f) 65 | [freeze] {args = lt ■} mr = just _ 66 | [freeze] {args = hd , lt ∷ args} {f = (S , f)} (mv , mr) = _,_ <$> mv ⊛ [freeze] mr 67 | where open RawMonad monad 68 | 69 | mfreeze : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} 70 | (mr : MRecord args f) → Maybe (Record args f) 71 | mfreeze mr = let open RawMonad monad in mkRecord <$> [freeze] (mcontent mr) 72 | 73 | freeze : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} 74 | (mr : MRecord args f) → From-just (Record args f) (mfreeze mr) 75 | freeze mr = from-just (mfreeze mr) 76 | 77 | {- 78 | [allJust] : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : [Fields] ℓ args} → 79 | [MRecord] args f → Maybe ([Record] args f) 80 | [allJust] {args = lt ■} r = just r 81 | [allJust] {args = hd , lt ∷ args} (mv , r) = _,_ <$> mv ⊛ [allJust] r 82 | where open RawMonad monad 83 | 84 | allJust : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} → 85 | MRecord args f → Maybe (Record args f) 86 | allJust (mkMRecord r) = mkRecord <$> [allJust] r 87 | where open RawMonad monad 88 | 89 | freeze : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} → 90 | (r : MRecord args f) {pr : T (is-just (allJust r))} → Record args f 91 | freeze r {pr} = to-witness-T (allJust r) pr 92 | -} 93 | 94 | {- 95 | Dummy : (ℓ : Level) {lb ub : _} {args : UniqueSortedList lb ub} → Fields ℓ args 96 | Dummy ℓ = tabulate $ const $ Lift ⊤ 97 | 98 | ⟨⟩ : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} → Record args (Dummy ℓ) 99 | ⟨⟩ = pure go where 100 | go : {lb ub : _} {args : UniqueSortedList lb ub} (arg : _) (pr : arg ∈ args) → 101 | [lookup] pr (fields $ Dummy _) 102 | go arg z = lift tt 103 | go arg (s pr) = go arg pr 104 | 105 | [update] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} → [Fields] ℓ args → 106 | {arg : _} (pr : arg ∈ args) (A : Set ℓ) → [Fields] ℓ args 107 | [update] (_ , fs) z A = A , fs 108 | [update] (f , fs) (s pr) A = f , [update] fs pr A 109 | 110 | update : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} → Fields ℓ args → 111 | {arg : _} (pr : arg ∈ args) (A : Set ℓ) → Fields ℓ args 112 | update f pr A = mkFields $ [update] (fields f) pr A 113 | 114 | infixr 5 [_at_∷=_⟨]_ _at_∷=_⟨_ 115 | [_at_∷=_⟨]_ : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {f : [Fields] ℓ args} 116 | (arg : _) (pr : arg ∈ args) {A : Set ℓ} (v : A) → 117 | [Record] args f → [Record] args ([update] f pr A) 118 | [ a at z ∷= v ⟨] (_ , r) = v , r 119 | [ a at s pr ∷= v ⟨] (w , r) = w , [ a at pr ∷= v ⟨] r 120 | 121 | _at_∷=_⟨_ : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {f : Fields ℓ args} 122 | (arg : _) (pr : arg ∈ args) {A : Set ℓ} (v : A) → 123 | Record args f → Record args (update f pr A) 124 | a at pr ∷= v ⟨ r = mkRecord $ [ a at pr ∷= v ⟨] content r 125 | -} 126 | -} 127 | open import Relation.Binary.PropositionalEquality 128 | 129 | module withEqDec 130 | (eqDec : Decidable ((StrictTotalOrder.Carrier STO → _ → Set ℓᵃ) ∋ _≡_)) 131 | where 132 | 133 | open USL.withEqDec eqDec 134 | open import Relation.Nullary 135 | 136 | {- 137 | infixr 5 _∷=_⟨_ 138 | _∷=_⟨_ : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} 139 | arg {pr : toSet (arg ∈? args)} (v : lookup (fromYes (arg ∈? args) {pr}) f) → 140 | MRecord args f → MRecord args f 141 | _∷=_⟨_ {args = args} arg {pr} v r with arg ∈? args 142 | ... | yes p = arg at p ∷= v ⟨ r 143 | ... | no ¬p = ⊥-elim pr 144 | -} 145 | 146 | `project : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} arg → 147 | Record args f → dec (arg ∈? args) (λ pr → lookup pr f) (const $ Lift ⊤) 148 | `project {args = args} arg r with arg ∈? args 149 | ... | yes pr = project pr r 150 | ... | no ¬pr = lift tt 151 | 152 | _‼_ : ∀ {ℓ} {lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} → 153 | Record args f → ∀ arg → {pr : toSet (arg ∈? args)} → 154 | lookup (fromYes (arg ∈? args) {pr}) f 155 | _‼_ {args = args} r arg {pr} with arg ∈? args 156 | ... | yes p = project p r 157 | ... | no ¬p = ⊥-elim pr 158 | -------------------------------------------------------------------------------- /agdARGS/Data/Infinities.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.Data.Infinities where 2 | 3 | open import Level 4 | open import Function 5 | open import Data.Product 6 | open import Data.Sum 7 | open import agdARGS.Relation.Nullary 8 | open import Relation.Nullary 9 | open import Relation.Binary 10 | 11 | infix 10 ↑_ 12 | data [_] {ℓᵃ} (A : Set ℓᵃ) : Set ℓᵃ where 13 | -∞ : [ A ] 14 | ↑_ : (a : A) → [ A ] 15 | +∞ : [ A ] 16 | 17 | infix 10 -∞≤_ _≤+∞ 18 | data [≤] {ℓᵃ ℓʳ} {A : Set ℓᵃ} (_≤_ : Rel A ℓʳ) : 19 | (a b : [ A ]) → Set ℓʳ where 20 | -∞≤_ : (a : [ A ]) → [≤] _≤_ -∞ a 21 | ↑_ : {a b : A} (le : a ≤ b) → [≤] _≤_ (↑ a) (↑ b) 22 | _≤+∞ : (a : [ A ]) → [≤] _≤_ a +∞ 23 | 24 | data [<] {ℓᵃ ℓʳ} {A : Set ℓᵃ} (_<_ : Rel A ℓʳ) : 25 | (a b : [ A ]) → Set ℓʳ where 26 | -∞<↑_ : (a : A) → [<] _<_ -∞ (↑ a) 27 | -∞<+∞ : [<] _<_ -∞ +∞ 28 | ↑_<+∞ : (a : A) → [<] _<_ (↑ a) +∞ 29 | ↑_ : {a b : A} (lt : a < b) → [<] _<_ (↑ a) (↑ b) 30 | 31 | data [≈] {ℓᵃ ℓᵉ} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) : 32 | (a b : [ A ]) → Set ℓᵉ where 33 | -∞≈-∞ : [≈] _≈_ -∞ -∞ 34 | ↑_ : {a b : A} (eq : a ≈ b) → [≈] _≈_ (↑ a) (↑ b) 35 | +∞≈+∞ : [≈] _≈_ +∞ +∞ 36 | 37 | IsEquivalenceT : 38 | {ℓᵃ ℓᵉ : Level} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) 39 | (IE : IsEquivalence _≈_) → IsEquivalence ([≈] _≈_) 40 | IsEquivalenceT _≈_ IE = 41 | record { refl = refl 42 | ; sym = sym 43 | ; trans = trans } 44 | where 45 | refl : Reflexive ([≈] _≈_) 46 | refl { -∞} = -∞≈-∞ 47 | refl {↑ a} = ↑ IsEquivalence.refl IE 48 | refl { +∞} = +∞≈+∞ 49 | 50 | sym : Symmetric ([≈] _≈_) 51 | sym -∞≈-∞ = -∞≈-∞ 52 | sym (↑ eq) = ↑ IsEquivalence.sym IE eq 53 | sym +∞≈+∞ = +∞≈+∞ 54 | 55 | trans : Transitive ([≈] _≈_) 56 | trans -∞≈-∞ eq₂ = eq₂ 57 | trans (↑ eq₁) (↑ eq₂) = ↑ IsEquivalence.trans IE eq₁ eq₂ 58 | trans +∞≈+∞ +∞≈+∞ = +∞≈+∞ 59 | 60 | IsPreorderT : 61 | {ℓᵃ ℓᵉ ℓʳ : Level} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) (_≤_ : Rel A ℓʳ) 62 | (IPO : IsPreorder _≈_ _≤_) → IsPreorder ([≈] _≈_) ([≤] _≤_) 63 | IsPreorderT _≈_ _≤_ IPO = 64 | record { isEquivalence = IsEquivalenceT _≈_ $ IsPreorder.isEquivalence IPO 65 | ; reflexive = reflexive 66 | ; trans = trans } 67 | where 68 | reflexive : [≈] _≈_ ⇒ [≤] _≤_ 69 | reflexive -∞≈-∞ = -∞≤ -∞ 70 | reflexive (↑ eq) = ↑ IsPreorder.reflexive IPO eq 71 | reflexive +∞≈+∞ = +∞ ≤+∞ 72 | 73 | trans : Transitive ([≤] _≤_) 74 | trans (-∞≤ a) le₂ = -∞≤ _ 75 | trans (↑ le₁) (↑ le₂) = ↑ IsPreorder.trans IPO le₁ le₂ 76 | trans (↑ le) (._ ≤+∞) = _ ≤+∞ 77 | trans (a ≤+∞) (.+∞ ≤+∞) = a ≤+∞ 78 | 79 | IsPartialOrderT : 80 | {ℓᵃ ℓᵉ ℓʳ : Level} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) (_≤_ : Rel A ℓʳ) 81 | (IPO : IsPartialOrder _≈_ _≤_) → IsPartialOrder ([≈] _≈_) ([≤] _≤_) 82 | IsPartialOrderT _≈_ _≤_ IPO = 83 | record { isPreorder = IsPreorderT _≈_ _≤_ $ IsPartialOrder.isPreorder IPO 84 | ; antisym = antisym } 85 | where 86 | antisym : Antisymmetric ([≈] _≈_) ([≤] _≤_) 87 | antisym (-∞≤ .-∞) (-∞≤ .-∞) = -∞≈-∞ 88 | antisym (↑ le₁) (↑ le₂) = ↑ IsPartialOrder.antisym IPO le₁ le₂ 89 | antisym (.+∞ ≤+∞) (.+∞ ≤+∞) = +∞≈+∞ 90 | 91 | IsTotalOrderT : 92 | {ℓᵃ ℓᵉ ℓʳ : Level} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) (_≤_ : Rel A ℓʳ) 93 | (ITO : IsTotalOrder _≈_ _≤_) → IsTotalOrder ([≈] _≈_) ([≤] _≤_) 94 | IsTotalOrderT _≈_ _≤_ ITO = 95 | record { isPartialOrder = IsPartialOrderT _≈_ _≤_ $ IsTotalOrder.isPartialOrder ITO 96 | ; total = total } 97 | where 98 | total : Total ([≤] _≤_) 99 | total -∞ b = inj₁ $ -∞≤ b 100 | total a +∞ = inj₁ $ a ≤+∞ 101 | total +∞ b = inj₂ $ b ≤+∞ 102 | total a -∞ = inj₂ $ -∞≤ a 103 | total (↑ a) (↑ b) = [ inj₁ ∘ ↑_ , inj₂ ∘ ↑_ ]′ (IsTotalOrder.total ITO a b) 104 | 105 | IsDecTotalOrderT : 106 | {ℓᵃ ℓᵉ ℓʳ : Level} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) (_≤_ : Rel A ℓʳ) 107 | (IDTO : IsDecTotalOrder _≈_ _≤_) → IsDecTotalOrder ([≈] _≈_) ([≤] _≤_) 108 | IsDecTotalOrderT {A = A} _≈_ _≤_ IDTO = 109 | record { isTotalOrder = IsTotalOrderT _≈_ _≤_ $ IsDecTotalOrder.isTotalOrder IDTO 110 | ; _≟_ = _≟_ 111 | ; _≤?_ = _≤?_ } 112 | where 113 | ↑≈-inj : ∀ {a b : A} → [≈] _≈_ (↑ a) (↑ b) → a ≈ b 114 | ↑≈-inj (↑ eq) = eq 115 | 116 | _≟_ : Decidable ([≈] _≈_) 117 | -∞ ≟ -∞ = yes -∞≈-∞ 118 | (↑ a) ≟ (↑ b) = dec (IsDecTotalOrder._≟_ IDTO a b) (yes ∘ ↑_) (λ ¬eq → no $ ¬eq ∘ ↑≈-inj) 119 | +∞ ≟ +∞ = yes +∞≈+∞ 120 | -∞ ≟ (↑ a) = no $ λ () 121 | -∞ ≟ +∞ = no $ λ () 122 | (↑ a) ≟ -∞ = no $ λ () 123 | (↑ a) ≟ +∞ = no $ λ () 124 | +∞ ≟ -∞ = no $ λ () 125 | +∞ ≟ (↑ a) = no $ λ () 126 | 127 | ↑≤-inj : ∀ {a b : A} → [≤] _≤_ (↑ a) (↑ b) → a ≤ b 128 | ↑≤-inj (↑ le) = le 129 | 130 | _≤?_ : Decidable ([≤] _≤_) 131 | -∞ ≤? b = yes $ -∞≤ b 132 | (↑ a) ≤? (↑ b) = dec (IsDecTotalOrder._≤?_ IDTO a b) (yes ∘ ↑_) (λ ¬le → no $ ¬le ∘ ↑≤-inj) 133 | a ≤? +∞ = yes $ a ≤+∞ 134 | (↑ a) ≤? -∞ = no $ λ () 135 | +∞ ≤? -∞ = no $ λ () 136 | +∞ ≤? (↑ a) = no $ λ () 137 | 138 | IsStrictTotalOrderT : 139 | {ℓᵃ ℓᵉ ℓʳ : Level} {A : Set ℓᵃ} (_≈_ : Rel A ℓᵉ) (_<_ : Rel A ℓʳ) 140 | (ISTO : IsStrictTotalOrder _≈_ _<_) → IsStrictTotalOrder ([≈] _≈_) ([<] _<_) 141 | IsStrictTotalOrderT _≈_ _<_ ISTO = 142 | record { isEquivalence = IsEquivalenceT _≈_ $ IsStrictTotalOrder.isEquivalence ISTO 143 | ; trans = trans 144 | ; compare = compare 145 | } 146 | where 147 | 148 | trans : Transitive ([<] _<_) 149 | trans (-∞<↑ a) ↑ .a <+∞ = -∞<+∞ 150 | trans (-∞<↑ a) (↑ lt₂) = -∞<↑ _ 151 | trans -∞<+∞ () 152 | trans ↑ a <+∞ () 153 | trans (↑ lt₁) ↑ b <+∞ = ↑ _ <+∞ 154 | trans (↑ lt₁) (↑ lt₂) = ↑ IsStrictTotalOrder.trans ISTO lt₁ lt₂ 155 | 156 | ↑≈-inj : ∀ {a b : _} → [≈] _≈_ (↑ a) (↑ b) → a ≈ b 157 | ↑≈-inj (↑ eq) = eq 158 | 159 | ↑<-inj : ∀ {a b : _} → [<] _<_ (↑ a) (↑ b) → a < b 160 | ↑<-inj (↑ lt) = lt 161 | 162 | compare : Trichotomous ([≈] _≈_) ([<] _<_) 163 | compare -∞ -∞ = tri≈ (λ ()) -∞≈-∞ (λ ()) 164 | compare -∞ (↑ a) = tri< (-∞<↑ a) (λ ()) (λ ()) 165 | compare -∞ +∞ = tri< -∞<+∞ (λ ()) (λ ()) 166 | compare (↑ a) -∞ = tri> (λ ()) (λ ()) (-∞<↑ a) 167 | compare (↑ a) (↑ b) with IsStrictTotalOrder.compare ISTO a b 168 | ... | tri< lt ¬b ¬c = tri< (↑ lt) (¬b ∘ ↑≈-inj) (¬c ∘ ↑<-inj) 169 | ... | tri≈ ¬a eq ¬c = tri≈ (¬a ∘ ↑<-inj) (↑ eq) (¬c ∘ ↑<-inj) 170 | ... | tri> ¬a ¬b gt = tri> (¬a ∘ ↑<-inj) (¬b ∘ ↑≈-inj) (↑ gt) 171 | compare (↑ a) +∞ = tri< ↑ a <+∞ (λ ()) (λ ()) 172 | compare +∞ -∞ = tri> (λ ()) (λ ()) -∞<+∞ 173 | compare +∞ (↑ a) = tri> (λ ()) (λ ()) ↑ a <+∞ 174 | compare +∞ +∞ = tri≈ (λ ()) +∞≈+∞ (λ ()) 175 | 176 | PosetT : {ℓᵃ ℓᵉ ℓʳ : Level} → Poset ℓᵃ ℓᵉ ℓʳ → Poset ℓᵃ ℓᵉ ℓʳ 177 | PosetT PO = 178 | record { Carrier = _ 179 | ; _≈_ = _ 180 | ; _≤_ = _ 181 | ; isPartialOrder = IsPartialOrderT _ _ $ Poset.isPartialOrder PO } 182 | 183 | 184 | TotalOrderT : {ℓᵃ ℓᵉ ℓʳ : Level} → TotalOrder ℓᵃ ℓᵉ ℓʳ → TotalOrder ℓᵃ ℓᵉ ℓʳ 185 | TotalOrderT TO = 186 | record { Carrier = _ 187 | ; _≈_ = _ 188 | ; _≤_ = _ 189 | ; isTotalOrder = IsTotalOrderT _ _ $ TotalOrder.isTotalOrder TO } 190 | 191 | DecTotalOrderT : {ℓᵃ ℓᵉ ℓʳ : Level} → DecTotalOrder ℓᵃ ℓᵉ ℓʳ → DecTotalOrder ℓᵃ ℓᵉ ℓʳ 192 | DecTotalOrderT DTO = 193 | record { Carrier = _ 194 | ; _≈_ = _ 195 | ; _≤_ = _ 196 | ; isDecTotalOrder = IsDecTotalOrderT _ _ $ DecTotalOrder.isDecTotalOrder DTO } 197 | 198 | StrictTotalOrderT : {ℓᵃ ℓᵉ ℓʳ : Level} → StrictTotalOrder ℓᵃ ℓᵉ ℓʳ → StrictTotalOrder ℓᵃ ℓᵉ ℓʳ 199 | StrictTotalOrderT STO = 200 | record { Carrier = _ 201 | ; _≈_ = _ 202 | ; _<_ = _ 203 | ; isStrictTotalOrder = IsStrictTotalOrderT _ _ $ StrictTotalOrder.isStrictTotalOrder STO } 204 | -------------------------------------------------------------------------------- /doc/Sum.tex: -------------------------------------------------------------------------------- 1 | \begin{code}% 2 | \>\AgdaKeyword{module} \AgdaModule{agdARGS.Examples.Doc.Sum} \AgdaKeyword{where}\<% 3 | \\ 4 | % 5 | \\ 6 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Nat} \<[25]% 7 | \>[25]\AgdaSymbol{as} \AgdaModule{Nat}\<% 8 | \\ 9 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Integer} \AgdaSymbol{as} \AgdaModule{Int}\<% 10 | \\ 11 | % 12 | \\ 13 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Level} \AgdaSymbol{as} \AgdaModule{Level}\<% 14 | \\ 15 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Empty}\<% 16 | \\ 17 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Product}\<% 18 | \\ 19 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Bool}\<% 20 | \\ 21 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Maybe}\<% 22 | \\ 23 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Sum} \AgdaSymbol{as} \AgdaModule{Sum}\<% 24 | \\ 25 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.String} \AgdaSymbol{as} \AgdaModule{String}\<% 26 | \\ 27 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.String} \AgdaSymbol{as} \AgdaModule{Str}\<% 28 | \\ 29 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.List} \AgdaSymbol{as} \AgdaModule{List}\<% 30 | \\ 31 | \>\AgdaKeyword{import} \AgdaModule{agdARGS.Data.List} \AgdaSymbol{as} \AgdaModule{List}\<% 32 | \\ 33 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Function}\<% 34 | \\ 35 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Relation.Nullary}\<% 36 | \\ 37 | % 38 | \\ 39 | % 40 | \\ 41 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.CLI}\<% 42 | \\ 43 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.CLI.Usual}\<% 44 | \\ 45 | % 46 | \\ 47 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Error}\<% 48 | \\ 49 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Algebra.Magma}\<% 50 | \\ 51 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Nat.Read}\<% 52 | \\ 53 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Integer.Read}\<% 54 | \\ 55 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.UniqueSortedList.Usual}\<% 56 | \\ 57 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Record.Usual}\<% 58 | \\ 59 | % 60 | \\ 61 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.Options.Domain}\<% 62 | \\ 63 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.Modifiers} \AgdaSymbol{as} \AgdaModule{Mods} \AgdaKeyword{using} \AgdaSymbol{(}\AgdaFunction{flag}\AgdaSymbol{)}\<% 64 | \\ 65 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.Options.Usual}\<% 66 | \\ 67 | \>\AgdaFunction{Sum} \AgdaSymbol{:} \AgdaRecord{Command} \AgdaSymbol{\_} \AgdaString{"sum"}\<% 68 | \end{code} 69 | 70 | %<*sum> 71 | \begin{code}% 72 | \>\AgdaFunction{Sum} \AgdaSymbol{=} \AgdaKeyword{record}\<% 73 | \\ 74 | \> \AgdaSymbol{\{} \AgdaField{description} \<[16]% 75 | \>[16]\AgdaSymbol{=} \<[19]% 76 | \>[19]\AgdaString{"Sum its arguments"}\<% 77 | \\ 78 | \> \AgdaSymbol{;} \AgdaField{subcommands} \<[16]% 79 | \>[16]\AgdaSymbol{=}\<% 80 | \\ 81 | \> \AgdaFunction{,} \<[4]% 82 | \>[4]\AgdaFunction{<} \<[7]% 83 | \>[7]\AgdaString{"nat"} \AgdaFunction{∷=} \AgdaFunction{basic} \AgdaSymbol{(}\AgdaFunction{lotsOf} \AgdaFunction{Nat}\AgdaSymbol{)}\<% 84 | \\ 85 | \>[0]\AgdaIndent{4}{}\<[4]% 86 | \>[4]\AgdaFunction{⟨} \<[7]% 87 | \>[7]\AgdaString{"int"} \AgdaFunction{∷=} \AgdaFunction{basic} \AgdaSymbol{(}\AgdaFunction{lotsOf} \AgdaFunction{Int}\AgdaSymbol{)} \AgdaFunction{⟨} \AgdaFunction{⟨⟩}\<% 88 | \\ 89 | \> \AgdaSymbol{;} \AgdaField{modifiers} \<[16]% 90 | \>[16]\AgdaSymbol{=} \AgdaFunction{,} \AgdaString{"-v"} \AgdaFunction{∷=} \AgdaFunction{flag} \AgdaString{"Version nb"} \AgdaFunction{⟨} \AgdaFunction{⟨⟩}\<% 91 | \\ 92 | \> \AgdaSymbol{;} \AgdaField{arguments} \<[16]% 93 | \>[16]\AgdaSymbol{=} \<[19]% 94 | \>[19]\AgdaFunction{none} \AgdaSymbol{\}}\<% 95 | \end{code} 96 | % 97 | 98 | \begin{code}% 99 | \>\AgdaFunction{cli} \AgdaSymbol{:} \AgdaRecord{CLI} \AgdaPrimitive{Level.zero}\<% 100 | \\ 101 | \>\AgdaFunction{cli} \AgdaSymbol{=} \AgdaKeyword{record} \AgdaSymbol{\{} \AgdaField{name} \AgdaSymbol{=} \AgdaString{"sum"}\<% 102 | \\ 103 | \>[4]\AgdaIndent{13}{}\<[13]% 104 | \>[13]\AgdaSymbol{;} \AgdaField{exec} \AgdaSymbol{=} \AgdaFunction{Sum} \AgdaSymbol{\}} \AgdaKeyword{where}\<% 105 | \\ 106 | % 107 | \\ 108 | \>[0]\AgdaIndent{2}{}\<[2]% 109 | \>[2]\<% 110 | \\ 111 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{IO}\<% 112 | \\ 113 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Coinduction}\<% 114 | \\ 115 | \>\AgdaKeyword{import} \AgdaModule{Data.Nat.Show} \AgdaSymbol{as} \AgdaModule{NatShow}\<% 116 | \\ 117 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Environment.Arguments}\<% 118 | \\ 119 | % 120 | \\ 121 | \>\AgdaFunction{main} \AgdaSymbol{:} \AgdaSymbol{\_}\<% 122 | \\ 123 | \>\AgdaFunction{main} \AgdaSymbol{=} \AgdaFunction{withCLI} \AgdaFunction{cli} \AgdaFunction{\$} \AgdaFunction{putStrLn} \AgdaFunction{∘} \AgdaFunction{success}\<% 124 | \\ 125 | % 126 | \\ 127 | \>[0]\AgdaIndent{2}{}\<[2]% 128 | \>[2]\AgdaKeyword{where}\<% 129 | \\ 130 | % 131 | \\ 132 | \>[2]\AgdaIndent{4}{}\<[4]% 133 | \>[4]\AgdaFunction{sumNat} \AgdaSymbol{:} \AgdaDatatype{Maybe} \AgdaSymbol{(}\AgdaDatatype{List} \AgdaDatatype{ℕ}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaDatatype{ℕ}\<% 134 | \\ 135 | \>[2]\AgdaIndent{4}{}\<[4]% 136 | \>[4]\AgdaFunction{sumNat} \AgdaSymbol{=} \AgdaFunction{maybe} \AgdaSymbol{(}\AgdaFunction{List.foldr} \AgdaPrimitive{Nat.\_+\_} \AgdaNumber{0}\AgdaSymbol{)} \AgdaNumber{0}\<% 137 | \\ 138 | % 139 | \\ 140 | \>[2]\AgdaIndent{4}{}\<[4]% 141 | \>[4]\AgdaFunction{sumInt} \AgdaSymbol{:} \AgdaDatatype{Maybe} \AgdaSymbol{(}\AgdaDatatype{List} \AgdaDatatype{ℤ}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaDatatype{ℤ}\<% 142 | \\ 143 | \>[2]\AgdaIndent{4}{}\<[4]% 144 | \>[4]\AgdaFunction{sumInt} \AgdaSymbol{=} \AgdaFunction{maybe} \AgdaSymbol{(}\AgdaFunction{List.foldr} \AgdaFunction{Int.\_+\_} \AgdaSymbol{(}\AgdaInductiveConstructor{+} \AgdaNumber{0}\AgdaSymbol{))} \AgdaSymbol{(}\AgdaInductiveConstructor{+} \AgdaNumber{0}\AgdaSymbol{)}\<% 145 | \\ 146 | \>[2]\AgdaIndent{4}{}\<[4]% 147 | \>[4]\<% 148 | \\ 149 | \>[2]\AgdaIndent{4}{}\<[4]% 150 | \>[4]\AgdaFunction{success} \AgdaSymbol{:} \AgdaDatatype{ParsedCommand} \AgdaSymbol{(}\AgdaField{exec} \AgdaFunction{cli}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaPostulate{String}\<% 151 | \\ 152 | \>[2]\AgdaIndent{4}{}\<[4]% 153 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{[} \<[31]% 154 | \>[31]\AgdaSymbol{.\_} \<[38]% 155 | \>[38]\AgdaInductiveConstructor{∷=} \AgdaSymbol{\_} \AgdaInductiveConstructor{\&} \AgdaSymbol{\_} \AgdaInductiveConstructor{]}\AgdaSymbol{)} \<[51]% 156 | \>[51]\AgdaSymbol{=} \AgdaString{"meh"}\<% 157 | \\ 158 | \>[2]\AgdaIndent{4}{}\<[4]% 159 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{[} \AgdaSymbol{.}\AgdaString{"int"} \AgdaInductiveConstructor{[} \<[26]% 160 | \>[26]\AgdaInductiveConstructor{z} \AgdaInductiveConstructor{]∙} \AgdaSymbol{.}\AgdaString{"int"} \AgdaInductiveConstructor{∷=} \AgdaSymbol{\_} \AgdaInductiveConstructor{\&} \AgdaBound{vs} \AgdaInductiveConstructor{]}\AgdaSymbol{)} \AgdaSymbol{=} \AgdaFunction{Int.show} \<[66]% 161 | \>[66]\AgdaFunction{\$} \AgdaFunction{sumInt} \AgdaBound{vs}\<% 162 | \\ 163 | \>[2]\AgdaIndent{4}{}\<[4]% 164 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{[} \AgdaSymbol{.}\AgdaString{"nat"} \AgdaInductiveConstructor{[} \AgdaInductiveConstructor{s} \AgdaInductiveConstructor{z} \AgdaInductiveConstructor{]∙} \AgdaSymbol{.}\AgdaString{"nat"} \AgdaInductiveConstructor{∷=} \AgdaSymbol{\_} \AgdaInductiveConstructor{\&} \AgdaBound{vs} \AgdaInductiveConstructor{]}\AgdaSymbol{)} \AgdaSymbol{=} \AgdaFunction{NatShow.show} \AgdaFunction{\$} \AgdaFunction{sumNat} \AgdaBound{vs}\<% 165 | \\ 166 | % 167 | \\ 168 | \>[2]\AgdaIndent{4}{}\<[4]% 169 | \>[4]\AgdaComment{-- empty cases}\<% 170 | \\ 171 | \>[2]\AgdaIndent{4}{}\<[4]% 172 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{[} \AgdaSymbol{.}\AgdaString{"int"} \AgdaInductiveConstructor{[} \<[29]% 173 | \>[29]\AgdaInductiveConstructor{z} \<[33]% 174 | \>[33]\AgdaInductiveConstructor{]∙} \AgdaSymbol{\_} \AgdaInductiveConstructor{[} \AgdaSymbol{()} \AgdaInductiveConstructor{]∙} \AgdaSymbol{\_)}\<% 175 | \\ 176 | \>[2]\AgdaIndent{4}{}\<[4]% 177 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{[} \AgdaSymbol{.}\AgdaString{"nat"} \AgdaInductiveConstructor{[} \AgdaInductiveConstructor{s} \<[29]% 178 | \>[29]\AgdaInductiveConstructor{z} \<[33]% 179 | \>[33]\AgdaInductiveConstructor{]∙} \AgdaSymbol{\_} \AgdaInductiveConstructor{[} \AgdaSymbol{()} \AgdaInductiveConstructor{]∙} \AgdaSymbol{\_)}\<% 180 | \\ 181 | \>[2]\AgdaIndent{4}{}\<[4]% 182 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{[} \AgdaSymbol{\_} \<[26]% 183 | \>[26]\AgdaInductiveConstructor{[} \AgdaInductiveConstructor{s} \AgdaSymbol{(}\AgdaInductiveConstructor{s} \AgdaSymbol{())} \AgdaInductiveConstructor{]∙} \AgdaSymbol{\_)}\<% 184 | \end{code} 185 | -------------------------------------------------------------------------------- /doc/2017-01-06.tex: -------------------------------------------------------------------------------- 1 | \documentclass[dvipsnames]{beamer} 2 | \usetheme{ru} 3 | 4 | \usepackage{minted} 5 | \usepackage{mathspec} 6 | \usepackage{xcolor} 7 | 8 | \usepackage{tikz} 9 | \usetikzlibrary{calc,shapes.multipart,chains,arrows} 10 | 11 | \setmainfont[Ligatures=TeX]{XITS} 12 | \setmathfont{XITS Math} 13 | 14 | \title{agdARGS} 15 | \subtitle{Declarative Hierarchical Command Line Interfaces} 16 | \author[G. Allais]{Guillaume Allais} 17 | \institute[Radboud]{Radboud University} 18 | \date[NL FP Dag 17]{Dutch Functional Programming Day 2017} 19 | 20 | \begin{document} 21 | 22 | \begin{frame} 23 | \maketitle 24 | \end{frame} 25 | 26 | \section{Motivation: When it typechecks...} 27 | 28 | \begin{frame}{Ship it? More like shelve it! :(} 29 | Core algorithm 30 | \begin{itemize} 31 | \item Data structures with strong invariants 32 | \item Fully certified 33 | \end{itemize} 34 | + Boilerplate 35 | \begin{itemize} 36 | \item Validation of unsafe data 37 | \item (Command Line / Graphical) Interface 38 | \end{itemize} 39 | = Executable 40 | \end{frame} 41 | 42 | \begin{frame}{Case study: a minimal \texttt{grep}} 43 | No access to the program's command-line arguments 44 | \begin{itemize} 45 | \item Add postulate + \texttt{COMPILED} pragma for \texttt{getArgs} 46 | \item Wrap in the \texttt{IO} monad 47 | \end{itemize} 48 | Ad-hoc parsing function 49 | \end{frame} 50 | 51 | \begin{frame}[fragile]{"Hand-crafted" solution} 52 | 53 | Now that we have access to the arguments, we just have to make sense 54 | of them. We use a type of options: 55 | 56 | \begin{minted}{haskell} 57 | record grepOptions : Set where 58 | field 59 | -v : Bool -- invert match 60 | -i : Bool -- ignore case 61 | regexp : Maybe String -- regular expression 62 | files : List FilePath -- list of files to process 63 | \end{minted} 64 | 65 | And "hand-craft" a function populating it: 66 | \end{frame} 67 | 68 | \begin{frame}[fragile] 69 | \begin{minted}{haskell} 70 | parseOptions : List String -> grepOptions 71 | parseOptions args = 72 | record result { files = reverse (files result) } 73 | where 74 | cons : grepOptions -> String -> grepOptions 75 | cons opt "-v" = record opt { -v = true } 76 | cons opt "-i" = record opt { -i = true } 77 | cons opt str = 78 | if is-nothing (regexp opt) 79 | then record opt { regexp = just str } 80 | else record opt { files = str :: files opt } 81 | 82 | result : grepOptions 83 | result = foldl cons defaultGrepOptions args 84 | \end{minted} 85 | \end{frame} 86 | 87 | \section{What is the specification of a CLI?} 88 | \begin{frame}{Types: What is a command-line interface?} 89 | 90 | What is a Command-Line Interface? 91 | \begin{itemize} 92 | \item A \textbf{description} 93 | \item A list of \textbf{subcommands} 94 | \item A list of \textbf{modifiers} (\textbf{flags} \& \textbf{options}) 95 | \item Default \textbf{arguments} 96 | \end{itemize} 97 | 98 | What should we get from declaring one? 99 | \begin{itemize} 100 | \item The corresponding parser 101 | \item Usage information 102 | \end{itemize} 103 | \end{frame} 104 | 105 | \begin{frame}[fragile]{Types: Example of a CLI} 106 | \begin{minted}{haskell} 107 | Grep = record 108 | { description = "Print lines matching a regexp" 109 | ; subcommands = noSubCommands 110 | ; arguments = lotsOf filePath 111 | ; modifiers = 112 | , "-v" ::= flag "Invert match" 113 | < "-i" ::= flag "Ignore case" 114 | < "-e" ::= option "Regexp" regexp 115 | < <> 116 | } 117 | \end{minted} 118 | \end{frame} 119 | 120 | \section{Internal representation} 121 | \begin{frame}{Extensible records} 122 | Represent field names as sorted lists 123 | \begin{itemize} 124 | \item guaranteed uniqueness of commands / modifiers 125 | \item easy to lookup values 126 | \item easy to extend 127 | \item first class citizens (generic programming possible!) 128 | \end{itemize} 129 | Associate a type to each field name 130 | 131 | Generate record types by recursion on the list of field names 132 | 133 | Remark: Drive type inference 134 | \end{frame} 135 | 136 | \subsection{Types - Keep your neighbours in order} 137 | 138 | \begin{frame}{The type of extensible records} 139 | McBride to the rescue: "How to keep your neighbours in order" tells 140 | us how to build in the invariant stating that a tree's leaves are 141 | sorted. 142 | 143 | In the special case of linked lists, using a \emph{strict} total 144 | order, we move from: 145 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 146 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 147 | \begin{figure}[t] 148 | \centering 149 | \begin{tikzpicture}[list/.style={rectangle split, rectangle split parts=2, 150 | draw, rectangle split horizontal}, >=stealth, start chain] 151 | 152 | \node[list,on chain] (A) {12}; 153 | \node[list,on chain] (B) {99}; 154 | \node[list,on chain] (C) {128}; 155 | \node[on chain,draw, inner sep=6pt] (D) {}; 156 | \draw (D.north west) -- (D.south east); 157 | \draw (D.north east) -- (D.south west); 158 | \draw[*->] let \p1 = (A.two), \p2 = (A.center) in (\x1,\y2) -- (B); 159 | \draw[*->] let \p1 = (B.two), \p2 = (B.center) in (\x1,\y2) -- (C); 160 | \draw[*->] let \p1 = (C.two), \p2 = (C.center) in (\x1,\y2) -- (D); 161 | \end{tikzpicture} 162 | \end{figure} 163 | 164 | To the proven ordered: 165 | 166 | \begin{figure}[t] 167 | \begin{tikzpicture}[list/.style={rectangle split, rectangle split parts=2, 168 | draw, rectangle split horizontal}, >=stealth, start chain] 169 | 170 | \node[list,on chain] (A) {{\color{red}-$\infty$} < 12}; 171 | \node[list,on chain] (B) {{\color{gray}12} < 99}; 172 | \node[list,on chain] (C) {{\color{gray}99} < 128}; 173 | \node[on chain,draw] (D) {{\color{gray}128} < {\color{red}+$\infty$}}; 174 | \draw[*->] let \p1 = (A.two), \p2 = (A.center) in (\x1,\y2) -- (B); 175 | \draw[*->] let \p1 = (B.two), \p2 = (B.center) in (\x1,\y2) -- (C); 176 | \draw[*->] let \p1 = (C.two), \p2 = (C.center) in (\x1,\y2) -- (D); 177 | \end{tikzpicture} 178 | \end{figure} 179 | 180 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 181 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 182 | \end{frame} 183 | 184 | \begin{frame}[fragile]{Key ideas} 185 | 186 | Extend any ordered set with +/-infinity: 187 | \begin{minted}{haskell} 188 | data [_] (A : Set) : Set where 189 | -infty : [ A ] 190 | emb_ : (a : A) -> [ A ] 191 | +infty : [ A ] 192 | \end{minted} 193 | 194 | Define a type of ordered lists: 195 | \begin{minted}{haskell} 196 | data USL' (lb ub : [ A ]) : Set where 197 | [] : lb < ub -> USL' lb ub 198 | _,_::_ : hd -> lb < emb hd -> USL' (emb hd) ub -> 199 | USL' lb ub 200 | \end{minted} 201 | 202 | Top level type: relax the bounds as much as possible! 203 | \begin{minted}{haskell} 204 | type USL A = USL' (-infty : [ A ]) +infty 205 | \end{minted} 206 | \end{frame} 207 | 208 | \begin{frame}[fragile]{CLI} 209 | 210 | \begin{minted}{haskell} 211 | data Modifier name where 212 | mkFlag : Record _ Flag -> Modifier name 213 | mkOption : Record _ Option -> Modifier name 214 | 215 | record Command name : Set where 216 | inductive; constructor mkCommand 217 | field 218 | description : String 219 | subcommands : names ** Record names Command 220 | modifiers : names ** Record names Modifier 221 | arguments : Arguments 222 | \end{minted} 223 | \end{frame} 224 | 225 | \section{Design a nice interface} 226 | \begin{frame}[fragile]{We can \textbf{run} an awful lot at \textbf{compile time}} 227 | 228 | Fully-explicit, invariant-heavy structures internally 229 | 230 | vs. Decidability on concrete instances externally (smart constructors) 231 | 232 | Remember: 233 | \begin{minted}{haskell} 234 | , "-v" ::= flag "Invert match" 235 | < "-i" ::= flag "Ignore case" 236 | < "-e" ::= option "Regexp" regexp 237 | < <> 238 | \end{minted} 239 | \end{frame} 240 | 241 | \section{Generic Programming over Interfaces} 242 | 243 | \begin{frame}[fragile]{Parsing} 244 | Parsing is decomposed in 3 phases 245 | 246 | \begin{itemize} 247 | \item subcommand selection 248 | \item modifier and arguments collection 249 | \item argument collection (triggered by ``-{}-'') 250 | \end{itemize} 251 | 252 | And the returned result is \emph{guaranteed} to respect the CLI: 253 | 254 | \begin{minted}{haskell} 255 | parseCLI : (c : CLI) -> List String -> Error (ParsedCLI c) 256 | withCLI : (c : CLI) (k : ParsedCLI c -> IO a) -> IO a 257 | \end{minted} 258 | \end{frame} 259 | 260 | \begin{frame}[fragile]{Usage information} 261 | We know a lot about the structure of the interface. Let's use it! 262 | \begin{minted}{haskell} 263 | usage : CLI -> String 264 | \end{minted} 265 | 266 | e.g. 267 | 268 | \begin{minted}{bash} 269 | grep Print lines matching a regexp 270 | -e Regexp 271 | -i Ignore case 272 | -v Invert match 273 | \end{minted} 274 | \end{frame} 275 | 276 | \section{Conclusion} 277 | \begin{frame}[fragile]{Future Work} 278 | \begin{itemize} 279 | \item Validation DSL (cf. Jon Sterling's Vinyl) 280 | \item Syntactic sugar for writing the continuation 281 | \mintinline{haskell}{(k : ParsedCLI c -> IO a)} 282 | \item Compound flags 283 | \item Other types of documentation (e.g. man pages) 284 | \item More parsers for base types 285 | \end{itemize} 286 | \end{frame} 287 | \end{document} 288 | -------------------------------------------------------------------------------- /doc/2017-01-15.tex: -------------------------------------------------------------------------------- 1 | \documentclass[dvipsnames]{beamer} 2 | \usetheme{ru} 3 | 4 | \usepackage{minted} 5 | \usepackage{mathspec} 6 | \usepackage{xcolor} 7 | 8 | \usepackage{tikz} 9 | \usetikzlibrary{calc,shapes.multipart,chains,arrows} 10 | 11 | \setmainfont[Ligatures=TeX]{XITS} 12 | \setmathfont{XITS Math} 13 | 14 | \title{agdARGS} 15 | \subtitle{Declarative Hierarchical Command Line Interfaces} 16 | \author[G. Allais]{Guillaume Allais} 17 | \institute[Radboud]{Radboud University} 18 | \date[TTT 17]{Type Theory based Tools 2017 - Paris} 19 | 20 | \begin{document} 21 | 22 | \begin{frame} 23 | \maketitle 24 | \end{frame} 25 | 26 | \section{Motivation: When it typechecks...} 27 | 28 | \begin{frame}{Ship it? More like shelve it! :(} 29 | Core algorithm 30 | \begin{itemize} 31 | \item Data structures with strong invariants 32 | \item Fully certified 33 | \end{itemize} 34 | + Boilerplate 35 | \begin{itemize} 36 | \item Validation of unsafe data 37 | \item (Command Line / Graphical) Interface 38 | \end{itemize} 39 | = Executable 40 | \end{frame} 41 | 42 | \begin{frame}{Case study: a minimal \texttt{grep}} 43 | No access to the program's command-line arguments 44 | \begin{itemize} 45 | \item Add postulate + \texttt{COMPILED} pragma for \texttt{getArgs} 46 | \item Wrap in the \texttt{IO} monad 47 | \end{itemize} 48 | Ad-hoc parsing function 49 | \end{frame} 50 | 51 | \begin{frame}[fragile]{"Hand-crafted" solution} 52 | 53 | Now that we have access to the arguments, we just have to make sense 54 | of them. We use a type of options: 55 | 56 | \begin{minted}{haskell} 57 | record grepOptions : Set where 58 | field 59 | -v : Bool -- invert match 60 | -i : Bool -- ignore case 61 | regexp : Maybe String -- regular expression 62 | files : List FilePath -- list of files to process 63 | \end{minted} 64 | 65 | And "hand-craft" a function populating it: 66 | \end{frame} 67 | 68 | \begin{frame}[fragile] 69 | \begin{minted}{haskell} 70 | parseOptions : List String -> grepOptions 71 | parseOptions args = 72 | record result { files = reverse (files result) } 73 | where 74 | cons : grepOptions -> String -> grepOptions 75 | cons opt "-v" = record opt { -v = true } 76 | cons opt "-i" = record opt { -i = true } 77 | cons opt str = 78 | if is-nothing (regexp opt) 79 | then record opt { regexp = just str } 80 | else record opt { files = str :: files opt } 81 | 82 | result : grepOptions 83 | result = foldl cons defaultGrepOptions args 84 | \end{minted} 85 | \end{frame} 86 | 87 | \section{What is the specification of a CLI?} 88 | \begin{frame}{Types: What is a command-line interface?} 89 | 90 | What is a Command-Line Interface? 91 | \begin{itemize} 92 | \item A \textbf{description} 93 | \item A list of \textbf{subcommands} 94 | \item A list of \textbf{modifiers} (\textbf{flags} \& \textbf{options}) 95 | \item Default \textbf{arguments} 96 | \end{itemize} 97 | 98 | What should we get from declaring one? 99 | \begin{itemize} 100 | \item The corresponding parser 101 | \item Usage information 102 | \end{itemize} 103 | \end{frame} 104 | 105 | \begin{frame}[fragile]{Types: Example of a CLI} 106 | \begin{minted}{haskell} 107 | Grep = record 108 | { description = "Print lines matching a regexp" 109 | ; subcommands = noSubCommands 110 | ; arguments = lotsOf filePath 111 | ; modifiers = 112 | , "-v" ::= flag "Invert match" 113 | < "-i" ::= flag "Ignore case" 114 | < "-e" ::= option "Regexp" regexp 115 | < <> 116 | } 117 | \end{minted} 118 | \end{frame} 119 | 120 | \section{Internal representation} 121 | \begin{frame}{Extensible records} 122 | Represent field names as sorted lists 123 | \begin{itemize} 124 | \item guaranteed uniqueness of commands / modifiers 125 | \item easy to lookup values 126 | \item easy to extend 127 | \item first class citizens (generic programming possible!) 128 | \end{itemize} 129 | Associate a type to each field name 130 | 131 | Generate record types by recursion on the list of field names 132 | 133 | Remark: Drive type inference 134 | \end{frame} 135 | 136 | \subsection{Types - Keep your neighbours in order} 137 | 138 | \begin{frame}{The type of extensible records} 139 | McBride to the rescue: "How to keep your neighbours in order" tells 140 | us how to build in the invariant stating that a tree's leaves are 141 | sorted. 142 | 143 | In the special case of linked lists, using a \emph{strict} total 144 | order, we move from: 145 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 146 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 147 | \begin{figure}[t] 148 | \centering 149 | \begin{tikzpicture}[list/.style={rectangle split, rectangle split parts=2, 150 | draw, rectangle split horizontal}, >=stealth, start chain] 151 | 152 | \node[list,on chain] (A) {12}; 153 | \node[list,on chain] (B) {99}; 154 | \node[list,on chain] (C) {128}; 155 | \node[on chain,draw, inner sep=6pt] (D) {}; 156 | \draw (D.north west) -- (D.south east); 157 | \draw (D.north east) -- (D.south west); 158 | \draw[*->] let \p1 = (A.two), \p2 = (A.center) in (\x1,\y2) -- (B); 159 | \draw[*->] let \p1 = (B.two), \p2 = (B.center) in (\x1,\y2) -- (C); 160 | \draw[*->] let \p1 = (C.two), \p2 = (C.center) in (\x1,\y2) -- (D); 161 | \end{tikzpicture} 162 | \end{figure} 163 | 164 | To the proven ordered: 165 | 166 | \begin{figure}[t] 167 | \begin{tikzpicture}[list/.style={rectangle split, rectangle split parts=2, 168 | draw, rectangle split horizontal}, >=stealth, start chain] 169 | 170 | \node[list,on chain] (A) {{\color{red}-$\infty$} < 12}; 171 | \node[list,on chain] (B) {{\color{gray}12} < 99}; 172 | \node[list,on chain] (C) {{\color{gray}99} < 128}; 173 | \node[on chain,draw] (D) {{\color{gray}128} < {\color{red}+$\infty$}}; 174 | \draw[*->] let \p1 = (A.two), \p2 = (A.center) in (\x1,\y2) -- (B); 175 | \draw[*->] let \p1 = (B.two), \p2 = (B.center) in (\x1,\y2) -- (C); 176 | \draw[*->] let \p1 = (C.two), \p2 = (C.center) in (\x1,\y2) -- (D); 177 | \end{tikzpicture} 178 | \end{figure} 179 | 180 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 181 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 182 | \end{frame} 183 | 184 | \begin{frame}[fragile]{Key ideas} 185 | 186 | Extend any ordered set with +/-infinity: 187 | \begin{minted}{haskell} 188 | data [_] (A : Set) : Set where 189 | -infty : [ A ] 190 | emb_ : (a : A) -> [ A ] 191 | +infty : [ A ] 192 | \end{minted} 193 | 194 | Define a type of ordered lists: 195 | \begin{minted}{haskell} 196 | data USL' (lb ub : [ A ]) : Set where 197 | [] : lb < ub -> USL' lb ub 198 | _,_::_ : hd -> lb < emb hd -> USL' (emb hd) ub -> 199 | USL' lb ub 200 | \end{minted} 201 | 202 | Top level type: relax the bounds as much as possible! 203 | \begin{minted}{haskell} 204 | type USL A = USL' (-infty : [ A ]) +infty 205 | \end{minted} 206 | \end{frame} 207 | 208 | \begin{frame}[fragile]{CLI} 209 | 210 | \begin{minted}{haskell} 211 | data Modifier name where 212 | mkFlag : Record _ Flag -> Modifier name 213 | mkOption : Record _ Option -> Modifier name 214 | 215 | record Command name : Set where 216 | inductive; constructor mkCommand 217 | field 218 | description : String 219 | subcommands : names ** Record names Command 220 | modifiers : names ** Record names Modifier 221 | arguments : Arguments 222 | \end{minted} 223 | \end{frame} 224 | 225 | \section{Design a nice interface} 226 | \begin{frame}[fragile]{We can \textbf{run} an awful lot at \textbf{compile time}} 227 | 228 | Fully-explicit, invariant-heavy structures internally 229 | 230 | vs. Decidability on concrete instances externally (smart constructors) 231 | 232 | Remember: 233 | \begin{minted}{haskell} 234 | , "-v" ::= flag "Invert match" 235 | < "-i" ::= flag "Ignore case" 236 | < "-e" ::= option "Regexp" regexp 237 | < <> 238 | \end{minted} 239 | 240 | \onslide<2> 241 | Using the smart constructors: 242 | \begin{minted}{haskell} 243 | <> : Record [] _ 244 | _::=_<_ : forall n -> S -> Record nms fields -> 245 | Record (insert n nms) (Finsert n nms S) 246 | \end{minted} 247 | 248 | \end{frame} 249 | 250 | \section{Generic Programming over Interfaces} 251 | 252 | \begin{frame}[fragile]{Parsing} 253 | Parsing is decomposed in 3 phases 254 | 255 | \begin{itemize} 256 | \item subcommand selection 257 | \item modifier and arguments collection 258 | \item argument collection (triggered by ``-{}-'') 259 | \end{itemize} 260 | 261 | And the returned result is \emph{guaranteed} to respect the CLI: 262 | 263 | \begin{minted}{haskell} 264 | parseCLI : (c : CLI) -> List String -> Error (ParsedCLI c) 265 | withCLI : (c : CLI) (k : ParsedCLI c -> IO a) -> IO a 266 | \end{minted} 267 | \end{frame} 268 | 269 | \begin{frame}[fragile]{Usage information} 270 | We know a lot about the structure of the interface. Let's use it! 271 | \begin{minted}{haskell} 272 | usage : CLI -> String 273 | \end{minted} 274 | 275 | e.g. 276 | 277 | \begin{minted}{bash} 278 | grep Print lines matching a regexp 279 | -e Regexp 280 | -i Ignore case 281 | -v Invert match 282 | \end{minted} 283 | \end{frame} 284 | 285 | \section{Conclusion} 286 | \begin{frame}{Conclusion} 287 | \begin{itemize} 288 | \item Declarative 289 | \item Hierarchical 290 | \item Type-inference friendly 291 | \item Size-indexed internal representation 292 | \item Parser \& Usage 293 | \end{itemize} 294 | \end{frame} 295 | 296 | \begin{frame}[fragile]{Future Work} 297 | \begin{itemize} 298 | \item Validation DSL (cf. Jon Sterling's Vinyl) 299 | \item Syntactic sugar for writing the continuation 300 | \mintinline{haskell}{(k : ParsedCLI c -> IO a)} 301 | \item Compound flags 302 | \item Other types of documentation (e.g. man pages) 303 | \item More parsers for base types 304 | \item Set level issues 305 | \end{itemize} 306 | \end{frame} 307 | \end{document} 308 | -------------------------------------------------------------------------------- /agdARGS/System/Console/Options.agda: -------------------------------------------------------------------------------- 1 | module agdARGS.System.Console.Options where 2 | 3 | open import Level 4 | open import Data.Unit 5 | open import Data.Bool 6 | open import Data.Product as Prod 7 | open import Data.Sum as Sum 8 | open import Data.Maybe as Maybe 9 | open import Data.String as Str hiding (strictTotalOrder) 10 | 11 | open import Function 12 | open import Relation.Binary 13 | import Relation.Binary.On as On 14 | 15 | open import agdARGS.System.Console.Options.Domain 16 | 17 | record Option (ℓ : Level) : Set (suc ℓ) where 18 | field 19 | name : String 20 | description : String 21 | flag : String 22 | optional : Bool 23 | domain : Domain ℓ 24 | parser : Parser domain 25 | open Option 26 | 27 | strictTotalOrder : (ℓ : Level) → StrictTotalOrder _ _ _ 28 | strictTotalOrder ℓ = On.strictTotalOrder Str.strictTotalOrder (flag {ℓ}) 29 | 30 | module Options (ℓ : Level) where 31 | 32 | open import agdARGS.Data.Infinities 33 | open import agdARGS.Data.UniqueSortedList (strictTotalOrder ℓ) public 34 | 35 | Options : Set (suc ℓ) 36 | Options = UniqueSortedList -∞ +∞ 37 | 38 | Mode : {lb ub : _} (args : UniqueSortedList lb ub) → Set (suc ℓ) 39 | Mode args = (arg : Option ℓ) (pr : arg ∈ args) → Set ℓ 40 | 41 | ModeS : {lb ub : _} {hd : _} .{lt : lb < ↑ hd} {args : UniqueSortedList (↑ hd) ub} → 42 | Mode (hd , lt ∷ args) → Mode args 43 | ModeS m = λ arg → m arg ∘ s 44 | 45 | values : {lb ub : _} (args : UniqueSortedList lb ub) (m : Mode args) → Set ℓ 46 | values (lt ■) m = Lift ⊤ 47 | values (hd , lt ∷ args) m = m hd z × values args (ModeS m) 48 | 49 | -- This is a trick to facilitate type inference: when `args` is 50 | -- instantiated, `values` will compute, making it impossible 51 | -- to reconstruct `args`'s value, but `Values` will stay stuck. 52 | -- This is why `get` uses `Values` (and takes `args` as an 53 | -- implicit argument) and `parse` produces it. 54 | data Values (args : Options) (m : Mode args) : Set ℓ where 55 | mkValues : values args m → Values args m 56 | 57 | getValues : 58 | {lb ub : _} {args : UniqueSortedList lb ub} (m : Mode args) 59 | {arg : Option ℓ} (pr : arg ∈ args) → values args m → m arg pr 60 | getValues m z = proj₁ 61 | getValues m (s pr) = getValues (ModeS m) pr ∘ proj₂ 62 | 63 | SetDomain : Domain ℓ → Set ℓ 64 | SetDomain = maybe id (Lift ⊤) ∘ Carrier 65 | 66 | MaybeMode : {lb ub : _} {args : UniqueSortedList lb ub} → Mode args 67 | MaybeMode = const ∘ Maybe ∘ SetDomain ∘ domain 68 | 69 | defaultValues : {lb ub : _} (args : UniqueSortedList lb ub) → values args MaybeMode 70 | defaultValues (lt ■) = lift tt 71 | defaultValues (hd , lt ∷ args) = nothing , defaultValues args 72 | 73 | open import Relation.Nullary 74 | open import Relation.Binary.PropositionalEquality 75 | 76 | findOption : (str : String) (args : Options) → 77 | Dec (Σ[ arg ∈ Option ℓ ] (arg ∈ args × flag arg ≡ str)) 78 | findOption str = search Str._≟_ flag str 79 | 80 | open import lib.Nullary 81 | 82 | genericGet : 83 | {args : Options} {m : Mode args} (str : String) (opts : Values args m) → 84 | dec (findOption str args) (uncurry $ λ arg → m arg ∘ proj₁) (const $ Lift ⊤) 85 | genericGet {args} {m} str (mkValues opts) = dec′ C (findOption str args) success failure 86 | where 87 | C : Dec _ → Set ℓ 88 | C d = dec d (uncurry $ λ arg → m arg ∘ proj₁) (const $ Lift ⊤) 89 | 90 | success : ∀ p → C (yes p) 91 | success (arg , pr , _) = getValues m pr opts 92 | 93 | failure : ∀ ¬p → C (no ¬p) 94 | failure = const $ lift tt 95 | 96 | open import Category.Monad 97 | 98 | mapMValues : 99 | {M : Set ℓ → Set ℓ} (MM : RawMonad M) → 100 | {lb ub : _} (args : UniqueSortedList lb ub) {f g : Mode args} 101 | (upd : (arg : Option ℓ) (pr : arg ∈ args) → f arg pr → M (g arg pr)) → 102 | values args f → M (values args g) 103 | mapMValues MM (lt ■) upd opts = let open RawMonad MM in return opts 104 | mapMValues MM (hd , lt ∷ xs) upd (v , opts) = 105 | upd hd z v >>= λ w → 106 | mapMValues MM xs (λ arg → upd arg ∘ s) opts >>= λ ws → 107 | return (w , ws) 108 | where open RawMonad MM 109 | 110 | updateMValues : 111 | {M : Set ℓ → Set ℓ} (MM : RawMonad M) → 112 | {lb ub : _} {args : UniqueSortedList lb ub} {m : Mode args} 113 | {arg : Option ℓ} (pr : arg ∈ args) (f : m arg pr → M (m arg pr)) → 114 | values args m → M (values args m) 115 | updateMValues {M} MM {args = args} {m} {arg} pr f = mapMValues MM _ (upd m pr f) 116 | where 117 | open RawMonad MM 118 | 119 | upd : {lb ub : _} {args : UniqueSortedList lb ub} (m : Mode args) {arg : Option ℓ} → 120 | (pr : arg ∈ args) (upd : m arg pr → M (m arg pr)) → 121 | (arg : Option ℓ) (pr : arg ∈ args) → m arg pr → M (m arg pr) 122 | upd m z f arg z = f 123 | upd m z f arg (s pr₂) = return 124 | upd m (s pr₁) f arg z = return 125 | upd m (s pr₁) f arg (s pr₂) = upd (ModeS m) pr₁ f arg pr₂ 126 | 127 | import agdARGS.Data.Sum as Sum 128 | open import agdARGS.Algebra.Magma 129 | 130 | set : {args : Options} {arg : Option ℓ} (pr : arg ∈ args) (v : SetDomain (domain arg)) → 131 | values args MaybeMode → String ⊎ values args MaybeMode 132 | set {_} {arg} pr v = updateMValues (Sum.monad String) pr $ elimDomain {P = P} PNone PSome PALot (domain arg) v 133 | where 134 | P : Domain ℓ → Set ℓ 135 | P d = SetDomain d → Maybe (SetDomain d) → String ⊎ Maybe (SetDomain d) 136 | 137 | PNone : P None 138 | PNone new = maybe′ (const (inj₁ ("Flag " ++ flag arg ++ " set more than once"))) (inj₂ (just new)) 139 | 140 | PSome : (S : Set ℓ) → P (Some S) 141 | PSome S new = maybe′ (const (inj₁ ("Option " ++ flag arg ++ " used more than once"))) (inj₂ (just new)) 142 | 143 | PALot : (M : RawMagma ℓ) → P (ALot M) 144 | PALot M new = maybe′ (λ old → inj₂ (just (new ∙ old))) (inj₂ (just new)) 145 | where open RawMagma M 146 | 147 | open import Data.Nat as Nat 148 | open import Data.List using ([] ; _∷_ ; List) 149 | open import lib.Nullary 150 | 151 | ParseResult : (args : Options) → Maybe (Option ℓ) → Set ℓ 152 | ParseResult args default = maybe′ (Maybe ∘ SetDomain ∘ domain) (Lift ⊤) default × values args MaybeMode 153 | 154 | parse : List String → (default : Maybe (Option ℓ)) (args : Options) → 155 | String ⊎ maybe′ (Maybe ∘ SetDomain ∘ domain) (Lift ⊤) default × Values args MaybeMode 156 | parse xs default args = Sum.map id (Prod.map id mkValues) $ go xs (initDefault , defaultValues args) 157 | where 158 | 159 | initDefault : maybe′ (Maybe ∘ SetDomain ∘ domain) (Lift ⊤) default 160 | initDefault = maybe {B = maybe′ (Maybe ∘ SetDomain ∘ domain) (Lift ⊤)} (λ _ → nothing) (lift tt) default 161 | 162 | failure : String → ParseResult args default → String ⊎ ParseResult args default 163 | failure x (opt , opts) = 164 | (case default 165 | return (λ d → maybe (Maybe ∘ SetDomain ∘ domain) (Lift ⊤) d → String ⊎ ParseResult args d) 166 | of λ { nothing _ → inj₁ ("Invalid option: " ++ x) 167 | ; (just arg) → 168 | (case (domain arg) 169 | return (λ d → Parser d → Maybe (SetDomain d) → 170 | String ⊎ (Maybe (SetDomain d) × values args MaybeMode)) 171 | of λ { None p old → inj₁ "Defaulting should always work on a RawMagma" 172 | ; (Some S) p old → inj₁ "Defaulting should always work on a RawMagma" 173 | ; (ALot M) p old → 174 | let open RawMonad (Sum.monad String {ℓ}) 175 | open RawMagma M 176 | in (λ v → (maybe (λ w → just (v ∙ w)) (just v) old , opts)) <$> p x 177 | }) (parser arg) 178 | }) opt 179 | 180 | go : List String → ParseResult args default → String ⊎ ParseResult args default 181 | go [] opts = inj₂ opts 182 | go (x ∷ []) (opt , opts) = 183 | flip (dec (findOption x args)) 184 | -- flag not found 185 | (const $ failure x (opt , opts)) 186 | -- flag found 187 | $ λ elpreq → 188 | let sd = case domain (proj₁ elpreq) 189 | return (λ d → String ⊎ SetDomain d) 190 | of λ { None → inj₂ (lift tt) 191 | ; _ → inj₁ ("Option " ++ flag (proj₁ elpreq) ++ " expects an argument; none given") } 192 | open RawMonad (Sum.monad String {ℓ}) 193 | in sd >>= λ v → set (proj₁ (proj₂ elpreq)) v opts >>= λ opts′ → return (opt , opts′) 194 | go (x ∷ y ∷ xs) (opt , opts) = 195 | flip (dec (findOption x args)) 196 | -- flag not found 197 | (const $ 198 | let open RawMonad (Sum.monad String {ℓ}) 199 | in failure x (opt , opts) >>= go (y ∷ xs)) 200 | -- flag found 201 | $ λ elpreq → 202 | let vb = (case domain (proj₁ elpreq) 203 | return (λ d → Parser d → String ⊎ (SetDomain d × Bool)) 204 | of let open RawMonad (Sum.monad String {ℓ}) in λ 205 | { None p → inj₂ (lift tt , false) 206 | ; (Some S) p → (λ s → s , true) <$> p y 207 | ; (ALot M) p → (λ s → s , true) <$> p y } 208 | ) (parser (proj₁ elpreq)) 209 | open RawMonad (Sum.monad String {ℓ}) 210 | in vb >>= uncurry λ v b → set (proj₁ (proj₂ elpreq)) v opts >>= λ opts′ → 211 | (if b then go xs else go (y ∷ xs)) (opt , opts′) 212 | 213 | {- 214 | validate : {args : Values} → Values (const Maybe) args → 215 | let f a = if optional a then Maybe else id 216 | in Maybe $ Values f args 217 | validate = {!!} 218 | 219 | 220 | parse : List String → (args : Values) → Maybe $ Values _ args 221 | parse xs args = preParse xs args >>= validate 222 | where open RawMonad Maybe.monad 223 | -} 224 | open import agdARGS.Data.UniqueSortedList.SmartConstructors (strictTotalOrder ℓ) public -------------------------------------------------------------------------------- /doc/2015-03-18-IIM.tex: -------------------------------------------------------------------------------- 1 | \documentclass[dvipsnames]{beamer} 2 | \usetheme{CambridgeUS} 3 | 4 | \usepackage{minted} 5 | \usepackage{mathspec} 6 | \usepackage{xcolor} 7 | 8 | \usepackage{tikz} 9 | \usetikzlibrary{calc,shapes.multipart,chains,arrows} 10 | 11 | \setmainfont[Ligatures=TeX]{XITS} 12 | \setmathfont{XITS Math} 13 | 14 | \title{agdARGS} 15 | \subtitle{Command Line Arguments, Options and Flags} 16 | \author[G. Allais]{Guillaume Allais} 17 | \institute[Strathclyde]{University of Strathclyde} 18 | \date[IDM, March 2015]{Idris Developers Meeting, March 2015} 19 | 20 | \begin{document} 21 | 22 | \begin{frame} 23 | \maketitle 24 | \end{frame} 25 | 26 | \section{Motivation} 27 | \subsection{Let's compile!} 28 | 29 | \begin{frame} 30 | \frametitle{Crazy thought: let's compile some programs!} 31 | 32 | Bored of the stereotype that in Type Theory we never go anywhere 33 | past typechecking or producing \texttt{.tex} documents (which, 34 | by the way, Travis can help with! \url{http://blog.gallais.org/travis-builds}). 35 | 36 | \vspace{0.7cm} 37 | 38 | Decided to build a simple executable because I can. 39 | \end{frame} 40 | 41 | \subsection{aGdaREP} 42 | 43 | \begin{frame}{\url{https://github.com/gallais/aGdaREP}} 44 | 45 | My simple pick: a certified regexp matcher leading to an 46 | implementation of \texttt{grep}. 47 | 48 | \begin{center} 49 | \includegraphics[width=0.9\textwidth]{screenshot.png} 50 | \end{center} 51 | 52 | Lots of fun implementing, optimizing and extending the correct by 53 | construction matcher (see Alexandre Agular and Bassel Mannaa's 2009 54 | "Regular Expressions in Agda" ), 55 | 56 | But... then we need a user-facing interface! 57 | \end{frame} 58 | 59 | \begin{frame}[fragile]{A cheeky account of my journey} 60 | 61 | First step: add a binding to the important \texttt{Haskell} 62 | function... 63 | 64 | \begin{minted}{haskell} 65 | module Bindings.Arguments.Primitive where 66 | 67 | open import IO.Primitive 68 | open import Data.List 69 | open import Data.String 70 | 71 | {-# IMPORT System.Environment #-} 72 | 73 | postulate 74 | getArgs : IO (List String) 75 | 76 | {-# COMPILED getArgs System.Environment.getArgs #-} 77 | 78 | \end{minted} 79 | \end{frame} 80 | 81 | \begin{frame}[fragile]{But wait! There's more!} 82 | 83 | Then lift the bound primitive to the \texttt{IO} type actually used 84 | at a high level of abstraction: 85 | 86 | \begin{minted}{haskell} 87 | module Bindings.Arguments where 88 | 89 | open import Data.List 90 | open import Data.String 91 | open import IO 92 | import Bindings.Arguments.Primitive as Prim 93 | 94 | getArgs : IO (List String) 95 | getArgs = lift Prim.getArgs 96 | \end{minted} 97 | 98 | I guess it's a good way to learn about the language's and the 99 | standard library's internals? Which, maybe, I did not want to. 100 | Anyway. 101 | \end{frame} 102 | 103 | \begin{frame}[fragile]{"Hand-crafted" solution} 104 | 105 | Now that we have access to the arguments, we just have to make sense 106 | of them. We use a type of options: 107 | 108 | \begin{minted}{haskell} 109 | record grepOptions : Set where 110 | field 111 | -V : Bool -- version 112 | -v : Bool -- invert match 113 | -i : Bool -- ignore case 114 | regexp : Maybe String -- regular expression 115 | files : List FilePath -- list of files to mine 116 | open grepOptions public 117 | \end{minted} 118 | 119 | And "hand-craft" a function populating it: 120 | \end{frame} 121 | 122 | \begin{frame}[fragile] 123 | \begin{minted}{haskell} 124 | parseOptions : List String -> grepOptions 125 | parseOptions args = 126 | record result { files = reverse (files result) } 127 | where 128 | cons : grepOptions -> String -> grepOptions 129 | cons opt "-v" = record opt { -v = true } 130 | cons opt "-V" = record opt { -V = true } 131 | cons opt "-i" = record opt { -i = true } 132 | cons opt str = 133 | if is-nothing (regexp opt) 134 | then record opt { regexp = just str } 135 | else record opt { files = str :: files opt } 136 | 137 | result : grepOptions 138 | result = foldl cons defaultGrepOptions args 139 | \end{minted} 140 | \end{frame} 141 | 142 | \begin{frame}[fragile]{A few issues} 143 | \begin{itemize} 144 | \item I don't want to have to write this for every app 145 | \item I'm not even dealing with options yet 146 | \item This is not even ready for consumption yet! 147 | \begin{minted}{haskell} 148 | regexp : Maybe String 149 | \end{minted} 150 | \end{itemize} 151 | \end{frame} 152 | 153 | \section{Design the internals} 154 | \subsection{Types} 155 | 156 | \begin{frame}{What is a command-line interface?} 157 | 158 | \begin{itemize} 159 | \item A set of \emph{distinct} flag or options 160 | \item Each potentially coming with an \emph{argument} 161 | \item Living in a \emph{domain} of values 162 | \item We know how to \emph{parse} 163 | \end{itemize} 164 | \end{frame} 165 | 166 | \begin{frame}[fragile]{The (minimal) type of an \texttt{Argument}} 167 | \begin{minted}{haskell} 168 | record Argument (l : Level) : Set (suc l) where 169 | field 170 | flag : String 171 | domain : Domain l 172 | parser : parserType domain 173 | 174 | data Domain (l : Level) : Set (suc l) where 175 | None : Domain l 176 | Some : (S : Set l) -> Domain l 177 | ALot : (M : RawMagma l) -> Domain l 178 | 179 | parserType : {l : Level} -> Domain l -> Set l 180 | parserType None = Lift Unit 181 | parserType (Some S) = String -> String || S 182 | parserType (ALot M) = String -> String || carrier M 183 | \end{minted} 184 | \end{frame} 185 | 186 | \begin{frame}[fragile] 187 | A CLI is defined by an \textbf{extensible record} of arguments. 188 | 189 | \begin{itemize} 190 | \item guaranteed uniqueness of flags 191 | \item easy to lookup values 192 | \item easy to extend 193 | \item first class citizens (generic programming possible!) 194 | \end{itemize} 195 | \end{frame} 196 | 197 | \subsection{Types - Keep your neighbours in order} 198 | 199 | \begin{frame}{The type of extensible records} 200 | McBride to the rescue: "How to keep your neighbours in order" tells 201 | us how to build in the invariant stating that a tree's leaves are 202 | sorted. 203 | 204 | In the special case of linked lists, using a \emph{strict} total 205 | order, we move from: 206 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 207 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 208 | \begin{figure}[t] 209 | \centering 210 | \begin{tikzpicture}[list/.style={rectangle split, rectangle split parts=2, 211 | draw, rectangle split horizontal}, >=stealth, start chain] 212 | 213 | \node[list,on chain] (A) {12}; 214 | \node[list,on chain] (B) {99}; 215 | \node[list,on chain] (C) {128}; 216 | \node[on chain,draw, inner sep=6pt] (D) {}; 217 | \draw (D.north west) -- (D.south east); 218 | \draw (D.north east) -- (D.south west); 219 | \draw[*->] let \p1 = (A.two), \p2 = (A.center) in (\x1,\y2) -- (B); 220 | \draw[*->] let \p1 = (B.two), \p2 = (B.center) in (\x1,\y2) -- (C); 221 | \draw[*->] let \p1 = (C.two), \p2 = (C.center) in (\x1,\y2) -- (D); 222 | \end{tikzpicture} 223 | \end{figure} 224 | 225 | To the proven ordered: 226 | 227 | \begin{figure}[t] 228 | \begin{tikzpicture}[list/.style={rectangle split, rectangle split parts=2, 229 | draw, rectangle split horizontal}, >=stealth, start chain] 230 | 231 | \node[list,on chain] (A) {{\color{red}-$\infty$} < 12}; 232 | \node[list,on chain] (B) {{\color{gray}12} < 99}; 233 | \node[list,on chain] (C) {{\color{gray}99} < 128}; 234 | \node[on chain,draw] (D) {{\color{gray}128} < {\color{red}+$\infty$}}; 235 | \draw[*->] let \p1 = (A.two), \p2 = (A.center) in (\x1,\y2) -- (B); 236 | \draw[*->] let \p1 = (B.two), \p2 = (B.center) in (\x1,\y2) -- (C); 237 | \draw[*->] let \p1 = (C.two), \p2 = (C.center) in (\x1,\y2) -- (D); 238 | \end{tikzpicture} 239 | \end{figure} 240 | 241 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 242 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 243 | \end{frame} 244 | 245 | \begin{frame}[fragile]{Key ideas} 246 | 247 | Extend any ordered set with +/-infinity: 248 | \begin{minted}{haskell} 249 | data [_] {l : Level} (A : Set l) : Set l where 250 | -infty : [ A ] 251 | emb_ : (a : A) -> [ A ] 252 | +infty : [ A ] 253 | \end{minted} 254 | 255 | Define a type of ordered lists: 256 | \begin{minted}{haskell} 257 | data USL (lb ub : Carrier) : Set _ where 258 | [] : lb < ub -> USL lb ub 259 | _,_::_ : hd (lt : lb < emb hd) (tl : USL (emb hd) ub) -> 260 | USL lb ub 261 | \end{minted} 262 | 263 | Top level type: relax the bounds as much as possible! 264 | \begin{minted}{haskell} 265 | Arguments = USL -infty +infty 266 | \end{minted} 267 | \end{frame} 268 | 269 | \begin{frame}[fragile]{} 270 | As a consequence: 271 | 272 | \begin{itemize} 273 | \item really easy to write the correct: 274 | {\small\mintinline{haskell}{insertM : lb < x < ub -> USL lb ub -> Maybe (USL lb ub)}} 275 | 276 | rather than the intuitive: 277 | {\small \mintinline{haskell}{insertM : x -> USL lb ub -> Maybe (USL (min lb x) (max x ub))}} 278 | 279 | \item We can search for values satisfying a decidable property: 280 | 281 | \mintinline{haskell}{search : (d : Decidable R) f (a : A) (xs : USL lb ub) ->} 282 | \mintinline{haskell}{Dec (el ** el inUSL xs ** R (f el) a))} 283 | \end{itemize} 284 | 285 | where \mintinline{haskell}{_inUSL_} are fancy de Bruijn indices: 286 | \begin{minted}{haskell} 287 | data _inUSL_ (a : _) : USL lb ub -> Set _ where 288 | z : a inUSL a , lt :: xs 289 | s : a inUSL xs -> a inUSL b , lt :: xs 290 | \end{minted} 291 | \end{frame} 292 | 293 | \subsection{Terms} 294 | 295 | \begin{frame}[fragile]{The values of type an extensible record} 296 | Jon Sterling to the rescue: "Vinyl: Modern Records for Haskell" tells 297 | us what they should look like. 298 | 299 | \begin{minted}{haskell} 300 | Mode : (args : USL lb ub) -> Set (suc l) 301 | Mode args = arg (pr : arg inUSL args) -> Set l 302 | 303 | options : (args : USL lb ub) (m : Mode args) -> Set l 304 | options [] m = Lift Unit 305 | options (hd , lt :: args) m = m hd 0 * options args m' 306 | \end{minted} 307 | \end{frame} 308 | 309 | \begin{frame}[fragile]{Benefits} 310 | \begin{itemize} 311 | \item Mode morphisms $\Rightarrow$ record morphisms 312 | \item \mintinline{haskell}{get} through \mintinline{haskell}{search} + 313 | \mintinline{haskell}{lookup : (pr : x inUSL args)} 314 | \mintinline{haskell}{(opts : options args m) -> m x pr} 315 | \item generic parsing function! 316 | \mintinline{haskell}{parse : List String -> (args : Arguments) ->} 317 | \mintinline{haskell}{String || options args MaybeMode} 318 | \item generic usage function! 319 | \mintinline{haskell}{usage : Arguments -> String} 320 | \end{itemize} 321 | 322 | \end{frame} 323 | 324 | \section{Design a nice interface} 325 | \begin{frame}[fragile]{We can \textbf{run} an awful lot at \textbf{compile time}} 326 | 327 | \begin{itemize} 328 | \item Type-rich structures internally 329 | \item Decidability on concrete instances externally (smart constructors) 330 | \end{itemize} 331 | 332 | For instance using \texttt{fromJust}: 333 | 334 | \begin{minted}{haskell} 335 | fromJust : (a : Maybe A) {pr : maybe (\_ -> Unit) Void a} 336 | -> A 337 | fromJust (just a) {pr} = a 338 | fromJust nothing {()} 339 | \end{minted} 340 | 341 | we can turn \mintinline{haskell}{insertM : x (xs : Arguments) -> Maybe Arguments} 342 | into: 343 | 344 | \begin{minted}{haskell} 345 | insert : x (xs : Arguments) {pr : _} -> Arguments 346 | insert x xs = fromJust (insertM x xs) 347 | \end{minted} 348 | \end{frame} 349 | 350 | \section{Conclusion} 351 | 352 | \begin{frame}{Future Work} 353 | \begin{itemize} 354 | \item Validation (DSL to write Mode morphisms?) 355 | \item Clean up the interface 356 | \item More parsers for base types 357 | \item Identify the utilities worth sending upstream 358 | \end{itemize} 359 | \end{frame} 360 | 361 | \end{document} 362 | -------------------------------------------------------------------------------- /doc/TTT-2017.tex: -------------------------------------------------------------------------------- 1 | \documentclass[preprint,9pt]{sigplanconf} 2 | \usepackage[references]{agda} 3 | \usepackage[english]{babel} 4 | \usepackage{todonotes} 5 | \usepackage{alltt, enumitem, color, url} 6 | \usepackage{catchfilebetweentags} 7 | \setlength\mathindent{0em} 8 | 9 | % \setmainfont{XITS} 10 | % \setmathfont{XITS Math} 11 | 12 | \begin{document} 13 | 14 | \newcommand{\AB}[1]{\AgdaBound{#1}} 15 | \newcommand{\AD}[1]{\AgdaDatatype{#1}} 16 | \newcommand{\AF}[1]{\AgdaFunction{#1}} 17 | \newcommand{\AS}[1]{\AgdaSymbol{#1}} 18 | 19 | \newcommand{\command}[1]{\colorbox{lightgray}{\texttt{#1}}} 20 | 21 | \conferenceinfo{TTT '17}{January 15th, 2017, Paris, France} 22 | \copyrightyear{2017} 23 | \copyrightdata{978-1-nnnn-nnnn-n/yy/mm} 24 | \copyrightdoi{nnnnnnn.nnnnnnn} 25 | 26 | \title{agdARGS - Declarative Hierarchical Command Line Interfaces} 27 | % \subtitle{Subtitle Text, if any} 28 | 29 | \authorinfo{Guillaume Allais} 30 | {gallais@cs.ru.nl} 31 | {Radboud University Nijmegen} 32 | \maketitle 33 | 34 | \section{Introduction} 35 | 36 | If functional programmers using statically typed languages (broadly) 37 | in the Hindley-Milner tradition have taken to boasting 38 | ``If it typechecks, ship it!'', the shared sentiment amongst the ones 39 | using dependently typed languages seemed for a long while to be closer 40 | to ``Once it typechecks, shelve it!''. 41 | 42 | Over the years, there has been some outliers not only using Type Theory 43 | as a theorem proving tool but also demonstrating the practical benefits 44 | dependent types bring to the programmers' table. The nowadays classic 45 | definition of \texttt{printf} in a type-safe 46 | manner~\cite{augustsson1998cayenne} is a prime example. Other notable 47 | contributions in that vein include for instance parser DSLs and 48 | generators~\cite{danielsson2010total,stump2016book}, 49 | and interactive systems~\cite{brady2014resource,claret2015mechanical}. 50 | 51 | When writing an application in Type Theory, it is reasonable to expect 52 | the programmer to want to focus her attention on the core algorithms 53 | i.e. the parts that can be fully certified, dealing with sanitised data 54 | enriched with all sorts of fancy invariants. The wrapper code is not 55 | necessarily terribly exciting in comparison and tends to be treated 56 | more as an afterthought. 57 | Tanter and Tabareau~(\citeyear{tanter2015gradual}) have developed a 58 | nice library to facilitate the transition from weakly typed to strongly 59 | typed data whilst maintaining type safety. This potentially removes one 60 | layer of boilerplate. 61 | 62 | Command line interfaces are another one of these layers of wrapper 63 | code. We offer a solution: a dependently typed DSL for defining 64 | declaratively hierarchical command line interfaces available at 65 | \url{https://github.com/gallais/agdARGS}. 66 | 67 | \section{Hierarchical Command Line Interfaces} 68 | \label{hcli} 69 | 70 | A hierarchical command line interface is defined by: 71 | 72 | \begin{itemize} 73 | \item A \textbf{description} explaining the command's purpose. It has no 74 | influence on the implementation of the interface but is useful 75 | documentation for the end-user. 76 | 77 | \item A list of \textbf{subcommands}. They are themselves fully-fledged 78 | commands the user gets access to by mentioning a keyword. This 79 | makes it possible to give the interface a \emph{hierarchical} 80 | structure. E.g. \command{git pull} accesses the subcommand 81 | \texttt{git-pull} from the main \texttt{git} interface with the 82 | keyword \texttt{pull}. 83 | 84 | \item A list of \textbf{modifiers} for the current command. They can 85 | be either \textbf{flags} one may set or \textbf{options} taking 86 | a parameter. 87 | 88 | \item Finally, strings which are neither subcommand keywords nor 89 | modifiers are considered \textbf{arguments} of the command. 90 | \end{itemize} 91 | 92 | With our library, the programmer can simply get an interface by 93 | specifying this structure. For instance\footnote{Unfortunately 94 | we lack the space necessary to give an example of an interface 95 | with subcommands}, a command similar to UNIX's \texttt{wc} can 96 | be declared this way: 97 | 98 | \begin{figure}[ht] 99 | \ExecuteMetaData[WordCount.tex]{wordcount} 100 | \caption{The \texttt{wc} command's interface}\label{wc-cli} 101 | \end{figure} 102 | 103 | \section{Implementation Details} 104 | 105 | If the general structure of a command is set in stone, it cannot 106 | be the case for its subcommands and modifiers: they will vary 107 | from application to application in number and nature. This means 108 | that we need to design a first class representation of (extensible) 109 | records amenable to generic programming to deal with them. 110 | 111 | \subsection{Extensible Records} 112 | 113 | A record type is characterised by two things: a list of distinct 114 | field names and a type associated to each one of these fields. 115 | Given a decidable \emph{strict} order on the type of names, we can 116 | make use of McBride's design principles~(\citeyear{mcbride2014keep}) 117 | to define a structure of lists sorted in strictly increasing order 118 | and thus only containing distinct elements. These will be our lists 119 | of names. The types associated to each one of these field names can 120 | be collected in a right-nested tuple computed by recursion on the list. 121 | A record value is then a right-nested tuple of values of the corresponding 122 | types. 123 | 124 | Because there are so many computations at the type level, the 125 | unification machinery can get stuck on meta-variables introduced 126 | by implicit arguments. It is crucial for the usability of the 127 | library defining extensible records that some of these notions 128 | (the fields' types and the record value itself) are wrapped in 129 | an Agda record to guide the type inference. 130 | 131 | The combinators \AF{\_∷=\_⟨\_} and \AF{⟨⟩} one can see in 132 | Figure~\ref{wc-cli} are also crucial to the library's usability: 133 | they make it possible to define the extensible record field by 134 | field without having to pay attention to the underlying representation 135 | where all the invariants are enforced. 136 | 137 | 138 | \subsection{Commands as Rose Trees} 139 | 140 | The structure described in Section \ref{hcli} is reminiscent of a 141 | rose tree and it is indeed implemented as one. It should now be 142 | folklore that rose trees benefit a lot from being defined as sized 143 | types~\cite{abelminiagda}. It allows recursive traversals to weaponize 144 | higher-order functions without having to spend a lot of efforts 145 | appeasing the termination checker. An instance of such a higher order 146 | function we use to great effect is the fold over an extensible record 147 | of subcommands. 148 | 149 | We made Size an implicit index so that it does not add any extra 150 | overhead from the programmer's point of view in places where it 151 | does not matter. 152 | 153 | \section{Generic Programming over Interfaces} 154 | 155 | The point of having a first order representation of Interfaces 156 | is, just like for any deeply-embedded DSL~\cite{hudak1996building}, 157 | to be able to write generic program against this representation. 158 | 159 | \subsection{Parsing} 160 | 161 | The most important use case is to harness the Interface declaration 162 | to make sense of the list of strings\footnote{These are usually 163 | referred to as ``command line arguments'' e.g. in the specification 164 | of \texttt{getArgs} in the Haskell 98 report's ``System Functions'' 165 | section. We refrain from using that expression to avoid confusion 166 | with our Interface's notion of arguments} passed to the executable 167 | called from the command line. The expected result of a successful 168 | parse is a path down the hierarchical structure of the interface 169 | selecting a subcommand together with a collection of recognized 170 | modifiers and arguments specific to that subcommand. Dependent types 171 | allow us to make this requirement explicit by indexing the path 172 | over the command it corresponds to. We write \AF{ParsedCLI} \AB{c} 173 | for the type of successful parses associated to the interface \AB{c}. 174 | This parsing process can be decomposed in three successive phases: 175 | 176 | \begin{enumerate}[wide, labelwidth=!, labelindent=0pt] 177 | \item The \textbf{subcommand selection} phase goes down the hierarchical 178 | interface picking subcommands based on the keywords provided by the 179 | user. As soon as a modifier or an argument for the current command 180 | in focus is found, the second phase starts. 181 | 182 | \item The \textbf{modifier and arguments collection} phase now has 183 | settled for a given subcommand and tries to parse each new string as 184 | either one of its modifiers or, if that doesn't succeed, an argument. 185 | 186 | \item At any point the string ``-{}-'' can make the parser switch to the 187 | \textbf{argument collection} phase. It interprets each subsequent 188 | string as an argument to the command in focus. It is useful when 189 | arguments may look like modifiers e.g. \command{ls -l -{}- -l} lists 190 | (\texttt{ls}) in a long listing format (\texttt{-l}) the information 191 | about the file ``-l'' (\texttt{-{}- -l}). 192 | \end{enumerate} 193 | 194 | We provide the user with a combinator readily putting various 195 | pieces together that should fit most use cases. Its takes an interface, 196 | a continuation for a successful parse and returns an \texttt{IO} 197 | computation: 198 | \ExecuteMetaData[WordCount.tex]{withCLI} 199 | Internally, \AF{withCLI} performs a call to Haskell's \texttt{getArgs}, 200 | attempts to parse the list of strings it got back, and either prints 201 | the error to \texttt{stdout} if the parse failed or calls the 202 | continuation otherwise. 203 | 204 | It is currently very simple but fits our need. We can imagine 205 | more elaborate variations on it. We could for instance ``patch'' 206 | on the fly the provided interface so that it supports all the 207 | common flags for requesting help (e.g. \texttt{-h}, \texttt{-{}-help}, 208 | \texttt{-?}, etc.) and responds to them by displaying appropriate 209 | usage information. 210 | 211 | \subsection{Usage Information} 212 | 213 | It is indeed possible to exploit the available knowledge about 214 | the interface's hierarchical structure, the subcommands' names 215 | and their associated modifiers to generically produce usage 216 | information for the end-users' consumption. Our \AF{usage} 217 | function traverses the interface tree in a depth-first manner: 218 | it starts by recursively displaying all the subcommands (if any) 219 | at an increased indentation level and then lists the modifiers 220 | for the current command. Ran on the \texttt{wc}-like interface 221 | described in Figure~\ref{wc-cli}, it yields the output in 222 | Figure~\ref{wc-usage}. 223 | 224 | \begin{figure}[ht] 225 | \begin{alltt} 226 | WordCount Print each file's counts 227 | --help Display help 228 | --version Version Number 229 | -l Newline count 230 | -w Word count 231 | \end{alltt} 232 | \caption{Usage Information for the Interface in Fig. \ref{wc-cli}} 233 | \label{wc-usage} 234 | \end{figure} 235 | 236 | \section{Current Limitations and Future Work} 237 | 238 | Writing the continuation passed to \AF{withCLI} can be a bit 239 | verbose when dealing with deeply nested interfaces. It ought 240 | to be possible to define combinators that make it easier to 241 | combine together small, self-contained subcommands each one 242 | handling its own branch of the subcommands tree. 243 | 244 | It is rather common for interfaces to allow the grouping of 245 | flags which are one character long into compound flags (e.g. 246 | \command{tar -xz} is understood as \command{tar -x -z}) 247 | or to use the remainder of a one character long option as 248 | its parameter (e.g. \command{tar -xz -ffi} is understood as 249 | \command{tar -xz -f fi}). One can even mix the two e.g. 250 | \command{tar -xzffi}. The current parser does not handle 251 | these shortcuts. 252 | 253 | The usage information is generated in a rather crude manner 254 | by putting raw strings together. A well-structured intermediate 255 | format describing in a simple manner the dependencies between 256 | blocks of text would be an ideal candidate for a refactoring. 257 | Wadler's Prettier Printer~(\citeyear{wadler2003prettier}) is a 258 | possible candidate. 259 | 260 | Once the generation of usage information is well structured, 261 | it would be interesting to be able to generate proper \texttt{man} 262 | pages. An interesting problem to solve towards that goal is the 263 | generation of compact yet informative examples of valid usages. 264 | 265 | \bibliographystyle{abbrvnat} 266 | \bibliography{TTT-2017} 267 | 268 | \end{document} 269 | -------------------------------------------------------------------------------- /agdARGS/Data/Record.agda: -------------------------------------------------------------------------------- 1 | open import Level 2 | open import Relation.Binary 3 | 4 | module agdARGS.Data.Record 5 | {ℓᵃ ℓᵉ ℓʳ : Level} 6 | (STO : StrictTotalOrder ℓᵃ ℓᵉ ℓʳ) 7 | where 8 | 9 | open import Data.Unit 10 | open import Data.Maybe hiding (map) 11 | open import Data.Product hiding (map) 12 | open import Function 13 | open import Category.Applicative 14 | 15 | -- A Record is characterised by a set of field names. We decide 16 | -- to represent this set by a UniqueSortedList in order to ensure 17 | -- unicity of field names. Hence the following import: 18 | 19 | open import agdARGS.Data.Infinities hiding ([_]) 20 | open import agdARGS.Data.UniqueSortedList STO 21 | open import agdARGS.Data.UniqueSortedList.SmartConstructors STO as SC 22 | hiding (module MayFail ; module NeverFail) 23 | 24 | 25 | -- We then need to define what the content of each one of these 26 | -- fields is. This is taken care of by associating a set to each 27 | -- index of the UniqueSortedList of field names. 28 | 29 | [Fields] : (ℓ : Level) {lb ub : _} (args : UniqueSortedList lb ub) → Set (suc ℓ) 30 | [Fields] ℓ (_ ■) = Lift ⊤ 31 | [Fields] ℓ (_ , _ ∷ args) = Set ℓ × [Fields] ℓ args 32 | 33 | record Fields (ℓ : Level) {lb ub : _} (args : UniqueSortedList lb ub) : Set (suc ℓ) where 34 | constructor mkFields 35 | field 36 | fields : [Fields] ℓ args 37 | open Fields public 38 | 39 | -- We expect to be able to lookup a field's type from a Fields definition 40 | [lookup] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 41 | {arg : _} (pr : arg ∈ args) (fs : [Fields] ℓ args) → Set ℓ 42 | [lookup] z (f , _) = f 43 | [lookup] (s pr) (_ , fs) = [lookup] pr fs 44 | 45 | lookup : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 46 | {arg : _} (pr : arg ∈ args) (fs : Fields ℓ args) → Set ℓ 47 | lookup pr = [lookup] pr ∘ fields 48 | 49 | -- We may tabulate a function associating, to each element, a Set in order 50 | -- to get a Fields. Cue the simplest examples: constant Set ℓ. 51 | 52 | [tabulate] : {ℓ : Level} {lb ub : _} (args : UniqueSortedList lb ub) 53 | (ρ : {arg : _} (pr : arg ∈ args) → Set ℓ) → [Fields] ℓ args 54 | [tabulate] (_ ■) ρ = lift tt 55 | [tabulate] (arg , _ ∷ args) ρ = ρ z , [tabulate] args (ρ ∘ s) 56 | 57 | tabulate : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 58 | (ρ : {arg : _} (pr : arg ∈ args) → Set ℓ) → Fields ℓ args 59 | tabulate {args = args} = mkFields ∘ [tabulate] args 60 | 61 | [Sets] : (ℓ : Level) {lb ub : _} (args : UniqueSortedList lb ub) → [Fields] (suc ℓ) args 62 | [Sets] ℓ args = [tabulate] args $ const $ Set ℓ 63 | 64 | Sets : (ℓ : Level) {lb ub : _} {args : UniqueSortedList lb ub} → Fields (suc ℓ) args 65 | Sets ℓ = tabulate $ const $ Set ℓ 66 | 67 | -- We can apply a set transformer to each one the elements. This will 68 | -- be useful later on when dealing with records whose elements are 69 | -- in an applicative functor or a monad 70 | 71 | [_[_]] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} → 72 | (a : Set ℓ → Set ℓ) → [Fields] ℓ args → [Fields] ℓ args 73 | [_[_]] {args = _ ■} a f = f 74 | [_[_]] {args = _ , _ ∷ args} a (f , fs) = a f , [ a [ fs ]] 75 | 76 | infix 5 _[_] 77 | _[_] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} → 78 | (a : Set ℓ → Set ℓ) → Fields ℓ args → Fields ℓ args 79 | a [ f ] = mkFields [ a [ fields f ]] 80 | 81 | -- A record is then defined by aggregating an element of each one 82 | -- of these sets in a right-nested tuple. 83 | 84 | [Record] : ∀ {ℓ lb ub} (args : UniqueSortedList lb ub) (f : [Fields] ℓ args) → Set ℓ 85 | [Record] (lt ■) f = Lift ⊤ 86 | [Record] (hd , lt ∷ args) (f , fs) = f × [Record] args fs 87 | 88 | record Record {ℓ lb ub} (args : UniqueSortedList lb ub) (f : Fields ℓ args) : Set ℓ where 89 | constructor mkRecord 90 | field 91 | content : [Record] args (fields f) 92 | open Record public 93 | 94 | 95 | module NeverFail where 96 | 97 | open SC.NeverFail 98 | 99 | -- We may also insert a new field 100 | [Finsert] : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} 101 | arg .lt₁ .lt₂ → Set ℓ → [Fields] ℓ args → [Fields] ℓ (insert′ arg lt₁ lt₂ args) 102 | [Finsert] {args = lt ■} a lt₁ lt₂ S f = S , _ 103 | [Finsert] {args = hd , lt ∷ args} a lt₁ lt₂ S f with compare (↑ a) (↑ hd) 104 | ... | tri< lt′ ¬eq ¬gt = S , f 105 | ... | tri≈ ¬lt eq ¬gt = S , proj₂ f 106 | ... | tri> ¬lt ¬eq gt = proj₁ f , [Finsert] a gt lt₂ S (proj₂ f) 107 | 108 | Finsert : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} 109 | arg .lt₁ .lt₂ → Set ℓ → Fields ℓ args → Fields ℓ (insert′ arg lt₁ lt₂ args) 110 | Finsert arg lt₁ lt₂ S (mkFields f) = mkFields ([Finsert] arg lt₁ lt₂ S f) 111 | 112 | [Rinsert] : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : [Fields] ℓ args} arg .lt₁ .lt₂ → 113 | {S : Set ℓ} (v : S) → [Record] args f → [Record] _ ([Finsert] arg lt₁ lt₂ S f) 114 | [Rinsert] {args = lt ■} a lt₁ lt₂ S f = S , _ 115 | [Rinsert] {args = hd , lt ∷ args} a lt₁ lt₂ S f with compare (↑ a) (↑ hd) 116 | ... | tri< lt′ ¬eq ¬gt = S , f 117 | ... | tri≈ ¬lt eq ¬gt = S , proj₂ f 118 | ... | tri> ¬lt ¬eq gt = proj₁ f , [Rinsert] a gt lt₂ S (proj₂ f) 119 | 120 | Rinsert : ∀ {ℓ lb ub} {args : UniqueSortedList lb ub} {f : Fields ℓ args} arg .lt₁ .lt₂ → 121 | {S : Set ℓ} (v : S) → Record args f → Record _ (Finsert arg lt₁ lt₂ S f) 122 | Rinsert arg lt₁ lt₂ v (mkRecord r) = mkRecord ([Rinsert] arg lt₁ lt₂ v r) 123 | 124 | 125 | [foldr] : ∀ {ℓ ℓ′ lb ub} {names : UniqueSortedList lb ub} {A : Set ℓ′} {f : ∀ {n} (pr : n ∈ names) → Set ℓ} → 126 | (∀ {n} pr → f {n} pr → A → A) → A → [Record] names ([tabulate] names f) → A 127 | [foldr] {names = lt ■} c n r = n 128 | [foldr] {names = hd , lt ∷ names} c n (v , r) = c z v $ [foldr] (c ∘ s) n r 129 | 130 | foldr : ∀ {ℓ ℓ′ lb ub} {names : UniqueSortedList lb ub} {A : Set ℓ′} {f : ∀ {n} (pr : n ∈ names) → Set ℓ} → 131 | (∀ {n} pr → f {n} pr → A → A) → A → Record names (tabulate f) → A 132 | foldr c n = [foldr] c n ∘ content 133 | 134 | [MRecord] : ∀ {ℓ lb ub} (args : UniqueSortedList lb ub) (f : [Fields] ℓ args) → Set ℓ 135 | [MRecord] (lt ■) f = Lift ⊤ 136 | [MRecord] (hd , lt ∷ args) (f , fs) = Maybe f × [MRecord] args fs 137 | 138 | record MRecord {ℓ lb ub} (args : UniqueSortedList lb ub) (f : Fields ℓ args) : Set ℓ where 139 | constructor mkMRecord 140 | field 141 | mcontent : [MRecord] args (fields f) 142 | open MRecord public 143 | 144 | -- The first thing we expect Records to deliver is the ability to 145 | -- project the content of a field given its name. 146 | 147 | [project] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : [Fields] ℓ args} 148 | {arg : _} (pr : arg ∈ args) → [Record] args fs → [lookup] pr fs 149 | [project] z (v , _) = v 150 | [project] (s pr) (_ , r) = [project] pr r 151 | 152 | project : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : Fields ℓ args} 153 | {arg : _} (pr : arg ∈ args) → Record args fs → lookup pr fs 154 | project pr = [project] pr ∘ content 155 | 156 | [project′] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 157 | {fs : {arg : _} (pr : arg ∈ args) → Set ℓ} 158 | {arg : _} (pr : arg ∈ args) → [Record] args ([tabulate] args fs) → fs pr 159 | [project′] z (v , _) = v 160 | [project′] (s pr) (_ , r) = [project′] pr r 161 | 162 | project′ : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 163 | {fs : {arg : _} (pr : arg ∈ args) → Set ℓ} 164 | {arg : _} (pr : arg ∈ args) → Record args (tabulate fs) → fs pr 165 | project′ pr = [project′] pr ∘ content 166 | 167 | -- A record of Sets can naturally be turned into the appropriate Fields 168 | -- This is how we end up typing records with records 169 | 170 | [Type] : {ℓ : Level} {lb ub : _} (args : UniqueSortedList lb ub) 171 | (r : [Record] args ([Sets] ℓ args)) → [Fields] ℓ args 172 | [Type] (_ ■) _ = lift tt 173 | [Type] (_ , _ ∷ args) (v , r) = v , [Type] args r 174 | 175 | Type : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 176 | (r : Record args (Sets ℓ)) → Fields ℓ args 177 | Type = mkFields ∘ [Type] _ ∘ content 178 | 179 | -- If we know how to populate fields, we naturally want to be able 180 | -- to build a record by tabulating the defining function. 181 | 182 | [pure] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : [Fields] ℓ args} 183 | (v : (arg : _) (pr : arg ∈ args) → [lookup] pr fs) → [Record] args fs 184 | [pure] {args = lt ■} v = lift tt 185 | [pure] {args = hd , lt ∷ args} v = v _ z , [pure] (λ a → v a ∘ s) 186 | 187 | pure : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : Fields ℓ args} 188 | (v : (arg : _) (pr : arg ∈ args) → lookup pr fs) → Record args fs 189 | pure = mkRecord ∘ [pure] 190 | 191 | [pure′] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : {arg : _} (pr : arg ∈ args) → Set ℓ} 192 | (v : (arg : _) (pr : arg ∈ args) → fs pr) → [Record] args ([tabulate] args fs) 193 | [pure′] {args = lt ■} v = lift tt 194 | [pure′] {args = hd , lt ∷ args} v = v _ z , [pure′] (λ a → v a ∘ s) 195 | 196 | pure′ : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : {arg : _} (pr : arg ∈ args) → Set ℓ} 197 | (v : (arg : _) (pr : arg ∈ args) → fs pr) → Record args (tabulate fs) 198 | pure′ = mkRecord ∘ [pure′] 199 | 200 | -- A special sort of content may be a Fields-morphism: for each 201 | -- field we will explaing how to turn data belonging to the first 202 | -- type of Records to the second one. 203 | 204 | infixr 3 _[⟶]_ _⟶_ 205 | _[⟶]_ : {ℓᶠ ℓᵍ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 206 | (fs : [Fields] ℓᶠ args) (gs : [Fields] ℓᵍ args) → [Fields] (ℓᶠ ⊔ ℓᵍ) args 207 | fs [⟶] gs = [tabulate] _ $ λ pr → [lookup] pr fs → [lookup] pr gs 208 | 209 | _⟶_ : {ℓᶠ ℓᵍ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 210 | (f : Fields ℓᶠ args) (g : Fields ℓᵍ args) → Fields (ℓᶠ ⊔ ℓᵍ) args 211 | fs ⟶ gs = mkFields $ fields fs [⟶] fields gs 212 | 213 | -- And given a first record whose fields are Fields-morphism 214 | -- and a second record whose fields are of the corresponding 215 | -- domain, we can apply them in a pointwise manner: 216 | 217 | [app] : {ℓᶠ ℓᵍ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 218 | {fs : [Fields] ℓᶠ args} {gs : [Fields] ℓᵍ args} 219 | (fs→gs : [Record] args (fs [⟶] gs)) (r : [Record] args fs) → [Record] args gs 220 | [app] {args = lt ■} fs→gs fs = lift tt 221 | [app] {args = hd , lt ∷ args} (f→g , fs→gs) (f , fs) = f→g f , [app] fs→gs fs 222 | 223 | app : {ℓᶠ ℓᵍ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 224 | {fs : Fields ℓᶠ args} {gs : Fields ℓᵍ args} 225 | (fs→gs : Record args (fs ⟶ gs)) (f : Record args fs) → Record args gs 226 | app fs→gs f = mkRecord $ [app] (content fs→gs) (content f) 227 | 228 | [map] : {ℓᶠ ℓᵍ : Level} {lb ub : _} (args : UniqueSortedList lb ub) 229 | {fs : {arg : _} (pr : arg ∈ args) → Set ℓᶠ} 230 | {gs : {arg : _} (pr : arg ∈ args) → Set ℓᵍ} 231 | (fs→gs : {arg : _} (pr : arg ∈ args) → fs pr → gs pr) 232 | (f : [Record] args ([tabulate] args fs)) → [Record] args ([tabulate] args gs) 233 | [map] (_ ■) fs→gs f = lift tt 234 | [map] (_ , _ ∷ args) fs→gs (v , f) = fs→gs z v , [map] args (fs→gs ∘ s) f 235 | 236 | map : {ℓᶠ ℓᵍ : Level} {lb ub : _} {args : UniqueSortedList lb ub} 237 | {fs : {arg : _} (pr : arg ∈ args) → Set ℓᶠ} 238 | {gs : {arg : _} (pr : arg ∈ args) → Set ℓᵍ} 239 | (fs→gs : {arg : _} (pr : arg ∈ args) → fs pr → gs pr) 240 | (f : Record args (tabulate fs)) → Record args (tabulate gs) 241 | map fs→gs = mkRecord ∘ [map] _ fs→gs ∘ content 242 | 243 | [seqA] : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : [Fields] ℓ args} 244 | {a : Set ℓ → Set ℓ} (A : RawApplicative a) → 245 | [Record] args [ a [ fs ]] → a ([Record] args fs) 246 | [seqA] {ℓ} {args = args} {a = a} A = go args 247 | where 248 | module RA = RawApplicative A ; open RA 249 | 250 | go : {lb ub : _} (args : UniqueSortedList lb ub) {fs : [Fields] ℓ args} → 251 | [Record] args [ a [ fs ]] → a ([Record] args fs) 252 | go (lt ■) r = RA.pure r 253 | go (hd , lt ∷ args) (av , r) = _,_ RA.<$> av RA.⊛ go args r 254 | 255 | seqA : {ℓ : Level} {lb ub : _} {args : UniqueSortedList lb ub} {fs : Fields ℓ args} 256 | {a : Set ℓ → Set ℓ} (A : RawApplicative a) → 257 | Record args (a [ fs ]) → a (Record args fs) 258 | seqA A r = mkRecord RA.<$> [seqA] A (content r) 259 | where module RA = RawApplicative A 260 | -------------------------------------------------------------------------------- /doc/TTT-2017.bib: -------------------------------------------------------------------------------- 1 | @inproceedings{claret2015mechanical, 2 | title={Mechanical verification of interactive programs specified by use cases}, 3 | author={Claret, Guillaume and R{\'e}gis-Gianas, Yann}, 4 | booktitle={Proceedings of the Third FME Workshop on Formal Methods in Software Engineering}, 5 | pages={61--67}, 6 | year={2015}, 7 | organization={IEEE Press} 8 | } 9 | @inproceedings{brady2014resource, 10 | title={Resource-dependent algebraic effects}, 11 | author={Brady, Edwin}, 12 | booktitle={International Symposium on Trends in Functional Programming}, 13 | pages={18--33}, 14 | year={2014}, 15 | organization={Springer} 16 | } 17 | @book{stump2016book, 18 | author = {Stump, Aaron}, 19 | title = {Verified Functional Programming in Agda}, 20 | year = {2016}, 21 | isbn = {978-1-97000-127-3}, 22 | publisher = {Association for Computing Machinery and Morgan \&\#38; Claypool}, 23 | address = {New York, NY, USA}, 24 | } 25 | @inproceedings{abelminiagda, 26 | author = {Andreas Abel}, 27 | title = {MiniAgda: Integrating Sized and Dependent Types}, 28 | booktitle = {Proceedings Workshop on Partiality and Recursion in ITP, {PAR}}, 29 | year = {2010}, 30 | } 31 | @article{claessen2011quickcheck, 32 | title={QuickCheck: a lightweight tool for random testing of Haskell programs}, 33 | author={Claessen, Koen and Hughes, John}, 34 | journal={Acm sigplan notices}, 35 | volume={46}, 36 | number={4}, 37 | pages={53--64}, 38 | year={2011}, 39 | publisher={ACM} 40 | } 41 | @inproceedings{abel2013copatterns, 42 | title={Copatterns: programming infinite structures by observations}, 43 | author={Abel, Andreas and Pientka, Brigitte and Thibodeau, David and Setzer, Anton}, 44 | booktitle={ACM SIGPLAN Notices}, 45 | volume={48}, 46 | number={1}, 47 | pages={27--38}, 48 | year={2013}, 49 | organization={ACM} 50 | } 51 | @inproceedings{tanter2015gradual, 52 | title={Gradual certified programming in coq}, 53 | author={Tanter, Eric and Tabareau, Nicolas}, 54 | booktitle={Proceedings of the 11th Symposium on Dynamic Languages}, 55 | pages={26--40}, 56 | year={2015}, 57 | organization={ACM} 58 | } 59 | @article{dybjer2000general, 60 | title={A general formulation of simultaneous inductive-recursive definitions in type theory}, 61 | author={Dybjer, Peter}, 62 | journal={The Journal of Symbolic Logic}, 63 | volume={65}, 64 | number={02}, 65 | pages={525--549}, 66 | year={2000}, 67 | publisher={Cambridge Univ Press} 68 | } 69 | @inproceedings{augustsson1998cayenne, 70 | title={Cayenne—a language with dependent types}, 71 | author={Augustsson, Lennart}, 72 | booktitle={International School on Advanced Functional Programming}, 73 | pages={240--267}, 74 | year={1998}, 75 | organization={Springer} 76 | } 77 | @article{coquand1991algorithm, 78 | title={An algorithm for testing conversion in type theory}, 79 | author={Coquand, Thierry}, 80 | journal={Logical Frameworks}, 81 | volume={1}, 82 | pages={255--279}, 83 | year={1991} 84 | } 85 | @article{martin1982constructive, 86 | title={Constructive mathematics and computer programming}, 87 | author={Martin-L{\"o}f, Per}, 88 | journal={Studies in Logic and the Foundations of Mathematics}, 89 | volume={104}, 90 | pages={153--175}, 91 | year={1982}, 92 | publisher={Elsevier} 93 | } 94 | @inproceedings{danielsson2010total, 95 | title={Total parser combinators}, 96 | author={Danielsson, Nils Anders}, 97 | booktitle={ACM Sigplan Notices}, 98 | volume={45}, 99 | number={9}, 100 | pages={285--296}, 101 | year={2010}, 102 | organization={ACM} 103 | } 104 | @inproceedings{mcbride2014keep, 105 | title={How to keep your neighbours in order}, 106 | author={McBride, Conor Thomas}, 107 | booktitle={ACM SIGPLAN Notices}, 108 | volume={49}, 109 | number={9}, 110 | pages={297--309}, 111 | year={2014}, 112 | organization={ACM} 113 | } 114 | @inproceedings{atkey2009syntax, 115 | title={Syntax for free: Representing syntax with binding using parametricity}, 116 | author={Atkey, Robert}, 117 | booktitle={TLCA}, 118 | pages={35--49}, 119 | year={2009}, 120 | organization={Springer} 121 | } 122 | @article{carette2009finally, 123 | title={Finally tagless, partially evaluated}, 124 | author={Carette, Jacques and Kiselyov, Oleg and Shan, Chung-chieh}, 125 | journal={JFP}, 126 | year={2009}, 127 | publisher={Citeseer} 128 | } 129 | @article{abel2014normalization, 130 | title={Normalization by evaluation in the delay monad}, 131 | author={Abel, Andreas and Chapman, James}, 132 | journal={MSFP 2014}, 133 | year={2014} 134 | } 135 | @incollection{hughes1995design, 136 | title={The design of a pretty-printing library}, 137 | author={Hughes, John}, 138 | booktitle={AFP Summer School}, 139 | pages={53--96}, 140 | year={1995}, 141 | publisher={Springer} 142 | } 143 | @phdthesis{chapman2009type, 144 | title={Type checking and normalisation}, 145 | author={Chapman, James Maitland}, 146 | year={2009}, 147 | school={University of Nottingham} 148 | } 149 | @article{girard1972interpretation, 150 | title={Interpr{\'e}tation fonctionelle et {\'e}limination des coupures de l’arithm{\'e}tique d’ordre sup{\'e}rieur}, 151 | author={Girard, Jean-Yves}, 152 | year={1972}, 153 | publisher={PhD thesis, Universit{\'e} Paris VII} 154 | } 155 | @article{wadler1990deforestation, 156 | title={Deforestation: Transforming programs to eliminate trees}, 157 | author={Wadler, Philip}, 158 | journal={TCS}, 159 | volume={73}, 160 | number={2}, 161 | pages={231--248}, 162 | year={1990}, 163 | publisher={Elsevier} 164 | } 165 | @article{wadler2003prettier, 166 | title={A prettier printer}, 167 | author={Wadler, Philip}, 168 | journal={The Fun of Programming, Cornerstones of Computing}, 169 | pages={223--243}, 170 | year={2003}, 171 | publisher={Citeseer} 172 | } 173 | @inproceedings{chlipala2008parametric, 174 | title={Parametric higher-order abstract syntax for mechanized semantics}, 175 | author={Chlipala, Adam}, 176 | booktitle={ACM Sigplan Notices}, 177 | volume={43}, 178 | number={9}, 179 | pages={143--156}, 180 | year={2008}, 181 | organization={ACM} 182 | } 183 | @misc{jeffrey2011assoc, 184 | title={Associativity for free!}, 185 | author={Jeffrey, Alan}, 186 | howpublished={\url{http://thread.gmane.org/gmane.comp.lang.agda/3259}}, 187 | year={2011}, 188 | publisher={Agda Mailing List} 189 | } 190 | @article{goguen1997candidates, 191 | title={Candidates for substitution}, 192 | author={Goguen, Healfdene and McKinna, James}, 193 | journal={LFCS, Edinburgh Techreport}, 194 | year={1997}, 195 | publisher={UNIVERSITY OF EDINBURGH} 196 | } 197 | @article{gill2014domain, 198 | title={Domain-specific languages and code synthesis using {H}askell}, 199 | author={Gill, Andy}, 200 | journal={Queue}, 201 | volume={12}, 202 | number={4}, 203 | pages={30}, 204 | year={2014}, 205 | publisher={ACM} 206 | } 207 | @incollection{svenningsson2013combining, 208 | title={Combining deep and shallow embedding for {EDSL}}, 209 | author={Svenningsson, Josef and Axelsson, Emil}, 210 | booktitle={TFP}, 211 | pages={21--36}, 212 | year={2013}, 213 | publisher={Springer} 214 | } 215 | @article{hudak1996building, 216 | title={Building domain-specific embedded languages}, 217 | author={Hudak, Paul}, 218 | journal={ACM Computing Surveys (CSUR)}, 219 | volume={28}, 220 | number={4es}, 221 | pages={196}, 222 | year={1996}, 223 | publisher={ACM} 224 | } 225 | @incollection{berger1993program, 226 | title={Program extraction from normalization proofs}, 227 | author={Berger, Ulrich}, 228 | booktitle={TLCA}, 229 | pages={91--106}, 230 | year={1993}, 231 | publisher={Springer} 232 | } 233 | @article{CoqDybSK, 234 | title={Intuitionistic model constructions and normalization proofs}, 235 | author={Coquand, Thierry and Dybjer, Peter}, 236 | journal={MSCS}, 237 | volume={7}, 238 | number={01}, 239 | pages={75--94}, 240 | year={1997}, 241 | publisher={Cambridge Univ. Press} 242 | } 243 | @Manual{Coq:manual, 244 | title = {The Coq proof assistant reference manual}, 245 | author = {\mbox{The Coq development team}}, 246 | note = {Version 8.0}, 247 | year = {2004}, 248 | url = "http://coq.inria.fr" 249 | } 250 | @article{lindley2014hasochism, 251 | title={Hasochism}, 252 | author={Lindley, Sam and McBride, Conor}, 253 | journal={SIGPLAN Notices}, 254 | volume={48}, 255 | number={12}, 256 | pages={81--92}, 257 | year={2014}, 258 | publisher={ACM} 259 | } 260 | @article{mcbride2004view, 261 | title={The view from the left}, 262 | author={McBride, Conor and McKinna, James}, 263 | journal={JFP}, 264 | volume={14}, 265 | number={01}, 266 | pages={69--111}, 267 | year={2004}, 268 | publisher={Cambridge Univ. Press} 269 | } 270 | @book{mitchell1996foundations, 271 | title={Foundations for programming languages}, 272 | author={Mitchell, John C}, 273 | volume={1}, 274 | year={1996}, 275 | publisher={MIT press} 276 | } 277 | @inproceedings{de1972lambda, 278 | title={Lambda {C}alculus Notation with Nameless Dummies}, 279 | author={de Bruijn, Nicolaas Govert}, 280 | booktitle={Indagationes Mathematicae}, 281 | volume={75}, 282 | number={5}, 283 | pages={381--392}, 284 | year={1972}, 285 | organization={Elsevier} 286 | } 287 | @inproceedings{altenkirch1995categorical, 288 | title={Categorical reconstruction of a reduction free normalization proof}, 289 | author={Altenkirch, Thorsten and Hofmann, Martin and Streicher, Thomas}, 290 | booktitle={LNCS}, 291 | pages={182--199}, 292 | year={1995}, 293 | volume={530}, 294 | organization={Springer} 295 | } 296 | @article{mitchell1991kripke, 297 | title={Kripke-style models for typed lambda calculus}, 298 | author={Mitchell, John C and Moggi, Eugenio}, 299 | journal={Annals of Pure and Applied Logic}, 300 | volume={51}, 301 | number={1}, 302 | pages={99--124}, 303 | year={1991}, 304 | publisher={Elsevier} 305 | } 306 | @inproceedings{altenkirch1999monadic, 307 | title={Monadic presentations of lambda terms using generalized inductive types}, 308 | author={Altenkirch, Thorsten and Reus, Bernhard}, 309 | booktitle={CSL}, 310 | pages={453--468}, 311 | year={1999}, 312 | organization={Springer} 313 | } 314 | @article{dybjer1991inductive, 315 | title={Inductive sets and families in {M}artin-{L}{\"o}f’s type theory and their set-theoretic semantics}, 316 | author={Dybjer, Peter}, 317 | journal={Logical Frameworks}, 318 | volume={2}, 319 | pages={6}, 320 | year={1991} 321 | } 322 | @article{eisenberg2013dependently, 323 | title={Dependently typed programming with singletons}, 324 | author={Eisenberg, Richard A and Weirich, Stephanie}, 325 | journal={SIGPLAN Notices}, 326 | volume={47}, 327 | number={12}, 328 | pages={117--130}, 329 | year={2013}, 330 | publisher={ACM} 331 | } 332 | @incollection{norell2009dependently, 333 | title={Dependently typed programming in {A}gda}, 334 | author={Norell, Ulf}, 335 | booktitle={AFP Summer School}, 336 | pages={230--266}, 337 | year={2009}, 338 | publisher={Springer} 339 | } 340 | @article{danvytagless, 341 | title={Tagless and Typeful Normalization by Evaluation using Generalized Algebraic Data Types}, 342 | author={Danvy, Olivier and Keller, Chantal and Puech, Matthias} 343 | } 344 | @article{reynolds1983types, 345 | title={Types, abstraction and parametric polymorphism}, 346 | author={Reynolds, John C}, 347 | year={1983} 348 | } 349 | @article{bernardy2013type, 350 | title={Type-theory in color}, 351 | author={Bernardy, Jean-Philippe and Moulin, Guilhem}, 352 | journal={SIGPLAN Notices}, 353 | volume={48}, 354 | number={9}, 355 | pages={61--72}, 356 | year={2013}, 357 | publisher={ACM} 358 | } 359 | @article{wiedijk2012pollack, 360 | title={Pollack-inconsistency}, 361 | author={Wiedijk, Freek}, 362 | journal={ENTCS}, 363 | volume={285}, 364 | pages={85--100}, 365 | year={2012}, 366 | publisher={Elsevier} 367 | } 368 | @incollection{danvy1999type, 369 | title={Type-directed partial evaluation}, 370 | author={Danvy, Olivier}, 371 | booktitle={Partial Evaluation}, 372 | pages={367--411}, 373 | year={1999}, 374 | publisher={Springer} 375 | } 376 | @inproceedings{berger1991inverse, 377 | title={An inverse of the evaluation functional for typed $\lambda$-calculus}, 378 | author={Berger, Ulrich and Schwichtenberg, Helmut}, 379 | booktitle={LICS}, 380 | pages={203--211}, 381 | year={1991}, 382 | organization={IEEE} 383 | } 384 | @article{coquand2002formalised, 385 | title={A formalised proof of the soundness and completeness of a simply typed lambda-calculus with explicit substitutions}, 386 | author={Coquand, Catarina}, 387 | journal={Higher-Order and Symbolic Computation}, 388 | volume={15}, 389 | number={1}, 390 | pages={57--90}, 391 | year={2002}, 392 | publisher={Springer} 393 | } 394 | @article{benton2012strongly, 395 | title={Strongly typed term representations in Coq}, 396 | author={Benton, Nick and Hur, Chung-Kil and Kennedy, Andrew J and McBride, Conor}, 397 | journal={JAR}, 398 | volume={49}, 399 | number={2}, 400 | pages={141--159}, 401 | year={2012}, 402 | publisher={Springer} 403 | } 404 | @article{mcbride2005type, 405 | title={Type-preserving renaming and substitution}, 406 | author={McBride, Conor}, 407 | year={2005}, 408 | publisher={Citeseer} 409 | } 410 | @incollection{garillot2009packaging, 411 | title={Packaging mathematical structures}, 412 | author={Garillot, Fran{\c{c}}ois and Gonthier, Georges and Mahboubi, Assia and Rideau, Laurence}, 413 | booktitle={TPHOLs}, 414 | pages={327--342}, 415 | year={2009}, 416 | publisher={Springer} 417 | } 418 | @incollection{danielsson2011parsing, 419 | title={Parsing mixfix operators}, 420 | author={Danielsson, Nils Anders and Norell, Ulf}, 421 | booktitle={IFL}, 422 | pages={80--99}, 423 | year={2011}, 424 | publisher={Springer} 425 | } 426 | @article{moggi1991notions, 427 | title={Notions of computation and monads}, 428 | author={Moggi, Eugenio}, 429 | journal={Information and Computation}, 430 | volume={93}, 431 | number={1}, 432 | pages={55--92}, 433 | year={1991}, 434 | publisher={Elsevier} 435 | } 436 | -------------------------------------------------------------------------------- /doc/agda.sty: -------------------------------------------------------------------------------- 1 | % ---------------------------------------------------------------------- 2 | % Some useful commands when doing highlighting of Agda code in LaTeX. 3 | % ---------------------------------------------------------------------- 4 | 5 | \ProvidesPackage{agda} 6 | 7 | \RequirePackage{ifxetex, ifluatex, xifthen, xcolor, polytable, etoolbox} 8 | 9 | % https://tex.stackexchange.com/questions/47576/combining-ifxetex-and-ifluatex-with-the-logical-or-operation 10 | \newif\ifxetexorluatex 11 | \ifxetex 12 | \xetexorluatextrue 13 | \else 14 | \ifluatex 15 | \xetexorluatextrue 16 | \else 17 | \xetexorluatexfalse 18 | \fi 19 | \fi 20 | 21 | % XeLaTeX or LuaLaTeX 22 | \ifxetexorluatex 23 | 24 | % Hack to get the amsthm package working. 25 | % https://tex.stackexchange.com/questions/130491/xelatex-error-paragraph-ended-before-tempa-was-complete 26 | \let\AgdaOpenBracket\[\let\AgdaCloseBracket\] 27 | \RequirePackage{fontspec} 28 | \let\[\AgdaOpenBracket\let\]\AgdaCloseBracket 29 | \RequirePackage{unicode-math} 30 | 31 | \tracinglostchars=2 % If the font is missing some symbol, then say 32 | % so in the compilation output. 33 | \setmainfont 34 | [ Ligatures = TeX 35 | , BoldItalicFont = xits-bolditalic.otf 36 | , BoldFont = xits-bold.otf 37 | , ItalicFont = xits-italic.otf 38 | ] 39 | {xits-regular.otf} 40 | 41 | \setsansfont[Scale=MatchLowercase]{DejaVuSansMono.ttf} 42 | \setmathfont{xits-math.otf} 43 | \setmonofont[Mapping=tex-text, Scale=MatchLowercase]{DroidSansMono.ttf} 44 | 45 | % Make mathcal and mathscr appear as different. 46 | % https://tex.stackexchange.com/questions/120065/xetex-what-happened-to-mathcal-and-mathscr 47 | \setmathfont[range={\mathcal,\mathbfcal},StylisticSet=1]{xits-math.otf} 48 | \setmathfont[range=\mathscr]{xits-math.otf} 49 | \providecommand{\DeclareUnicodeCharacter}[2]{\relax} 50 | 51 | % pdfLaTeX 52 | \else 53 | \RequirePackage{ucs, amsfonts, amssymb} 54 | \RequirePackage[safe]{tipa} % See page 12 of the tipa manual for what 55 | % safe does. 56 | 57 | % https://tex.stackexchange.com/questions/1774/how-to-insert-pipe-symbol-in-latex 58 | \RequirePackage[T1]{fontenc} 59 | \RequirePackage[utf8x]{inputenc} 60 | \fi 61 | 62 | % ---------------------------------------------------------------------- 63 | % Options 64 | 65 | \DeclareOption{bw} {\newcommand{\AgdaColourScheme}{bw}} 66 | \DeclareOption{conor}{\newcommand{\AgdaColourScheme}{conor}} 67 | 68 | \newif\if@AgdaEnableReferences\@AgdaEnableReferencesfalse 69 | \DeclareOption{references}{ 70 | \@AgdaEnableReferencestrue 71 | } 72 | 73 | \newif\if@AgdaEnableLinks\@AgdaEnableLinksfalse 74 | \DeclareOption{links}{ 75 | \@AgdaEnableLinkstrue 76 | } 77 | 78 | \ProcessOptions\relax 79 | 80 | % ---------------------------------------------------------------------- 81 | % Colour schemes. 82 | 83 | \providecommand{\AgdaColourScheme}{standard} 84 | 85 | % ---------------------------------------------------------------------- 86 | % References to code (needs additional post-processing of tex files to 87 | % work, see wiki for details). 88 | 89 | \if@AgdaEnableReferences 90 | \RequirePackage{catchfilebetweentags, xstring} 91 | \newcommand{\AgdaRef}[2][]{% 92 | \StrSubstitute{#2}{\_}{AgdaUnderscore}[\tmp]% 93 | \ifthenelse{\isempty{#1}}% 94 | {\ExecuteMetaData{AgdaTag-\tmp}}% 95 | {\ExecuteMetaData{#1}{AgdaTag-\tmp}} 96 | } 97 | \fi 98 | 99 | \providecommand{\AgdaRef}[2][]{#2} 100 | 101 | % ---------------------------------------------------------------------- 102 | % Links (only done if the option is passed and the user has loaded the 103 | % hyperref package). 104 | 105 | \if@AgdaEnableLinks 106 | \@ifpackageloaded{hyperref}{ 107 | 108 | % List that holds added targets. 109 | \newcommand{\AgdaList}[0]{} 110 | 111 | \newtoggle{AgdaIsElem} 112 | \newcounter{AgdaIndex} 113 | \newcommand{\AgdaLookup}[3]{% 114 | \togglefalse{AgdaIsElem}% 115 | \setcounter{AgdaIndex}{0}% 116 | \renewcommand*{\do}[1]{% 117 | \ifstrequal{#1}{##1}% 118 | {\toggletrue{AgdaIsElem}\listbreak}% 119 | {\stepcounter{AgdaIndex}}}% 120 | \dolistloop{\AgdaList}% 121 | \iftoggle{AgdaIsElem}{#2}{#3}% 122 | } 123 | 124 | \newcommand*{\AgdaTargetHelper}[1]{% 125 | \AgdaLookup{#1}% 126 | {\PackageError{agda}{``#1'' used as target more than once}% 127 | {Overloaded identifiers and links do not% 128 | work well, consider using unique% 129 | \MessageBreak identifiers instead.}% 130 | }% 131 | {\listadd{\AgdaList}{#1}% 132 | \hypertarget{Agda\theAgdaIndex}{}% 133 | }% 134 | } 135 | 136 | \newcommand{\AgdaTarget}[1]{\forcsvlist{\AgdaTargetHelper}{#1}} 137 | 138 | \newcommand{\AgdaLink}[1]{% 139 | \AgdaLookup{#1}% 140 | {\hyperlink{Agda\theAgdaIndex}{#1}}% 141 | {#1}% 142 | } 143 | }{\PackageError{agda}{Load the hyperref package before the agda package}{}} 144 | \fi 145 | 146 | \providecommand{\AgdaTarget}[1]{} 147 | \providecommand{\AgdaLink}[1]{#1} 148 | 149 | % ---------------------------------------------------------------------- 150 | % Font styles. 151 | 152 | \ifxetexorluatex 153 | \newcommand{\AgdaFontStyle}[1]{\ensuremath{\mathsf{#1}}} 154 | \ifthenelse{\equal{\AgdaColourScheme}{bw}}{ 155 | \newcommand{\AgdaKeywordFontStyle}[1]{\underline{#1}} 156 | }{ 157 | \newcommand{\AgdaKeywordFontStyle}[1]{\ensuremath{\mathsf{#1}}} 158 | } 159 | \newcommand{\AgdaStringFontStyle}[1]{\ensuremath{\texttt{#1}}} 160 | \newcommand{\AgdaCommentFontStyle}[1]{\ensuremath{\texttt{#1}}} 161 | \newcommand{\AgdaBoundFontStyle}[1]{\ensuremath{\mathit{#1}}} 162 | 163 | \else 164 | \newcommand{\AgdaFontStyle}[1]{\textsf{#1}} 165 | \ifthenelse{\equal{\AgdaColourScheme}{bw}}{ 166 | \newcommand{\AgdaKeywordFontStyle}[1]{\underline{#1}} 167 | }{ 168 | \newcommand{\AgdaKeywordFontStyle}[1]{\textsf{#1}} 169 | } 170 | \newcommand{\AgdaStringFontStyle}[1]{\texttt{#1}} 171 | \newcommand{\AgdaCommentFontStyle}[1]{\texttt{#1}} 172 | \newcommand{\AgdaBoundFontStyle}[1]{\textit{#1}} 173 | \fi 174 | 175 | % ---------------------------------------------------------------------- 176 | % Colours. 177 | 178 | % ---------------------------------- 179 | % The black and white colour scheme. 180 | \ifthenelse{\equal{\AgdaColourScheme}{bw}}{ 181 | 182 | % Aspect colours. 183 | \definecolor{AgdaComment} {HTML}{000000} 184 | \definecolor{AgdaKeyword} {HTML}{000000} 185 | \definecolor{AgdaString} {HTML}{000000} 186 | \definecolor{AgdaNumber} {HTML}{000000} 187 | \definecolor{AgdaSymbol} {HTML}{000000} 188 | \definecolor{AgdaPrimitiveType}{HTML}{000000} 189 | \definecolor{AgdaOperator} {HTML}{000000} 190 | 191 | % NameKind colours. 192 | \definecolor{AgdaBound} {HTML}{000000} 193 | \definecolor{AgdaInductiveConstructor} {HTML}{000000} 194 | \definecolor{AgdaCoinductiveConstructor}{HTML}{000000} 195 | \definecolor{AgdaDatatype} {HTML}{000000} 196 | \definecolor{AgdaField} {HTML}{000000} 197 | \definecolor{AgdaFunction} {HTML}{000000} 198 | \definecolor{AgdaModule} {HTML}{000000} 199 | \definecolor{AgdaPostulate} {HTML}{000000} 200 | \definecolor{AgdaPrimitive} {HTML}{000000} 201 | \definecolor{AgdaRecord} {HTML}{000000} 202 | \definecolor{AgdaArgument} {HTML}{000000} 203 | 204 | % Other aspect colours. 205 | \definecolor{AgdaDottedPattern} {HTML}{000000} 206 | \definecolor{AgdaUnsolvedMeta} {HTML}{D3D3D3} 207 | \definecolor{AgdaTerminationProblem}{HTML}{BEBEBE} 208 | \definecolor{AgdaIncompletePattern} {HTML}{D3D3D3} 209 | \definecolor{AgdaError} {HTML}{696969} 210 | 211 | % Misc. 212 | \definecolor{AgdaHole} {HTML}{BEBEBE} 213 | 214 | % ---------------------------------- 215 | % Conor McBride's colour scheme. 216 | }{ \ifthenelse{\equal{\AgdaColourScheme}{conor}}{ 217 | 218 | % Aspect colours. 219 | \definecolor{AgdaComment} {HTML}{B22222} 220 | \definecolor{AgdaKeyword} {HTML}{000000} 221 | \definecolor{AgdaString} {HTML}{000000} 222 | \definecolor{AgdaNumber} {HTML}{000000} 223 | \definecolor{AgdaSymbol} {HTML}{000000} 224 | \definecolor{AgdaPrimitiveType}{HTML}{0000CD} 225 | \definecolor{AgdaOperator} {HTML}{000000} 226 | 227 | % NameKind colours. 228 | \definecolor{AgdaBound} {HTML}{A020F0} 229 | \definecolor{AgdaInductiveConstructor} {HTML}{8B0000} 230 | \definecolor{AgdaCoinductiveConstructor}{HTML}{8B0000} 231 | \definecolor{AgdaDatatype} {HTML}{0000CD} 232 | \definecolor{AgdaField} {HTML}{8B0000} 233 | \definecolor{AgdaFunction} {HTML}{006400} 234 | \definecolor{AgdaMacro} {HTML}{006400} 235 | \definecolor{AgdaModule} {HTML}{006400} 236 | \definecolor{AgdaPostulate} {HTML}{006400} 237 | \definecolor{AgdaPrimitive} {HTML}{006400} 238 | \definecolor{AgdaRecord} {HTML}{0000CD} 239 | \definecolor{AgdaArgument} {HTML}{404040} 240 | 241 | % Other aspect colours. 242 | \definecolor{AgdaDottedPattern} {HTML}{000000} 243 | \definecolor{AgdaUnsolvedMeta} {HTML}{FFD700} 244 | \definecolor{AgdaTerminationProblem}{HTML}{FF0000} 245 | \definecolor{AgdaIncompletePattern} {HTML}{A020F0} 246 | \definecolor{AgdaError} {HTML}{F4A460} 247 | 248 | % Misc. 249 | \definecolor{AgdaHole} {HTML}{9DFF9D} 250 | 251 | % ---------------------------------- 252 | % The standard colour scheme. 253 | }{ 254 | % Aspect colours. 255 | \definecolor{AgdaComment} {HTML}{B22222} 256 | \definecolor{AgdaKeyword} {HTML}{CD6600} 257 | \definecolor{AgdaString} {HTML}{B22222} 258 | \definecolor{AgdaNumber} {HTML}{A020F0} 259 | \definecolor{AgdaSymbol} {HTML}{404040} 260 | \definecolor{AgdaPrimitiveType}{HTML}{0000CD} 261 | \definecolor{AgdaOperator} {HTML}{000000} 262 | 263 | % NameKind colours. 264 | \definecolor{AgdaBound} {HTML}{000000} 265 | \definecolor{AgdaInductiveConstructor} {HTML}{008B00} 266 | \definecolor{AgdaCoinductiveConstructor}{HTML}{8B7500} 267 | \definecolor{AgdaDatatype} {HTML}{0000CD} 268 | \definecolor{AgdaField} {HTML}{EE1289} 269 | \definecolor{AgdaFunction} {HTML}{0000CD} 270 | \definecolor{AgdaMacro} {HTML}{458B74} 271 | \definecolor{AgdaModule} {HTML}{A020F0} 272 | \definecolor{AgdaPostulate} {HTML}{0000CD} 273 | \definecolor{AgdaPrimitive} {HTML}{0000CD} 274 | \definecolor{AgdaRecord} {HTML}{0000CD} 275 | \definecolor{AgdaArgument} {HTML}{404040} 276 | 277 | % Other aspect colours. 278 | \definecolor{AgdaDottedPattern} {HTML}{000000} 279 | \definecolor{AgdaUnsolvedMeta} {HTML}{FFFF00} 280 | \definecolor{AgdaTerminationProblem}{HTML}{FFA07A} 281 | \definecolor{AgdaIncompletePattern} {HTML}{F5DEB3} 282 | \definecolor{AgdaError} {HTML}{FF0000} 283 | 284 | % Misc. 285 | \definecolor{AgdaHole} {HTML}{9DFF9D} 286 | }} 287 | 288 | % ---------------------------------------------------------------------- 289 | % Commands. 290 | 291 | % Aspect commands. 292 | \newcommand{\AgdaComment} [1] 293 | {\AgdaCommentFontStyle{\textcolor{AgdaComment}{#1}}} 294 | \newcommand{\AgdaKeyword} [1] 295 | {\AgdaKeywordFontStyle{\textcolor{AgdaKeyword}{#1}}} 296 | \newcommand{\AgdaString} [1]{\AgdaStringFontStyle{\textcolor{AgdaString}{#1}}} 297 | \newcommand{\AgdaNumber} [1]{\AgdaFontStyle{\textcolor{AgdaNumber}{#1}}} 298 | \newcommand{\AgdaSymbol} [1]{\AgdaFontStyle{\textcolor{AgdaSymbol}{#1}}} 299 | \newcommand{\AgdaPrimitiveType}[1] 300 | {\AgdaFontStyle{\textcolor{AgdaPrimitiveType}{#1}}} 301 | \newcommand{\AgdaOperator} [1]{\AgdaFontStyle{\textcolor{AgdaOperator}{#1}}} 302 | 303 | % NameKind commands. 304 | \newcommand{\AgdaNoSpaceMath}[1] 305 | {\begingroup\thickmuskip=0mu\medmuskip=0mu#1\endgroup} 306 | 307 | \newcommand{\AgdaBound}[1] 308 | {\AgdaNoSpaceMath{\AgdaBoundFontStyle{\textcolor{AgdaBound}{#1}}}} 309 | \newcommand{\AgdaInductiveConstructor}[1] 310 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaInductiveConstructor}{\AgdaLink{#1}}}}} 311 | \newcommand{\AgdaCoinductiveConstructor}[1] 312 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaCoinductiveConstructor}{\AgdaLink{#1}}}}} 313 | \newcommand{\AgdaDatatype}[1] 314 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaDatatype}{\AgdaLink{#1}}}}} 315 | \newcommand{\AgdaField}[1] 316 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaField}{\AgdaLink{#1}}}}} 317 | \newcommand{\AgdaFunction}[1] 318 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaFunction}{\AgdaLink{#1}}}}} 319 | \newcommand{\AgdaMacro}[1] 320 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaMacro}{\AgdaLink{#1}}}}} 321 | \newcommand{\AgdaModule}[1] 322 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaModule}{\AgdaLink{#1}}}}} 323 | \newcommand{\AgdaPostulate}[1] 324 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaPostulate}{\AgdaLink{#1}}}}} 325 | \newcommand{\AgdaPrimitive}[1] 326 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaPrimitive}{#1}}}} 327 | \newcommand{\AgdaRecord}[1] 328 | {\AgdaNoSpaceMath{\AgdaFontStyle{\textcolor{AgdaRecord}{\AgdaLink{#1}}}}} 329 | \newcommand{\AgdaArgument}[1] 330 | {\AgdaNoSpaceMath{\AgdaBoundFontStyle{\textcolor{AgdaArgument}{#1}}}} 331 | 332 | % Other aspect commands. 333 | \newcommand{\AgdaFixityOp} [1]{\AgdaNoSpaceMath{$#1$}} 334 | \newcommand{\AgdaDottedPattern} [1]{\textcolor{AgdaDottedPattern}{#1}} 335 | \newcommand{\AgdaUnsolvedMeta} [1] 336 | {\AgdaFontStyle{\colorbox{AgdaUnsolvedMeta}{#1}}} 337 | \newcommand{\AgdaTerminationProblem}[1] 338 | {\AgdaFontStyle{\colorbox{AgdaTerminationProblem}{#1}}} 339 | \newcommand{\AgdaIncompletePattern} [1]{\colorbox{AgdaIncompletePattern}{#1}} 340 | \newcommand{\AgdaError} [1] 341 | {\AgdaFontStyle{\textcolor{AgdaError}{\underline{#1}}}} 342 | 343 | % Misc. 344 | \newcommand{\AgdaHole}[1]{\colorbox{AgdaHole}{#1}} 345 | \long\def\AgdaHide#1{} % Used to hide code from LaTeX. 346 | 347 | \newcommand{\AgdaIndent}[1]{$\;\;$} 348 | 349 | % ---------------------------------------------------------------------- 350 | % The code environment. 351 | 352 | \newcommand{\AgdaCodeStyle}{} 353 | % \newcommand{\AgdaCodeStyle}{\tiny} 354 | 355 | \ifdefined\mathindent 356 | {} 357 | \else 358 | \newdimen\mathindent\mathindent\leftmargini 359 | \fi 360 | 361 | \newenvironment{code}% 362 | {\noindent\ignorespaces\advance\leftskip\mathindent\AgdaCodeStyle\pboxed}% 363 | {\endpboxed\par\noindent% 364 | \ignorespacesafterend} 365 | 366 | % Default column for polytable. 367 | \defaultcolumn{@{~}l@{~}} 368 | 369 | \endinput 370 | -------------------------------------------------------------------------------- /doc/WordCount.tex: -------------------------------------------------------------------------------- 1 | \begin{code}% 2 | \>\AgdaKeyword{module} \AgdaModule{agdARGS.Examples.Doc.WordCount} \AgdaKeyword{where}\<% 3 | \\ 4 | % 5 | \\ 6 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Level}\<% 7 | \\ 8 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Coinduction}\<% 9 | \\ 10 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{IO}\<% 11 | \\ 12 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{IO.Primitive} \AgdaKeyword{using} \AgdaSymbol{()} \AgdaKeyword{renaming} \AgdaSymbol{(}\AgdaPostulate{IO} \AgdaSymbol{to} \AgdaPostulate{PrimIO}\AgdaSymbol{)}\<% 13 | \\ 14 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Unit}\<% 15 | \\ 16 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Bool}\<% 17 | \\ 18 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Nat} \AgdaSymbol{as} \AgdaModule{Nat} \AgdaKeyword{hiding} \AgdaSymbol{(}\AgdaInductiveConstructor{zero}\AgdaSymbol{)}\<% 19 | \\ 20 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Nat.Show} \AgdaSymbol{as} \AgdaModule{NatShow}\<% 21 | \\ 22 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Product}\<% 23 | \\ 24 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Sum}\<% 25 | \\ 26 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Maybe}\<% 27 | \\ 28 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.String} \AgdaSymbol{as} \AgdaModule{String}\<% 29 | \\ 30 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Vec} \AgdaSymbol{as} \AgdaModule{Vec} \AgdaKeyword{hiding} \AgdaSymbol{(}\AgdaFunction{\_>>=\_}\AgdaSymbol{)}\<% 31 | \\ 32 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.List} \AgdaSymbol{as} \AgdaModule{List}\<% 33 | \\ 34 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Data.Char}\<% 35 | \\ 36 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{Function}\<% 37 | \\ 38 | \>\AgdaKeyword{import} \AgdaModule{agdARGS.Data.String} \AgdaSymbol{as} \AgdaModule{Str}\<% 39 | \\ 40 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Error} \AgdaKeyword{using} \AgdaSymbol{(}\AgdaFunction{Error}\AgdaSymbol{)}\<% 41 | \\ 42 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Table} \AgdaSymbol{as} \AgdaModule{Table}\<% 43 | \\ 44 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Environment.Arguments}\<% 45 | \\ 46 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.CLI}\<% 47 | \\ 48 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.CLI.Parser}\<% 49 | \\ 50 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.CLI.Usual} \AgdaKeyword{hiding} \AgdaSymbol{(}\AgdaFunction{withCLI}\AgdaSymbol{)}\<% 51 | \\ 52 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.Modifiers}\<% 53 | \\ 54 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.System.Console.Options.Usual}\<% 55 | \\ 56 | % 57 | \\ 58 | \>\AgdaKeyword{open} \AgdaKeyword{import} \AgdaModule{agdARGS.Data.Record.Usual} \AgdaSymbol{as} \AgdaModule{RU} \AgdaKeyword{hiding} \AgdaSymbol{(}\AgdaFunction{\_∷=\_⟨\_}\AgdaSymbol{)}\<% 59 | \\ 60 | % 61 | \\ 62 | % 63 | \\ 64 | % 65 | \\ 66 | \>\AgdaFunction{ParsedCLI} \AgdaSymbol{:} \AgdaRecord{CLI} \AgdaPrimitive{zero} \AgdaSymbol{→} \AgdaPrimitiveType{Set₁}\<% 67 | \\ 68 | \>\AgdaFunction{ParsedCLI} \AgdaSymbol{=} \AgdaFunction{ParsedInterface}\<% 69 | \\ 70 | % 71 | \\ 72 | \>\<% 73 | \end{code} 74 | %<*withCLI> 75 | \begin{code}% 76 | \>\AgdaFunction{withCLI} \AgdaSymbol{:} \AgdaSymbol{∀} \AgdaBound{c} \AgdaSymbol{(}\AgdaBound{k} \AgdaSymbol{:} \AgdaFunction{ParsedCLI} \AgdaBound{c} \AgdaSymbol{→} \AgdaDatatype{IO} \AgdaRecord{⊤}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaDatatype{IO} \AgdaRecord{⊤}\<% 77 | \end{code} 78 | % 79 | \begin{code}% 80 | \>\AgdaFunction{withCLI} \AgdaBound{c} \AgdaBound{k} \AgdaSymbol{=} \AgdaCoinductiveConstructor{♯} \AgdaFunction{getArgs} \AgdaInductiveConstructor{IO.>>=} \AgdaSymbol{λ} \AgdaBound{args} \AgdaSymbol{→} \AgdaCoinductiveConstructor{♯} \AgdaFunction{[} \AgdaFunction{error} \AgdaFunction{,} \AgdaBound{k} \AgdaFunction{]′} \AgdaSymbol{(}\AgdaFunction{parseInterface} \AgdaBound{c} \AgdaBound{args}\AgdaSymbol{)}\<% 81 | \\ 82 | % 83 | \\ 84 | \>\AgdaFunction{WordCount} \AgdaSymbol{:} \AgdaRecord{Command} \AgdaSymbol{\_} \AgdaString{"WordCount"}\<% 85 | \end{code} 86 | 87 | %<*wordcount> 88 | \begin{code}% 89 | \>\AgdaFunction{WordCount} \AgdaSymbol{=} \AgdaKeyword{record}\<% 90 | \\ 91 | \> \AgdaSymbol{\{} \AgdaField{description} \<[16]% 92 | \>[16]\AgdaSymbol{=} \<[19]% 93 | \>[19]\AgdaString{"Print each file's counts"}\<% 94 | \\ 95 | \> \AgdaSymbol{;} \AgdaField{subcommands} \<[16]% 96 | \>[16]\AgdaSymbol{=} \<[19]% 97 | \>[19]\AgdaFunction{noSubCommands}\<% 98 | \\ 99 | \> \AgdaSymbol{;} \AgdaField{arguments} \<[16]% 100 | \>[16]\AgdaSymbol{=} \<[19]% 101 | \>[19]\AgdaFunction{lotsOf} \AgdaFunction{filePath} \<[35]% 102 | \>[35]\<% 103 | \\ 104 | \> \AgdaSymbol{;} \AgdaField{modifiers} \<[16]% 105 | \>[16]\AgdaSymbol{=}\<% 106 | \\ 107 | \>[0]\AgdaIndent{2}{}\<[2]% 108 | \>[2]\AgdaFunction{,} \AgdaString{"-l"} \<[17]% 109 | \>[17]\AgdaFunction{∷=} \AgdaFunction{flag} \AgdaString{"Newline count"}\<% 110 | \\ 111 | \>[0]\AgdaIndent{2}{}\<[2]% 112 | \>[2]\AgdaFunction{⟨} \AgdaString{"-w"} \<[17]% 113 | \>[17]\AgdaFunction{∷=} \AgdaFunction{flag} \AgdaString{"Word count"}\<% 114 | \\ 115 | \>[0]\AgdaIndent{2}{}\<[2]% 116 | \>[2]\AgdaFunction{⟨} \AgdaString{"--help"} \<[17]% 117 | \>[17]\AgdaFunction{∷=} \AgdaFunction{flag} \AgdaString{"Display help"}\<% 118 | \\ 119 | \>[0]\AgdaIndent{2}{}\<[2]% 120 | \>[2]\AgdaFunction{⟨} \AgdaString{"--version"} \<[17]% 121 | \>[17]\AgdaFunction{∷=} \AgdaFunction{flag} \AgdaString{"Version number"} \AgdaFunction{⟨} \AgdaFunction{⟨⟩} \AgdaSymbol{\}}\<% 122 | \end{code} 123 | % 124 | 125 | 126 | \begin{code}% 127 | \>\AgdaFunction{cli} \AgdaSymbol{:} \AgdaRecord{CLI} \AgdaPrimitive{Level.zero}\<% 128 | \\ 129 | \>\AgdaFunction{cli} \AgdaSymbol{=} \AgdaKeyword{record}\<% 130 | \\ 131 | \>[0]\AgdaIndent{2}{}\<[2]% 132 | \>[2]\AgdaSymbol{\{} \AgdaField{name} \AgdaSymbol{=} \AgdaString{"WordCount"}\<% 133 | \\ 134 | \>[0]\AgdaIndent{2}{}\<[2]% 135 | \>[2]\AgdaSymbol{;} \AgdaField{exec} \AgdaSymbol{=} \AgdaFunction{WordCount} \AgdaSymbol{\}}\<% 136 | \\ 137 | % 138 | \\ 139 | \>\AgdaKeyword{record} \AgdaRecord{count} \AgdaSymbol{:} \AgdaPrimitiveType{Set} \AgdaKeyword{where}\<% 140 | \\ 141 | \>[0]\AgdaIndent{2}{}\<[2]% 142 | \>[2]\AgdaKeyword{field}\<% 143 | \\ 144 | \>[2]\AgdaIndent{4}{}\<[4]% 145 | \>[4]\AgdaField{nb-words} \AgdaSymbol{:} \AgdaDatatype{ℕ}\<% 146 | \\ 147 | \>[2]\AgdaIndent{4}{}\<[4]% 148 | \>[4]\AgdaField{nb-lines} \AgdaSymbol{:} \AgdaDatatype{ℕ}\<% 149 | \\ 150 | \>\AgdaKeyword{open} \AgdaModule{count}\<% 151 | \\ 152 | % 153 | \\ 154 | \>\AgdaFunction{count0} \AgdaSymbol{:} \AgdaRecord{count}\<% 155 | \\ 156 | \>\AgdaField{nb-words} \AgdaFunction{count0} \AgdaSymbol{=} \AgdaNumber{0}\<% 157 | \\ 158 | \>\AgdaField{nb-lines} \AgdaFunction{count0} \AgdaSymbol{=} \AgdaNumber{0}\<% 159 | \\ 160 | % 161 | \\ 162 | \>\AgdaFunction{\_∙\_} \AgdaSymbol{:} \AgdaRecord{count} \AgdaSymbol{→} \AgdaRecord{count} \AgdaSymbol{→} \AgdaRecord{count}\<% 163 | \\ 164 | \>\AgdaField{nb-words} \AgdaSymbol{(}\AgdaBound{c} \AgdaFunction{∙} \AgdaBound{d}\AgdaSymbol{)} \AgdaSymbol{=} \AgdaSymbol{(}\AgdaPrimitive{\_+\_} \AgdaFunction{on} \AgdaField{nb-words}\AgdaSymbol{)} \AgdaBound{c} \AgdaBound{d}\<% 165 | \\ 166 | \>\AgdaField{nb-lines} \AgdaSymbol{(}\AgdaBound{c} \AgdaFunction{∙} \AgdaBound{d}\AgdaSymbol{)} \AgdaSymbol{=} \AgdaSymbol{(}\AgdaPrimitive{\_+\_} \AgdaFunction{on} \AgdaField{nb-lines}\AgdaSymbol{)} \AgdaBound{c} \AgdaBound{d}\<% 167 | \\ 168 | % 169 | \\ 170 | % 171 | \\ 172 | \>\AgdaFunction{showCounts} \AgdaSymbol{:} \AgdaFunction{ParsedModifiers} \AgdaSymbol{(}\AgdaField{proj₂} \AgdaSymbol{(}\AgdaField{modifiers} \AgdaFunction{WordCount}\AgdaSymbol{))} \AgdaSymbol{→}\<% 173 | \\ 174 | \>[4]\AgdaIndent{13}{}\<[13]% 175 | \>[13]\AgdaDatatype{List} \AgdaSymbol{(}\AgdaFunction{FilePath} \AgdaFunction{×} \AgdaRecord{count}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaPostulate{String}\<% 176 | \\ 177 | \>\AgdaFunction{showCounts} \AgdaBound{mods} \AgdaBound{xs} \AgdaSymbol{=}\<% 178 | \\ 179 | \>[0]\AgdaIndent{2}{}\<[2]% 180 | \>[2]\AgdaComment{-- Lines (resp. Words) are counted if the -l (resp. -w) flag is set}\<% 181 | \\ 182 | \>[0]\AgdaIndent{2}{}\<[2]% 183 | \>[2]\AgdaComment{-- or none at all are set.}\<% 184 | \\ 185 | \>[0]\AgdaIndent{2}{}\<[2]% 186 | \>[2]\AgdaKeyword{let} \AgdaBound{keepLines} \AgdaSymbol{=} \AgdaField{lower} \AgdaSymbol{(}\AgdaBound{mods} \AgdaFunction{‼} \AgdaString{"-l"}\AgdaSymbol{)} \AgdaFunction{∨} \AgdaFunction{not} \AgdaSymbol{(}\AgdaField{lower} \AgdaSymbol{(}\AgdaBound{mods} \AgdaFunction{‼} \AgdaString{"-w"}\AgdaSymbol{))}\<% 187 | \\ 188 | \>[2]\AgdaIndent{6}{}\<[6]% 189 | \>[6]\AgdaBound{keepWords} \AgdaSymbol{=} \AgdaField{lower} \AgdaSymbol{(}\AgdaBound{mods} \AgdaFunction{‼} \AgdaString{"-w"}\AgdaSymbol{)} \AgdaFunction{∨} \AgdaFunction{not} \AgdaSymbol{(}\AgdaField{lower} \AgdaSymbol{(}\AgdaBound{mods} \AgdaFunction{‼} \AgdaString{"-l"}\AgdaSymbol{))}\<% 190 | \\ 191 | \>[2]\AgdaIndent{6}{}\<[6]% 192 | \>[6]\AgdaBound{total} \<[16]% 193 | \>[16]\AgdaSymbol{=} \AgdaFunction{List.foldr} \AgdaSymbol{(}\AgdaFunction{\_∙\_} \AgdaFunction{∘} \AgdaField{proj₂}\AgdaSymbol{)} \AgdaFunction{count0} \AgdaBound{xs}\<% 194 | \\ 195 | \>[2]\AgdaIndent{6}{}\<[6]% 196 | \>[6]\AgdaBound{xs} \<[16]% 197 | \>[16]\AgdaSymbol{=} \AgdaBound{xs} \AgdaFunction{List.∷ʳ} \AgdaSymbol{(}\AgdaString{"Total"} \AgdaInductiveConstructor{,} \AgdaBound{total}\AgdaSymbol{)}\<% 198 | \\ 199 | \>[0]\AgdaIndent{2}{}\<[2]% 200 | \>[2]\AgdaKeyword{in} \AgdaFunction{Table.show} \AgdaFunction{\$} \AgdaFunction{showCol} \AgdaInductiveConstructor{true} \<[36]% 201 | \>[36]\AgdaString{"FilePath"} \AgdaField{proj₁} \<[81]% 202 | \>[81]\AgdaBound{xs}\<% 203 | \\ 204 | \>[2]\AgdaIndent{16}{}\<[16]% 205 | \>[16]\AgdaFunction{∥} \AgdaFunction{showCol} \AgdaBound{keepLines} \AgdaString{"Lines"} \<[47]% 206 | \>[47]\AgdaSymbol{(}\AgdaFunction{NatShow.show} \AgdaFunction{∘} \AgdaField{nb-lines} \AgdaFunction{∘} \AgdaField{proj₂}\AgdaSymbol{)} \AgdaBound{xs}\<% 207 | \\ 208 | \>[2]\AgdaIndent{16}{}\<[16]% 209 | \>[16]\AgdaFunction{∥} \AgdaFunction{showCol} \AgdaBound{keepWords} \AgdaString{"Words"} \<[47]% 210 | \>[47]\AgdaSymbol{(}\AgdaFunction{NatShow.show} \AgdaFunction{∘} \AgdaField{nb-words} \AgdaFunction{∘} \AgdaField{proj₂}\AgdaSymbol{)} \AgdaBound{xs}\<% 211 | \\ 212 | \>[0]\AgdaIndent{4}{}\<[4]% 213 | \>[4]\AgdaKeyword{where}\<% 214 | \\ 215 | \>[4]\AgdaIndent{6}{}\<[6]% 216 | \>[6]\AgdaFunction{showCol} \AgdaSymbol{:} \AgdaSymbol{(}\AgdaBound{b} \AgdaSymbol{:} \AgdaDatatype{Bool}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaBound{str} \AgdaSymbol{:} \AgdaPostulate{String}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaBound{f} \AgdaSymbol{:} \AgdaSymbol{(}\AgdaFunction{FilePath} \AgdaFunction{×} \AgdaRecord{count}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaPostulate{String}\AgdaSymbol{)} \AgdaSymbol{→}\<% 217 | \\ 218 | \>[6]\AgdaIndent{16}{}\<[16]% 219 | \>[16]\AgdaSymbol{(}\AgdaBound{xs} \AgdaSymbol{:} \AgdaDatatype{List} \AgdaSymbol{(}\AgdaFunction{FilePath} \AgdaFunction{×} \AgdaRecord{count}\AgdaSymbol{))} \AgdaSymbol{→}\<% 220 | \\ 221 | \>[6]\AgdaIndent{16}{}\<[16]% 222 | \>[16]\AgdaFunction{Table} \AgdaSymbol{(}\AgdaInductiveConstructor{Nat.suc} \AgdaFunction{\$} \AgdaFunction{List.length} \AgdaBound{xs}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaFunction{if} \AgdaBound{b} \AgdaFunction{then} \AgdaNumber{1} \AgdaFunction{else} \AgdaNumber{0}\AgdaSymbol{)} \AgdaPostulate{String}\<% 223 | \\ 224 | \>[0]\AgdaIndent{6}{}\<[6]% 225 | \>[6]\AgdaFunction{showCol} \AgdaInductiveConstructor{true} \<[20]% 226 | \>[20]\AgdaBound{str} \AgdaBound{f} \AgdaBound{xs} \AgdaSymbol{=} \AgdaSymbol{(}\AgdaBound{str} \AgdaInductiveConstructor{∷} \AgdaInductiveConstructor{[]}\AgdaSymbol{)} \AgdaInductiveConstructor{∷} \AgdaFunction{Vec.map} \AgdaSymbol{(}\AgdaFunction{Vec.[\_]} \AgdaFunction{∘} \AgdaBound{f}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaFunction{Vec.fromList} \AgdaBound{xs}\AgdaSymbol{)}\<% 227 | \\ 228 | \>[0]\AgdaIndent{6}{}\<[6]% 229 | \>[6]\AgdaFunction{showCol} \AgdaInductiveConstructor{false} \AgdaBound{str} \AgdaBound{f} \AgdaBound{xs} \AgdaSymbol{=} \AgdaInductiveConstructor{[]} \<[42]% 230 | \>[42]\AgdaInductiveConstructor{∷} \AgdaFunction{Vec.map} \AgdaSymbol{(}\AgdaFunction{const} \AgdaInductiveConstructor{[]}\AgdaSymbol{)} \<[66]% 231 | \>[66]\AgdaSymbol{(}\AgdaFunction{Vec.fromList} \AgdaBound{xs}\AgdaSymbol{)}\<% 232 | \\ 233 | % 234 | \\ 235 | \>\AgdaFunction{wc} \AgdaSymbol{:} \AgdaDatatype{List} \AgdaPostulate{Char} \AgdaSymbol{→} \AgdaRecord{count}\<% 236 | \\ 237 | \>\AgdaFunction{wc} \AgdaSymbol{=} \AgdaField{proj₁} \AgdaFunction{∘} \AgdaFunction{List.foldl} \AgdaSymbol{(}\AgdaFunction{uncurry} \AgdaFunction{cons}\AgdaSymbol{)} \AgdaFunction{nil}\<% 238 | \\ 239 | \>[0]\AgdaIndent{2}{}\<[2]% 240 | \>[2]\AgdaKeyword{where}\<% 241 | \\ 242 | \>[2]\AgdaIndent{4}{}\<[4]% 243 | \>[4]\AgdaFunction{cons} \AgdaSymbol{:} \AgdaSymbol{(}\AgdaBound{C} \AgdaSymbol{:} \AgdaRecord{count}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaBound{f} \AgdaSymbol{:} \AgdaDatatype{Bool}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaBound{c} \AgdaSymbol{:} \AgdaPostulate{Char}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaRecord{Σ} \AgdaRecord{count} \AgdaSymbol{(λ} \AgdaBound{\_} \AgdaSymbol{→} \AgdaDatatype{Bool}\AgdaSymbol{)}\<% 244 | \\ 245 | \>[2]\AgdaIndent{4}{}\<[4]% 246 | \>[4]\AgdaFunction{cons} \AgdaBound{C} \AgdaBound{f} \AgdaString{' '} \<[18]% 247 | \>[18]\AgdaSymbol{=} \AgdaBound{C} \AgdaInductiveConstructor{,} \AgdaInductiveConstructor{false}\<% 248 | \\ 249 | \>[2]\AgdaIndent{4}{}\<[4]% 250 | \>[4]\AgdaFunction{cons} \AgdaBound{C} \AgdaBound{f} \AgdaString{'\textbackslash{}t'} \AgdaSymbol{=} \AgdaBound{C} \AgdaInductiveConstructor{,} \AgdaInductiveConstructor{false}\<% 251 | \\ 252 | \>[2]\AgdaIndent{4}{}\<[4]% 253 | \>[4]\AgdaFunction{cons} \AgdaBound{C} \AgdaBound{f} \AgdaString{'\textbackslash{}n'} \AgdaSymbol{=} \AgdaKeyword{record} \AgdaBound{C} \AgdaSymbol{\{} \AgdaField{nb-lines} \AgdaSymbol{=} \AgdaNumber{1} \AgdaPrimitive{+} \AgdaField{nb-lines} \AgdaBound{C} \AgdaSymbol{\}} \AgdaInductiveConstructor{,} \AgdaInductiveConstructor{false}\<% 254 | \\ 255 | \>[2]\AgdaIndent{4}{}\<[4]% 256 | \>[4]\AgdaFunction{cons} \AgdaBound{C} \AgdaBound{f} \AgdaBound{c} \<[18]% 257 | \>[18]\AgdaSymbol{=} \AgdaSymbol{(}\AgdaFunction{if} \AgdaBound{f} \AgdaFunction{then} \AgdaBound{C} \AgdaFunction{else} \AgdaKeyword{record} \AgdaBound{C} \AgdaSymbol{\{} \AgdaField{nb-words} \AgdaSymbol{=} \AgdaNumber{1} \AgdaPrimitive{+} \AgdaField{nb-words} \AgdaBound{C} \AgdaSymbol{\})} \AgdaInductiveConstructor{,} \AgdaInductiveConstructor{true}\<% 258 | \\ 259 | \>[2]\AgdaIndent{4}{}\<[4]% 260 | \>[4]\AgdaFunction{nil} \AgdaSymbol{:} \AgdaRecord{count} \AgdaFunction{×} \AgdaDatatype{Bool}\<% 261 | \\ 262 | \>[2]\AgdaIndent{4}{}\<[4]% 263 | \>[4]\AgdaFunction{nil} \AgdaSymbol{=} \AgdaFunction{count0} \AgdaInductiveConstructor{,} \AgdaInductiveConstructor{false}\<% 264 | \\ 265 | % 266 | \\ 267 | \>\AgdaKeyword{infix} \AgdaNumber{5} \AgdaFixityOp{\_onFiniteFiles\_}\<% 268 | \\ 269 | \>\AgdaFunction{\_onFiniteFiles\_} \AgdaSymbol{:} \AgdaSymbol{\{}\AgdaBound{A} \AgdaSymbol{:} \AgdaPrimitiveType{Set}\AgdaSymbol{\}} \AgdaSymbol{(}\AgdaBound{f} \AgdaSymbol{:} \AgdaPostulate{String} \AgdaSymbol{→} \AgdaBound{A}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaDatatype{List} \AgdaFunction{FilePath} \AgdaSymbol{→} \AgdaDatatype{IO} \AgdaSymbol{(}\AgdaDatatype{List} \AgdaSymbol{(}\AgdaFunction{FilePath} \AgdaFunction{×} \AgdaBound{A}\AgdaSymbol{))}\<% 270 | \\ 271 | \>\AgdaBound{f} \AgdaFunction{onFiniteFiles} \AgdaInductiveConstructor{[]} \<[27]% 272 | \>[27]\AgdaSymbol{=} \AgdaInductiveConstructor{return} \AgdaInductiveConstructor{[]}\<% 273 | \\ 274 | \>\AgdaBound{f} \AgdaFunction{onFiniteFiles} \AgdaSymbol{(}\AgdaBound{fp} \AgdaInductiveConstructor{∷} \AgdaBound{fps}\AgdaSymbol{)} \AgdaSymbol{=}\<% 275 | \\ 276 | \>[0]\AgdaIndent{2}{}\<[2]% 277 | \>[2]\AgdaCoinductiveConstructor{♯} \AgdaFunction{readFiniteFile} \AgdaBound{fp} \<[29]% 278 | \>[29]\AgdaInductiveConstructor{>>=} \AgdaSymbol{λ} \AgdaBound{content} \AgdaSymbol{→}\<% 279 | \\ 280 | \>[0]\AgdaIndent{2}{}\<[2]% 281 | \>[2]\AgdaCoinductiveConstructor{♯} \AgdaSymbol{(}\AgdaCoinductiveConstructor{♯} \AgdaSymbol{(}\AgdaBound{f} \AgdaFunction{onFiniteFiles} \AgdaBound{fps}\AgdaSymbol{)} \AgdaInductiveConstructor{>>=} \AgdaSymbol{λ} \AgdaBound{rest} \<[43]% 282 | \>[43]\AgdaSymbol{→}\<% 283 | \\ 284 | \>[2]\AgdaIndent{5}{}\<[5]% 285 | \>[5]\AgdaCoinductiveConstructor{♯} \AgdaInductiveConstructor{return} \AgdaSymbol{((}\AgdaBound{fp} \AgdaInductiveConstructor{,} \AgdaBound{f} \AgdaBound{content}\AgdaSymbol{)} \AgdaInductiveConstructor{∷} \AgdaBound{rest}\AgdaSymbol{))}\<% 286 | \\ 287 | % 288 | \\ 289 | \>\AgdaFunction{main} \AgdaSymbol{:} \AgdaSymbol{\_}\<% 290 | \\ 291 | \>\AgdaFunction{main} \AgdaSymbol{=} \AgdaFunction{withCLI} \AgdaFunction{cli} \AgdaFunction{success}\<% 292 | \\ 293 | % 294 | \\ 295 | \>[0]\AgdaIndent{2}{}\<[2]% 296 | \>[2]\AgdaKeyword{where}\<% 297 | \\ 298 | % 299 | \\ 300 | \>[2]\AgdaIndent{4}{}\<[4]% 301 | \>[4]\AgdaFunction{treatFiles} \AgdaSymbol{:} \AgdaFunction{ParsedModifiers} \AgdaSymbol{(}\AgdaField{proj₂} \AgdaSymbol{(}\AgdaField{modifiers} \AgdaFunction{WordCount}\AgdaSymbol{))} \AgdaSymbol{→} \AgdaDatatype{List} \AgdaFunction{FilePath} \AgdaSymbol{→} \AgdaDatatype{IO} \AgdaSymbol{\_}\<% 302 | \\ 303 | \>[2]\AgdaIndent{4}{}\<[4]% 304 | \>[4]\AgdaFunction{treatFiles} \AgdaBound{opts} \AgdaBound{fps} \AgdaSymbol{=}\<% 305 | \\ 306 | \>[4]\AgdaIndent{6}{}\<[6]% 307 | \>[6]\AgdaCoinductiveConstructor{♯} \AgdaSymbol{(}\AgdaFunction{wc} \AgdaFunction{∘} \AgdaFunction{String.toList} \AgdaFunction{onFiniteFiles} \AgdaBound{fps}\AgdaSymbol{)} \AgdaInductiveConstructor{>>=} \AgdaSymbol{λ} \AgdaBound{counts} \AgdaSymbol{→}\<% 308 | \\ 309 | \>[4]\AgdaIndent{6}{}\<[6]% 310 | \>[6]\AgdaCoinductiveConstructor{♯} \AgdaSymbol{(}\AgdaFunction{putStrLn} \AgdaFunction{\$} \AgdaFunction{showCounts} \AgdaBound{opts} \AgdaBound{counts}\AgdaSymbol{)}\<% 311 | \\ 312 | % 313 | \\ 314 | \>[0]\AgdaIndent{4}{}\<[4]% 315 | \>[4]\AgdaFunction{success} \AgdaSymbol{:} \AgdaDatatype{ParsedCommand} \AgdaSymbol{(}\AgdaField{exec} \AgdaFunction{cli}\AgdaSymbol{)} \AgdaSymbol{→} \AgdaDatatype{IO} \AgdaSymbol{\_}\<% 316 | \\ 317 | \>[0]\AgdaIndent{4}{}\<[4]% 318 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{theCommand} \AgdaBound{mods} \AgdaBound{args}\AgdaSymbol{)} \AgdaSymbol{=}\<% 319 | \\ 320 | \>[4]\AgdaIndent{11}{}\<[11]% 321 | \>[11]\AgdaFunction{if} \AgdaField{lower} \AgdaSymbol{(}\AgdaBound{mods} \AgdaFunction{‼} \AgdaString{"--version"}\AgdaSymbol{)} \AgdaFunction{then} \AgdaFunction{putStrLn} \AgdaString{"WordCount: version 0.1"}\<% 322 | \\ 323 | \>[0]\AgdaIndent{6}{}\<[6]% 324 | \>[6]\AgdaFunction{else} \AgdaFunction{if} \AgdaField{lower} \AgdaSymbol{(}\AgdaBound{mods} \AgdaFunction{‼} \AgdaString{"--help"}\AgdaSymbol{)} \<[41]% 325 | \>[41]\AgdaFunction{then} \AgdaFunction{putStrLn} \AgdaString{"TODO: usage"}\<% 326 | \\ 327 | \>[0]\AgdaIndent{6}{}\<[6]% 328 | \>[6]\AgdaFunction{else} \AgdaFunction{maybe} \AgdaSymbol{(}\AgdaFunction{treatFiles} \AgdaBound{mods}\AgdaSymbol{)} \AgdaSymbol{(}\AgdaFunction{error} \AgdaString{"No file provided"}\AgdaSymbol{)} \AgdaBound{args}\<% 329 | \\ 330 | \>[0]\AgdaIndent{4}{}\<[4]% 331 | \>[4]\AgdaFunction{success} \AgdaSymbol{(}\AgdaInductiveConstructor{subCommand} \AgdaSymbol{()} \AgdaSymbol{\_)}\<% 332 | \end{code} 333 | --------------------------------------------------------------------------------