Quick db scraper written by Mitchell Rosen to generate the YAML.

dohaskell-db-scraper.hs

#!/usr/bin/env stack
-- stack --resolver lts-6.10 runghc --package sqlite-simple --package text --package time

{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.Foldable
import Data.Maybe
import Data.List
import Database.SQLite.Simple
import Data.Text (Text)
import Data.Time.Clock (UTCTime)

import qualified Data.Text as T
import qualified Data.Text.IO  as T

data Resource = Resource
  { resId     :: Int
  , resTitle  :: Text
  , resUrl    :: Text
  , resPub    :: Maybe Int
  , resType   :: Text
  , resUid    :: Int
  , resPosted :: Text
  } deriving Show
instance FromRow Resource where fromRow = Resource <$> field <*> field <*> field <*> field <*> field <*> field <*> field

data Author = Author
  { authId :: Int
  , authName :: Text
  } deriving Show
instance FromRow Author where fromRow = liftA2 Author field field

data Collection = Collection
  { collId :: Int
  , collName :: Text
  } deriving Show
instance FromRow Collection where fromRow = liftA2 Collection field field

data Tag = Tag
  { tagId :: Int
  , tagName :: Text
  } deriving Show
instance FromRow Tag where fromRow = liftA2 Tag field field

data ResAuthor = ResAuthor
  { resAuthorId :: Int
  , resAuthorResId :: Int
  , resAuthorAuthId :: Int
  , resAuthorOrd :: Int
  } deriving Show
instance FromRow ResAuthor where fromRow = ResAuthor <$> field <*> field <*> field <*> field

data ResCollection = ResCollection
  { resCollId :: Int
  , resCollResId :: Int
  , resCollCollId :: Int
  } deriving Show
instance FromRow ResCollection where fromRow = liftA3 ResCollection field field field

data ResTag = ResTag
  { resTagId :: Int
  , resTagResId :: Int
  , resTagTagId :: Int
  } deriving Show
instance FromRow ResTag where fromRow = liftA3 ResTag field field field


main :: IO ()
main = do
  conn        <- open "david_dohaskell (1).sqlite3"

  resources   <- query_ conn "SELECT * from resource"       :: IO [Resource]
  authors     <- query_ conn "SELECT * from author"         :: IO [Author]
  collections <- query_ conn "SELECT * from collection"     :: IO [Collection]
  tags        <- query_ conn "SELECT * from tag"            :: IO [Tag]
  res_authors <- query_ conn "SELECT * from res_author"     :: IO [ResAuthor]
  res_colls   <- query_ conn "SELECT * from res_collection" :: IO [ResCollection]
  res_tags    <- query_ conn "SELECT * from resource_tag"   :: IO [ResTag]

  forM_ resources $ \r -> do
    T.putStrLn ("- title: " <> resTitle r)
    T.putStrLn ("  url: " <> resUrl r)

    let as :: [Author]
        as = map (\aid -> fromJust (find (\a -> authId a == aid) authors))
           . map resAuthorAuthId
           . sortOn resAuthorOrd
           . filter (\ar -> resAuthorResId ar == resId r)
           $ res_authors

    when (not (null as)) $ do
      T.putStrLn "  authors:"
      mapM_ (\a -> T.putStrLn ("    - " <> authName a)) as

    case resPub r of
      Nothing -> pure ()
      Just p  -> T.putStrLn ("  published: " <> tshow p)

    T.putStrLn ("  type: " <> resType r)

    let ts :: [Text]
        ts =
            sortOn T.toLower
          . map tagName
          . map (\tid -> fromJust (find (\t -> tagId t == tid) tags))
          . map resTagTagId
          . filter (\rt -> resTagResId rt == resId r)
          $ res_tags

    when (not (null ts)) $ do
      T.putStrLn "  tags:"
      mapM_ (\t -> T.putStrLn ("    - " <> t)) ts

    let cs :: [Text]
        cs =
            sortOn T.toLower
          . map collName
          . map (\cid -> fromJust (find (\c -> collId c == cid) collections))
          . map resCollCollId
          . filter (\rc -> resCollResId rc == resId r)
          $ res_colls

    when (not (null cs)) $ do
      T.putStrLn "  collections:"
      mapM_ (\c -> T.putStrLn ("    - " <> c)) cs

    T.putStrLn ""

  close conn

tshow = T.pack . show