initial
diff --git a/JQ.hs b/JQ.hs
new file mode 100644
index 0000000..ca8df79
--- /dev/null
+++ b/JQ.hs
@@ -0,0 +1,157 @@
+module JQ where
+import Text.JSON
+import Text.JSON.String
+import Data.Maybe
+import Data.List (sortBy,sort,groupBy)
+import Data.Function (on)
+import Data.Ord (comparing)
+import Control.Monad
+import Control.Monad.Writer
+import Control.Monad.List
+import Control.Monad.Reader
+
+type Path = [Either Int String]
+
+type Program = JSValue -> [(JSValue, Path)]
+
+type JQ = ReaderT JSValue (WriterT Path [])
+
+runJQ :: JQ a -> JSValue -> [a]
+runJQ prog val = map fst $ runWriterT $ runReaderT prog val
+
+(>|) :: JQ JSValue -> JQ a -> JQ a
+a >| b = do
+ val <- a
+ local (const val) b
+
+collect :: JQ a -> JQ [a]
+collect prog = do
+ arg <- ask
+ return $ runJQ prog arg
+
+collectPaths :: JQ a -> JQ [(a,Path)]
+collectPaths prog = do
+ arg <- ask
+ return $ runWriterT $ runReaderT prog arg
+
+insert :: JSValue -> (JSValue, Path) -> JSValue
+insert base (replace, []) = replace
+insert (JSArray values) (replace, ((Left n):rest)) = JSArray values'
+ where
+ (left, (_:right)) = splitAt n values
+ values' = left ++ [replace] ++ right
+insert (JSObject obj) (replace, ((Right k):rest))= JSObject $ toJSObject obj'
+ where
+ withoutK = filter ((/= k) . fst) $ fromJSObject obj
+ obj' = (k, replace):withoutK
+
+
+eqj a b = JSBool $ a == b
+
+
+liftp :: (JSValue -> JSValue) -> JQ JSValue
+liftp f = liftM f ask
+
+idp = undefined
+failp t = []
+
+constp :: JSValue -> Program
+constp t t' = idp t
+
+anyj :: [JSValue] -> Bool
+anyj values = any isTrue values
+ where
+ isTrue (JSBool False) = False
+ isTrue (JSNull) = False
+ isTrue _ = True
+
+selectp prog = do
+ match <- collect prog
+ guard $ anyj match
+ ask
+
+constStr :: String -> JQ JSValue
+constStr = return . JSString . toJSString
+
+constInt :: Int -> JQ JSValue
+constInt = return . JSRational False . toRational
+
+updatep p = do
+ t <- ask
+ liftM (foldl insert t) $ collectPaths p
+
+arrayp prog = liftM JSArray $ collect prog
+
+
+childp' :: JSValue -> JQ JSValue
+childp' (JSArray values) = msum [tell [Left i] >> return v | (v,i) <- zip values [0..]]
+childp' (JSObject obj) = msum [tell [Right k] >> return v | (k,v) <- fromJSObject obj]
+childp' _ = mzero
+
+childp = ask >>= childp'
+
+--findp :: Program -> Program
+findp prog = do
+ found <- collect prog
+ if anyj found then ask else childp >| findp prog
+
+groupp prog = do
+ list <- ask
+ case list of
+ JSArray values -> do
+ marked <- forM values $ \v -> do
+ m <- collect (return v >| prog)
+ return (m,v)
+ msum $
+ map (return . JSArray . map snd) $
+ groupBy ((==) `on` fst) $
+ sortBy (comparing fst) $
+ marked
+ _ -> return JSNull
+
+
+
+
+withArray f (JSArray values) = JSArray $ f values
+withArray f x = x
+
+callp "select" [p] = selectp p
+callp "find" [p] = findp p
+callp "set" [p] = updatep p
+callp "sort" [] = liftp (withArray sort)
+callp "group" [p] = groupp p
+
+lookupj :: JSValue -> JSValue -> JQ JSValue
+lookupj (JSArray values) (JSRational _ n) = do
+ let idx = round n
+ tell [Left idx]
+ if idx >= 0 && idx < length values
+ then return $ values !! idx
+ else return $ JSNull
+lookupj (JSObject obj) (JSString s) = do
+ tell [Right (fromJSString s)]
+ case (lookup (fromJSString s) (fromJSObject obj)) of
+ Just x -> return x
+ Nothing -> return JSNull
+lookupj _ _ = mzero
+
+
+plusj (JSRational _ n1) (JSRational _ n2) = JSRational True (n1 + n2)
+plusj (JSString s1) (JSString s2) = JSString $ toJSString (fromJSString s1 ++ fromJSString s2)
+plusj (JSArray a1) (JSArray a2) = JSArray $ a1 ++ a2
+
+
+js :: JSON a => a -> JSValue
+js = showJSON
+
+index s = do
+ v <- ask
+ lookupj v (js s)
+
+
+dictp progs = do
+ liftM (JSObject . toJSObject) $ forM progs $ \(k,v) -> do
+ JSString k' <- k
+ v' <- v
+ return (fromJSString k', v')
+
diff --git a/Lexer.x b/Lexer.x
new file mode 100644
index 0000000..700c69e
--- /dev/null
+++ b/Lexer.x
@@ -0,0 +1,101 @@
+{
+module Lexer where
+import Control.Monad.Error
+}
+
+%wrapper "monadUserState"
+
+$digit = 0-9
+$alpha = [a-zA-Z_]
+@reserved = "."|"["|"]"|","|":"|"("|")"|"{"|"}"|"|"|"=="|"+"
+@ident = $alpha [$alpha $digit]*
+@string = \" ($printable)* \"
+
+
+tokens :-
+
+<0> $white+ ;
+<0> @reserved { tok TRes }
+<0> @ident { tok TIdent }
+<0> $digit+ { tok $ TInt . read }
+
+
+<0> \" { enterString }
+<string> \" { leaveString }
+<string> ($printable # [\"\\]) { pushString id }
+<string> \\ [\"\\\/] { pushString (drop 1) }
+<string> \\ [nrt] { pushString (escape . drop 1) }
+--<string> \\ 'u' [0-9a-fA-F]{4}
+-- { pushString (parseUnicode . drop 2) }
+
+-- @string { \s -> TString $ init $ tail s}
+
+
+{
+
+escape :: String -> String
+escape "r" = "\r"
+escape "n" = "\n"
+escape "t" = "\t"
+
+getState :: Alex AlexState
+getState = Alex $ \s -> Right (s, s)
+
+getUserState :: Alex AlexUserState
+getUserState = liftM alex_ust getState
+
+setUserState :: AlexUserState -> Alex ()
+setUserState s' = Alex $ \s -> Right (s{alex_ust = s'}, ())
+
+alexEOF = return $ Nothing
+
+enterString input len = do
+ setUserState []
+ alexSetStartCode string
+ skip input len
+
+pushString f i@(p, _, s) len = do
+ buf <- getUserState
+ setUserState (buf ++ [f $ take len s])
+ skip i len
+
+leaveString input len = do
+ s <- getUserState
+ alexSetStartCode 0
+ return $ Just $ TString $ concat s
+
+
+tok f (p,_,s) len = return $ Just $ f (take len s)
+data Token = TRes String | TString String | TIdent String | TInt Int
+
+instance Show Token where
+ show (TRes t) = "token " ++ t
+ show (TString t) = "string " ++ t
+ show (TIdent t) = "identifier " ++ t
+ show (TInt t) = "integer " ++ show t
+
+
+type AlexUserState = [String]
+
+alexInitUserState = undefined
+
+wrapError (Alex scanner) = Alex $ \s -> case scanner s of
+ Left message -> Left (message ++ " at " ++ showpos (alex_pos s))
+ where
+ showpos (AlexPn off line col) = "line " ++ show line ++ ", column " ++ show col
+ x -> x
+
+scanner = do
+ tok <- wrapError alexMonadScan
+ case tok of
+ Nothing -> do
+ s <- getState
+ case alex_scd s of
+ 0 -> return []
+ string -> alexError "Unterminated string literal"
+ Just tok -> liftM (tok:) scanner
+
+runLexer :: String -> Either String [Token]
+runLexer input = runAlex input scanner
+
+}
\ No newline at end of file
diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..695520c
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,22 @@
+import Parser
+import Lexer
+import JQ
+import Text.JSON
+import Text.JSON.String
+import System.Environment
+import Control.Monad
+import System.IO
+
+
+parseJS :: String -> JSValue
+parseJS s = case runGetJSON readJSValue s of
+ Left err -> error err
+ Right val -> val
+
+
+main = do
+ [program] <- getArgs
+ json <- liftM parseJS $ hGetContents stdin
+ case runLexer program >>= runParser of
+ Left err -> putStrLn err
+ Right program -> mapM_ (putStrLn . encode) (runJQ program json)
\ No newline at end of file
diff --git a/Parser.y b/Parser.y
new file mode 100644
index 0000000..544fe5b
--- /dev/null
+++ b/Parser.y
@@ -0,0 +1,78 @@
+{
+module Parser where
+import Lexer
+import JQ
+import Text.JSON
+import Debug.Trace
+import Data.List
+import Control.Monad.Error
+import Control.Monad.Reader
+}
+
+%name runParser Exp
+%tokentype { Token }
+
+%monad { Either String }
+%error { \t -> fail $ "parse error: unexpected " ++ if null t then [] else (show $ head t) }
+
+%token
+ '|' { TRes "|" }
+ '.' { TRes "." }
+ '[' { TRes "[" }
+ ']' { TRes "]" }
+ '{' { TRes "{" }
+ '}' { TRes "}" }
+ '(' { TRes "(" }
+ ')' { TRes ")" }
+ ',' { TRes "," }
+ ':' { TRes ":" }
+ '==' { TRes "==" }
+ '+' { TRes "+" }
+ Ident { TIdent $$ }
+ String { TString $$ }
+ Int { TInt $$ }
+
+%left '|'
+%left ','
+%nonassoc '=='
+%left '+'
+
+%%
+
+Exp
+ : Exp '|' Exp { $1 >| $3 }
+ | Exp ',' Exp { $1 `mplus` $3 }
+ | Exp '==' Exp { liftM2 eqj $1 $3 }
+ | Exp '+' Exp { liftM2 plusj $1 $3 }
+ | Term { $1 }
+
+ExpD
+ : ExpD '|' ExpD { $1 >| $3 }
+ | ExpD '==' ExpD { liftM2 eqj $1 $3 }
+ | Term { $1 }
+
+
+Term
+ : '.' { ask }
+ | Term '.' Ident { $1 >| index $3 }
+ | '.' Ident { index $2 }
+ | String { constStr $1 }
+ | Term '[' Exp ']' { do {t <- $1; i <- $3; lookupj t i} }
+ | Term '[' ']' { $1 >| childp }
+ | '(' Exp ')' { $2 }
+ | '[' Exp ']' { arrayp $2 }
+ | Int { constInt $1 }
+ | '{' MkDict '}' { dictp $2 }
+ | Ident '(' Exp ')' { callp $1 [$3] }
+ | Ident { callp $1 [] }
+
+MkDict
+ : { [] }
+ | MkDictPair { [$1] }
+ | MkDictPair ',' MkDict { $1:$3 }
+
+MkDictPair
+ : Ident ':' ExpD { (constStr $1, $3) }
+ | Ident { (constStr $1, index $1) }
+ | String ':' ExpD { (constStr $1, $3) }
+ | '(' Exp ')' ':' ExpD{ ($2, $5) }
