nek0/eidolon
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

even more verbosity for migration

Browse source
This commit is contained in:
nek0 2015-10-19 01:50:37 +02:00
parent cf11bdd702
commit 3eaa3c19e7
1 changed files with 21 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
Migrations/0.0.4-0.0.5/Migration.hs
View file

@ -17,6 +17,7 @@ import Data.Yaml as Y
import Data.Time.LocalTime import Data.Time.LocalTime
import Database.Bloodhound import Database.Bloodhound
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Types.Status
data ESSettings = ESSettings data ESSettings = ESSettings
{ esHost :: T.Text { esHost :: T.Text
@ -76,7 +77,11 @@ main = do
let u = SUser (decodeUtf8 name) (decodeUtf8 slug) let u = SUser (decodeUtf8 name) (decodeUtf8 slug)
let dId = DocId $ T.pack $ show theId let dId = DocId $ T.pack $ show theId
liftIO $ putStrLn $ (show u) ++ "\n" liftIO $ putStrLn $ (show u) ++ "\n"
indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings u dId resp <- indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings u dId
case statusCode (responseStatus resp) of
200 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
201 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
_ -> liftIO $ putStrLn $ "!!Failure!!: " ++ (show $ responseBody resp)
bla -> bla ->
error $ "malformed entry" ++ show bla error $ "malformed entry" ++ show bla
) userRows ) userRows
@ -86,7 +91,11 @@ main = do
let a = SAlbum (decodeUtf8 title) let a = SAlbum (decodeUtf8 title)
let dId = DocId $ T.pack $ show theId let dId = DocId $ T.pack $ show theId
liftIO $ putStrLn $ (show a) ++ "\n" liftIO $ putStrLn $ (show a) ++ "\n"
indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings a dId resp <- indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings a dId
case statusCode (responseStatus resp) of
200 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
201 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
_ -> liftIO $ putStrLn $ "!!Failure!!: " ++ (show $ responseBody resp)
bla -> bla ->
error $ "malformed entry: " ++ show bla error $ "malformed entry: " ++ show bla
) albumRows ) albumRows
@ -96,7 +105,11 @@ main = do
let m = SMedium (decodeUtf8 title) (zonedTimeToUTC time) (decodeUtf8 desc) (parseTags tags) let m = SMedium (decodeUtf8 title) (zonedTimeToUTC time) (decodeUtf8 desc) (parseTags tags)
let dId = DocId $ T.pack $ show theId let dId = DocId $ T.pack $ show theId
liftIO $ putStrLn $ (show m) ++ "\n" liftIO $ putStrLn $ (show m) ++ "\n"
indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings m dId resp <- indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings m dId
case statusCode (responseStatus resp) of
200 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
201 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
_ -> liftIO $ putStrLn $ "!!Failure!!: " ++ (show $ responseBody resp)
bla -> bla ->
error $ "malformed entry" ++ show bla error $ "malformed entry" ++ show bla
) mediumRows ) mediumRows
@ -106,7 +119,11 @@ main = do
let c = SComment (decodeUtf8 author) (zonedTimeToUTC time) (decodeUtf8 content) let c = SComment (decodeUtf8 author) (zonedTimeToUTC time) (decodeUtf8 content)
let dId = DocId $ T.pack $ show theId let dId = DocId $ T.pack $ show theId
liftIO $ putStrLn $ (show c) ++ "\n" liftIO $ putStrLn $ (show c) ++ "\n"
indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings c dId resp <- indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings c dId
case statusCode (responseStatus resp) of
200 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
201 -> liftIO $ putStrLn $ "OK: " ++ (show $ responseBody resp)
_ -> liftIO $ putStrLn $ "!!Failure!!: " ++ (show $ responseBody resp)
bla -> bla ->
error $ "malformed entry" ++ show bla error $ "malformed entry" ++ show bla
) commentRows ) commentRows