Permalink
Browse files

Final move to Clojure subfolder

  • Loading branch information...
richard-lyman committed Aug 20, 2013
1 parent 78666ec commit e78edfde3f9d23459b0204ac37780ad3e8fd2348
@@ -0,0 +1,6 @@
+(ns amotoen.core)
+
+(defn -main
+ "I don't do a whole lot."
+ [& args]
+ (println "Hello, World!"))

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -0,0 +1,74 @@
+; Copyright (c) Richard Lyman. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
+; which can be found in the file epl-v10.html at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
+(ns com.lithinos.amotoen.grammars.csv
+ (:use [com.lithinos.amotoen.core :only [post-process wrap-string]]))
+
+(def grammar {
+ :Document [:Line '(* :Line) :$]
+ :Line [:_* :Value '(* [:_* \, :_* :Value]) :_* '(* :EndOfLine)]
+ :Value '(| [\" (* :DoubleQuotedValue) \"]
+ [\' (* :SingleQuotedValue) \']
+ (* :VanillaValue))
+ :DoubleQuotedValue '(| [\\ \"] [\\ \\] (% \"))
+ :SingleQuotedValue '(| [\\ \'] [\\ \\] (% \'))
+ :VanillaValue ['(! :EndOfLine) '(% \,)]
+ :_* '(* :Whitespace)
+ :Whitespace '(| \space \tab)
+ :EndOfLine '(| \newline \return)
+})
+
+(defn specified
+ ([] (specified \,\ \" \"))
+ ([separator] (specified separator \" \"))
+ ([separator, wrapper] (specified separator wrapper wrapper))
+ ([separator, left-wrapper, right-wrapper] {
+ :Document [:Line '(* :Line) :$]
+ :Line [:_* :Value (list '* [:_* separator :_* :Value]) :_* '(* :EndOfLine)]
+ :Value (list '| [left-wrapper '(* :WrappedValue) right-wrapper]
+ '(* :VanillaValue))
+ :WrappedValue (list '| [\\ right-wrapper] [\\ \\] (list '% right-wrapper))
+ :VanillaValue ['(! :EndOfLine) (list '% separator)]
+ :_* '(* :Whitespace)
+ :Whitespace '(| \space \tab)
+ :EndOfLine '(| \newline \return)
+}))
+
+(defn ignore [_] "")
+(defn value-as-string [l]
+ (let [l (if (vector? l) (second l) l)]
+ (cond
+ (map? l) (str (first (vals l)))
+ true (apply str
+ (map #(first (vals %))
+ l)))))
+(defn without-guard [v]
+ (second v))
+(defn line-as-vec [v]
+ (let [others (map last (first (rest (rest v))))]
+ (reduce (fn [r i] (conj r (first (vals i))))
+ []
+ (conj others (second v)))))
+(defn lines-as-vec [v]
+ (let [v (vec (flatten v))]
+ (reduce (fn [r i] (if (empty? i) r (conj r (first (vals i)))))
+ []
+ (butlast v))))
+
+(def #^{:private true} to-clj-fns { :Document lines-as-vec
+ :Line line-as-vec
+ :Value value-as-string
+ :VanillaValue without-guard
+ :_* ignore
+ ;:EndOfLine (fn [_] nil)
+ :Whitespace ignore })
+
+(defn to-clj
+ ([s] (to-clj s grammar))
+ ([s g] (post-process :Document g (wrap-string s) to-clj-fns)))
+
@@ -0,0 +1,56 @@
+; Copyright (c) Richard Lyman. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
+; which can be found in the file epl-v10.html at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
+(ns com.lithinos.amotoen.grammars.json
+ (:use [com.lithinos.amotoen.core :only [move ls]]))
+
+(defn json-control-character [g w]
+ (let [s #{ \u0000 \u0001 \u0002 \u0003 \u0004 \u0005 \u0006 \u0007 \u0008 \u0009 \u000A \u000B \u000C \u000D \u000E \u000F
+ \u0010 \u0011 \u0012 \u0013 \u0014 \u0015 \u0016 \u0017 \u0018 \u0019 \u001A \u001B \u001C \u001D \u001E \u001F}
+ remaining (drop-while #(nil? (move w %)) s)]
+ (if (seq remaining)
+ (first remaining)
+ nil)))
+
+(def grammar {
+ :_* '(* (| \newline \return \tab \space))
+ :JSONText [:_* '(| :JSONObject :Array) :_* :$]
+ :Value (list '| :JSONString :JSONObject :Array "true" "false" "null" :JSONNumber)
+; Objects
+ :JSONObject '(| :EmptyObject :ContainingObject)
+ :EmptyObject [\{ :_* \}]
+ :ContainingObject [\{ :_* :Members :_* \}]
+ :Members '(| [:Pair :_* \, :_* :Members] :Pair) ; Nests the structure significantly
+ :Pair [:JSONString :_* \: :_* :Value]
+; Arrays
+ :Array '(| :EmptyArray :ContainingArray)
+ :EmptyArray [\[ :_* \]]
+ :ContainingArray [\[ :_* :Elements :_* \]]
+ :Elements '(| [:Value :_* \, :_* :Elements] :Value) ; Nests the structure significantly
+; Strings
+ :JSONString '(| :EmptyString :ContainingString)
+ :EmptyString [\" \"]
+ :ContainingString [\" :Chars \"]
+ :Chars [:GuardedChar '(* :GuardedChar)]
+ :GuardedChar ['(! :ControlCharacter) :Char]
+ :ControlCharacter (list 'a json-control-character)
+ :Char '(| :EscapedChar [(! \") :NonEscapedChar])
+ :EscapedChar [\\ '(| \" \\ \/ \b \f \n \r \t :Unicode)]
+ :Unicode [\u :HexDigit :HexDigit :HexDigit :HexDigit]
+ :HexDigit (ls '| "0123456789ABCDEFabcdef")
+ :NonEscapedChar :. ; This is OK since the only way it's used is with appropriate guards.
+; Numbers
+ :JSONNumber '(| [:Int :Frac :Exp] [:Int :Exp] [:Int :Frac] :Int)
+ :Int '(| [\- :Digit1-9 :Digits] [\- :Digit] [:Digit1-9 :Digits] :Digit)
+ :Frac [\. :Digits]
+ :Exp [:ExpLeader :Digits]
+ :Digit (ls '| "0123456789")
+ :Digit1-9 (ls '| "123456789")
+ :Digits [:Digit '(* :Digits)]
+ :ExpLeader ['(| \e \E) '(* (| \+ \-))]
+})
@@ -0,0 +1,144 @@
+; Copyright (c) Richard Lyman. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://www.eclipse.org/legal/epl-v10.html)
+; which can be found in the file epl-v10.html at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
+(ns com.lithinos.amotoen.grammars.minimark
+ (:use [com.lithinos.amotoen.core :only [ls post-process wrap-string]]))
+
+(defn containing [s b e] [s b (list '* b) e])
+
+(defn delimited
+ ([m] (delimited m m))
+ ([b e] (delimited b e e))
+ ([s b e] (containing s (list '% b) e)))
+
+(defn delimited-body [d b] (delimited d b d))
+
+(defn a-frequency-ordered-char [] ; Semi-frequency-ordered
+ (ls '| "etaoinsrh,.?bcdfgjklmpquvwxyz023456789~`@#$%&*()+}]|:;<>/\""))
+
+(defn one-or-more [b] [b (list '* b)])
+
+(defn one-or-more-not [b] [(list '% b) (list '* (list '% b))])
+
+(def grammar {
+ :Content '(* (| :SafeChar :Markup :UnsafeChar))
+ :Markup '(| :HRule :MDash :List :SS :U :B :I :Href :Pre :H4 :H3 :H2 :H1)
+ :HRule "----"
+ :MDash "---"
+ :List '(| :OrderedList :UnorderedList)
+ :OrderedList (one-or-more ["1. " :ListBody])
+ :UnorderedList (one-or-more ["-- " :ListBody])
+ :ListBody [:ListContent \newline '(* (| \newline \space \tab))]
+ :ListContent '(* (| :ListSafeChar :SS :U :B :I :Href :Pre (% \newline)))
+ :SS (delimited \^)
+ :H4 (delimited-body "====" \=)
+ :H3 (delimited-body "===" \=)
+ :H2 (delimited-body "==" \=)
+ :H1 (delimited-body "=" \=);
+ :B (delimited "'''");
+ :I (delimited "''");
+ :U (delimited "__");
+ :Pre (containing "{{{" :PreContent "}}}");
+ :PreContent '(| [\! \}] (% [\} \} \}]));
+ :Href [\[ (list '| (delimited \[ \]) :HrefExplained) \]];
+ :HrefExplained [(one-or-more-not \space) \space (one-or-more-not \])];
+ :ListSafeChar (list '| \space :EscapedChar (a-frequency-ordered-char) \tab);
+ :SafeChar (list '| :EmptyLine :ListSafeChar \newline);
+ :EmptyLine [\newline \newline]
+ :EscapedChar [\! :UnsafeChar];
+ :UnsafeChar (ls '| "ETAOINSRH1BCDFGJKLMPQUVWXYZ!\\[={_^'-");
+})
+
+(defn list-safe-to-html [l] (if (map? l) (first (vals l)) l))
+
+(defn safe-to-html [l] (if (map? l) (first (vals l)) l))
+
+(defn content-to-html [l]
+ (cond
+ (map? l) (first (vals l))
+ (seq? l) (apply str (map content-to-html l))
+ true l))
+
+(defn one-or-more-to-str [l]
+ (if (char? (second l))
+ (apply str l)
+ (reduce (fn [a b] (str a b))
+ (first l)
+ (second l))))
+
+(defn delimited-to-html
+ ([l c] (delimited-to-html l c "span"))
+ ([l c t] (if (not (nil? l))
+ (str "<" t " class='" c "'>" (one-or-more-to-str (butlast (rest l))) "</" t ">"))))
+
+(defn href-to-html [v]
+ (if (not (nil? v))
+ (if (vector? (second v))
+ (let [l (one-or-more-to-str (butlast (rest (second v))))]
+ (str "<a href='" l "'>" l "</a>"))
+ (let [inside (first (vals (second v)))
+ link (one-or-more-to-str (first inside))
+ explanation (one-or-more-to-str (last inside))]
+ (str "<a href='" link "'>" explanation "</a>")))))
+
+(defn pre-to-html[v]
+ (if (not (nil? v))
+ (let [v (butlast (rest v))]
+ (if (= \newline (first (vals (first v))))
+ (str "<div class='pre-block'>"
+ (apply str (map #(first (vals %))
+ (butlast (second v))))
+ "</div>")
+ (str "<div class='pre-inline'>"
+ (reduce (fn [a b] (str a (first (vals b))))
+ (first (vals (first v)))
+ (second v))
+ "</div>")))))
+
+(defn list-to-html
+ ([v] (list-to-html v "ol"))
+ ([v t]
+ (if (not (nil? v))
+ (str "<" t ">"
+ (reduce (fn [a b] (if (empty? b) a (str a (str "<li>" (first (vals (last b))) "</li>"))))
+ (str "<li>" (first (vals (last (first v)))) "</li>")
+ (rest v))
+ "</" t ">"))))
+
+(defn list-content-to-html [l]
+ (reduce (fn [a b] (str a (if (map? b) (first (vals b)) b)))
+ (first l)
+ (rest l)))
+
+(def #^{:private true} to-html-fns {:Content content-to-html
+ :EscapedChar #(first (vals (second %)))
+ :ListSafeChar list-safe-to-html
+ :SafeChar safe-to-html
+ :MDash #(if (not (nil? %)) "&mdash;")
+ :HRule #(if (not (nil? %)) "<hr />")
+ :SS #(delimited-to-html % "superscript")
+ :U #(delimited-to-html % "underline")
+ :B #(delimited-to-html % "bold")
+ :I #(delimited-to-html % "italic")
+ :H4 #(delimited-to-html % "H4" "div")
+ :H3 #(delimited-to-html % "H3" "div")
+ :H2 #(delimited-to-html % "H2" "div")
+ :H1 #(delimited-to-html % "H1" "div")
+ :Pre pre-to-html
+ :Href href-to-html
+ :List #(first (vals %))
+ :Markup #(first (vals %))
+ :ListBody #(first (vals (first %)))
+ :OrderedList list-to-html
+ :UnorderedList #(list-to-html % "ul")
+ :ListContent #(list-content-to-html %)
+ :EmptyLine #(if (not (nil? %)) "<div class='empty-line' />") })
+
+(defn to-html
+ ([s] (to-html s grammar))
+ ([s g] (post-process :Content g (wrap-string s) to-html-fns)))
@@ -0,0 +1,22 @@
+{
+ "glossary": {
+ "title": "example glossary",
+ "GlossDiv": {
+ "title": "S",
+ "GlossList": {
+ "GlossEntry": {
+ "ID": "SGML",
+ "SortAs": "SGML",
+ "GlossTerm": "Standard Generalized Markup Language",
+ "Acronym": "SGML",
+ "Abbrev": "ISO 8879:1986",
+ "GlossDef": {
+ "para": "A meta-markup language, used to create markup languages such as DocBook.",
+ "GlossSeeAlso": ["GML", "XML"]
+ },
+ "GlossSee": "markup"
+ }
+ }
+ }
+ }
+}

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -0,0 +1,11 @@
+{"menu": {
+ "id": "file",
+ "value": "File",
+ "popup": {
+ "menuitem": [
+ {"value": "New", "onclick": "CreateNewDoc()"},
+ {"value": "Open", "onclick": "OpenDoc()"},
+ {"value": "Close", "onclick": "CloseDoc()"}
+ ]
+ }
+}}
Oops, something went wrong.

0 comments on commit e78edfd

Please sign in to comment.