Haskell入門 P323 テストようやく終了

 本のままでは、動かず新しいバージョンに合わせた修正が必要だった。

-- Spec.hs ********************* {-# LANGUAGE OverloadedStrings #-} import Test.HUnit import qualified Data.Text() import Data.Text (Text,unpack) import Data.Hjq.Parser import Data.Hjq.Query(applyFilter,executeQuery) -- import qualified Data.HashMap.Strict as H import qualified Data.Vector as V import Data.Aeson import qualified Data.Aeson.KeyMap as KM import Control.Lens import Data.Aeson import Data.Aeson.Lens jqFilterParserTest :: Test jqFilterParserTest = TestList [ "jqFilterParser test 1" ~: parseJqFilter "." ~?= Right JqNil , "jqFilterParser test 2" ~: parseJqFilter ".[0]" ~?= Right (JqIndex 0 JqNil) , "jqFilterParser test 3" ~: parseJqFilter ".fieldName" ~?= Right (JqField "fieldName" JqNil) , "jqFilterParser test 4" ~: parseJqFilter ".[0].fieldName" ~?= Right (JqIndex 0 (JqField "fieldName" JqNil)) , "jqFilterParser test 5" ~: parseJqFilter ".fieldName[0]" ~?= Right (JqField "fieldName" (JqIndex 0 JqNil)) ] jqFilterParserSpacesTest :: Test jqFilterParserSpacesTest = TestList [ "jqFilterParser spaces test 1" ~: parseJqFilter " . " ~?= Right JqNil , "jqFilterParser spaces test 2" ~: parseJqFilter " . [ 0 ] " ~?= Right (JqIndex 0 JqNil) , "jqFilterParser spaces test 3" ~: parseJqFilter " . fieldName " ~?= Right (JqField "fieldName" JqNil) , "jqFilterParser spaces test 4" ~: parseJqFilter " . [ 0 ] . fieldName " ~?= Right (JqIndex 0 (JqField "fieldName" JqNil)) , "jqFilterParser spaces test 5" ~: parseJqFilter " . fieldName [ 0 ] " ~?= Right (JqField "fieldName" (JqIndex 0 JqNil)) ] -- ************************: jqQueryParserTest :: Test jqQueryParserTest = TestList [ "jqQueryParser test 1" ~: parseJqQuery "[]" ~?= Right (JqQueryArray []) , "jqQueryParser test 2" ~: parseJqQuery "[.hoge,.piyo]" ~?= Right (JqQueryArray [JqQueryFilter (JqField "hoge" JqNil), JqQueryFilter (JqField "piyo" JqNil)]) , "jqQueryParser test 3" ~: parseJqQuery "{\"hoge\":[],\"piyo\":[]}" ~?= Right (JqQueryObject [("hoge", JqQueryArray []), ("piyo", JqQueryArray [])]) ] jqQueryParserSpacesTest :: Test jqQueryParserSpacesTest = TestList [ "jqQueryParser spaces test 1" ~: parseJqQuery " [ ] " ~?= Right (JqQueryArray []) , "jqQueryParser spaces test 2" ~: parseJqQuery " [ . hoge , . piyo ] " ~?= Right (JqQueryArray [JqQueryFilter (JqField "hoge" JqNil), JqQueryFilter (JqField "piyo" JqNil)]) , "jqQueryParser spaces test 3" ~: parseJqQuery "{ \"hoge\" : [ ] , \"piyo\" : [ ] } " ~?= Right (JqQueryObject [("hoge", JqQueryArray []), ("piyo", JqQueryArray [])]) ] -- ***************** applyFilterTest :: Test applyFilterTest = TestList [ "applyFilter test 1" ~: applyFilter (unsafeParseFilter ".") testData ~?= Right testData , "applyFilter test 2" ~: (Just $ applyFilter (unsafeParseFilter ".string-field") testData) ~?= fmap Right (testData^?key "string-field") , "applyFilter test 3" ~: (Just $ applyFilter (unsafeParseFilter ".nested-field.inner-string") testData) ~?= fmap Right (testData ^? key "nested-field" . key "inner-string") , "applyFilter test 4" ~: (Just $ applyFilter (unsafeParseFilter ".nested-field.inner-number") testData) ~?= fmap Right (testData ^? key "nested-field" . key "inner-number") , "applyFilter test 5" ~: (Just $ applyFilter (unsafeParseFilter ".array-field[0]") testData) ~?= fmap Right (testData ^? key "array-field" . nth 0) , "applyFilter test 6" ~: (Just $ applyFilter (unsafeParseFilter ".array-field[1]") testData) ~?= fmap Right (testData ^? key "array-field" . nth 1) , "applyFilter test 7" ~: (Just $ applyFilter (unsafeParseFilter ".array-field[2].object-in-array") testData) ~?= fmap Right (testData ^? key "array-field" . nth 2 . key "object-in-array") ] executeQueryTest :: Test executeQueryTest = TestList -- [ "executeQuery test 1" ~: executeQuery (unsafeParseQuery "{}") testData ~?= Right (Object $ H.fromList []) [ "executeQuery test 1" ~: executeQuery (unsafeParseQuery "{}") testData ~?= Right (Object $ KM.fromList []) , "executeQuery test 2" ~: executeQuery (unsafeParseQuery "{ \"fielda\": . , \"fieldb\": .string-field }") testData ~?= -- Right (Object $ H.fromList [("fielda", testData), ("fieldb", String "string value")]) Right (Object $ KM.fromList [("fielda", testData), ("fieldb", String "string value")]) , "executeQuery test 3" ~: executeQuery (unsafeParseQuery "[ .string-field, .nested-field.inner-string ]") testData ~?= Right (Array $ V.fromList [String "string value", String "inner value"]) ] ----- testData :: Value -- testData = Object $ H.fromList testData = Object $ KM.fromList [ ("string-field", String "string value") -- , ("nested-field", Object $ H.fromList , ("nested-field", Object $ KM.fromList [ ("inner-string", String "inner value") , ("inner-number", Number 100) ] ) , ("array-field", Array $ V.fromList [ String "first field" , String "next field" -- , Object (H.fromList , Object (KM.fromList [ ("object-in-array", String "string value in object-in-array") ] ) ] ) ] unsafeParseFilter :: Text -> JqFilter unsafeParseFilter t = case parseJqFilter t of Right f -> f -- Left s -> error $ "PARSE FAILURE IN A TEST : " ++ unpack s Left s -> error $ "PARSE FAILURE IN A TEST : " ++ s unsafeParseQuery :: Text -> JqQuery unsafeParseQuery t = case parseJqQuery t of Right q -> q -- Left s -> error $ "PARSE FAILURE IN A TEST : " ++ unpack s Left s -> error $ "PARSE FAILURE IN A TEST : " ++ s main :: IO () main = do result <- runTestTT $ (TestList [ jqFilterParserTest , jqFilterParserSpacesTest , jqQueryParserTest , jqQueryParserSpacesTest , applyFilterTest , executeQueryTest ]) print result -- Parser.hs ****************************************** {-# LANGUAGE OverloadedStrings #-} module Data.Hjq.Parser ( JqFilter(..) , parseJqFilter , JqQuery(..) , parseJqQuery ) where import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L import Data.Void (Void) import qualified Data.Text as T import Data.Char () ------------------------------------------------------------ -- JqFilter 定義 ------------------------------------------------------------ data JqFilter = JqNil | JqField String JqFilter | JqIndex Int JqFilter deriving (Show, Read, Eq) type Parser = Parsec Void String ------------------------------------------------------------ -- JqFilter パーサ ------------------------------------------------------------ parseJqFilter :: T.Text -> Either String JqFilter parseJqFilter s = case parse (sc *> topFilter <* eof) "" (T.unpack s) of Left err -> Left (errorBundlePretty err) Right v -> Right v topFilter :: Parser JqFilter topFilter = schar '.' *> filterRest filterRest :: Parser JqFilter filterRest = try parseIndex <|> try parseField <|> pure JqNil parseField :: Parser JqFilter parseField = do name <- lexeme (some (letterChar <|> schar '-' ) ) rest <- option JqNil (schar '.' *> filterRest <|> parseIndex) return $ JqField name rest parseIndex :: Parser JqFilter parseIndex = do idx <- schar '[' *> lexeme L.decimal <* schar ']' rest <- option JqNil (schar '.' *> filterRest <|> parseField) return $ JqIndex idx rest ------------------------------------------------------------ -- JqQuery 定義 & パーサ ------------------------------------------------------------ data JqQuery = JqQueryObject [(T.Text, JqQuery)] | JqQueryArray [JqQuery] | JqQueryFilter JqFilter deriving (Show, Read, Eq) parseJqQuery :: T.Text -> Either String JqQuery parseJqQuery s = case parse (sc *> jqQueryParser <* eof) "" (T.unpack s) of Left err -> Left (errorBundlePretty err) Right v -> Right v jqQueryParser :: Parser JqQuery jqQueryParser = queryArray <|> queryObject <|> queryFilter queryArray :: Parser JqQuery queryArray = do _ <- schar '[' elems <- jqQueryParser `sepBy` schar ',' _ <- schar ']' return $ JqQueryArray elems queryObject :: Parser JqQuery queryObject = do _ <- schar '{' kvs <- qObj `sepBy` schar ',' _ <- schar '}' return $ JqQueryObject kvs where qObj = do key <- schar '"' *> (T.pack <$> some letterChar) <* schar '"' _ <- schar ':' val <- jqQueryParser return (key, val) queryFilter :: Parser JqQuery queryFilter = JqQueryFilter <$> topFilter ------------------------------------------------------------ -- 共通補助 ------------------------------------------------------------ sc :: Parser () sc = L.space space1 empty empty lexeme :: Parser a -> Parser a lexeme = L.lexeme sc schar :: Char -> Parser Char schar c = lexeme (char c) -- Query.hs ********************************************* {-# LANGUAGE OverloadedStrings #-} module Data.Hjq.Query where import Control.Lens import Control.Monad import Data.Monoid import Data.Hjq.Parser import Data.Aeson import Data.Aeson.Lens -- import Data.Text as T import qualified Data.Vector as V -- import qualified Data.HashMap.Strict as H import qualified Data.Text as T import Data.Aeson.Key (fromText) import qualified Data.Aeson.KeyMap as KM import qualified Data.Aeson.Key as Key applyFilter :: JqFilter -> Value -> Either T.Text Value applyFilter (JqField fieldName n) obj@(Object _) = join $ noteNotFoundError (T.pack fieldName) (fmap (applyFilter n) (obj ^? key (fromText(T.pack fieldName)))) applyFilter (JqIndex index n) array@(Array _) = join $ noteOutOfRangeError index (fmap (applyFilter n) (array ^? nth index)) applyFilter JqNil v = Right v applyFilter f o = Left $ "unexpected pattern : " <> tshow f <> " : " <> tshow o executeQuery :: JqQuery -> Value -> Either T.Text Value executeQuery (JqQueryObject o) v -- = fmap (Object . H.fromList) . sequence . fmap sequence $ fmap (fmap $ flip executeQuery v) o = fmap (Object . KM.fromList . fmap (\(k,v) -> (Key.fromText k, v))) . sequence . fmap sequence $ fmap (fmap $ flip executeQuery v) o executeQuery (JqQueryArray l) v = fmap (Array . V.fromList) . sequence $ fmap (flip executeQuery v) l executeQuery (JqQueryFilter f) v = applyFilter f v noteNotFoundError :: T.Text -> Maybe a -> Either T.Text a noteNotFoundError _ (Just x) = Right x noteNotFoundError s Nothing = Left $ "field name not found" <> s noteOutOfRangeError :: Int -> Maybe a -> Either T.Text a noteOutOfRangeError _ (Just x) = Right x noteOutOfRangeError s Nothing = Left $ "out of range : " <> tshow s tshow :: Show a => a -> T.Text tshow = T.pack . Prelude.show

よくわからないところを確認してみた。

Spec.hs

・applyFilterTestについて

   ^?  指定データを１部取り出したいとき使用(lens)

　nth 2 リストの３番目要素取り出し

   fmap Right (testData^?key "string-field") だと  fmap::(a->b)->f a->f bでみると

　(a->b)がRight　　f aがMaybe Value   f bがJustつまりMaybe(Either e Value)

　これにRightが適用なるようだ

Parser.hs

・queryArrayの　jqQueryParser `sepBy` schar ','　について

　　sepByは中値だが、２引数関数で　schar ','を区切りとして　jqQueryParserでパース

Query.hs

・applyFilter (JqField fieldName n) obj@(Object _)

  = join $ noteNotFoundError (T.pack fieldName) (fmap (applyFilter n) (obj ^? key (fromText(T.pack fieldName))))  について

   obj@(Object _)はObjectとか確認し、その値をobjとして利用可能

　joinはMaybeをはずすため

・executeQuery (JqQueryObject o) v

   = fmap (Object . KM.fromList . fmap (\(k,v) -> (Key.fromText k, v)))

    . sequence　②

    . fmap sequence　①

    $ fmap (fmap $ flip executeQuery v) o　　について        

    左辺の(JqQueryObject o) vは{"name":.name,"age":.age}::[(Text,JqQuery)]

    右辺の fmap $ flip executeQuery v のflipは引数を逆順にして、部分適用を意図した 通りにするために使う。(flip executeQuery v) q == executeQuery q v　

　 fmap (fmap $ flip executeQuery v) は、内側のfmapで( , )への処理を、外側のfmapで上の関数使って[  , , ]への処理を行う。

　　sequenceは①で　Eitherを外に出していく　[(either Text (Text,Value))]

        ②で　Ehter Text　[(Text,Value)]にする

　　　パーシングは、なかなか複雑