First commit. Have a draft of separating the README examples into functions and running them on a test sqlite DB

examples/Blog.hs

@@ -0,0 +1,189 @@
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+
+import           Control.Monad           (void)
+import           Control.Monad.IO.Class  (MonadIO, liftIO)
+import           Data.Text               (Text)
+import           Database.Esqueleto
+import           Database.Persist.Sqlite (runMigration, runSqlite)
+import           Database.Persist.TH     (mkMigrate, mkPersist,
+                                          persistLowerCase, share, sqlSettings)
+
+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+  Person
+    name String
+    age Int Maybe
+    deriving Eq Show
+  BlogPost
+    title String
+    authorId PersonId
+    deriving Eq Show
+  Follow
+    follower PersonId
+    followed PersonId
+    deriving Eq Show
+|]
+
+putPersons :: (MonadIO m)
+           => SqlPersistT m ()
+putPersons = do
+  people <- select $
+              from $ \person -> do
+              return person
+  liftIO $ mapM_ (putStrLn . personName . entityVal) people
+
+getJohns :: (MonadIO m)
+         => SqlReadT m [Entity Person]
+getJohns =
+  select $
+  from $ \p -> do
+    where_ (p ^. PersonName ==. val "John")
+    return p
+
+getJaoas :: (MonadIO m)
+         => SqlReadT m [Entity Person]
+getJaoas =
+  select $
+  from $ \p -> do
+    where_ (p ^. PersonName ==. val "João" ||. p ^. PersonName ==. val "Joao")
+    return p
+
+getAdults :: (MonadIO m)
+          => SqlReadT m [Entity Person]
+getAdults =
+  select $
+  from $ \p -> do
+    where_ (p ^. PersonAge >=. just (val 18))
+    return p
+
+getBlogPostsByAuthors :: (MonadIO m)
+                      => SqlReadT m [(Entity BlogPost, Entity Person)]
+getBlogPostsByAuthors =
+  select $
+  from $ \(b, p) -> do
+    where_ (b ^. BlogPostAuthorId ==. p ^. PersonId)
+    orderBy [asc (b ^. BlogPostTitle)]
+    return (b, p)
+
+getAuthorMaybePosts :: (MonadIO m)
+                    => SqlReadT m [(Entity Person, Maybe (Entity BlogPost))]
+getAuthorMaybePosts =
+  select $
+  from $ \(p `LeftOuterJoin` mb) -> do
+    on (just (p ^. PersonId) ==. mb ?. BlogPostAuthorId)
+    orderBy [asc (p ^. PersonName), asc (mb ?. BlogPostTitle)]
+    return (p, mb)
+
+followers :: (MonadIO m)
+          => SqlReadT m [(Entity Person, Entity Follow, Entity Person)]
+followers =
+  select $
+  from $ \(p1 `InnerJoin` f `InnerJoin` p2) -> do
+    on (p2 ^. PersonId ==. f ^. FollowFollowed)
+    on (p1 ^. PersonId ==. f ^. FollowFollower)
+    return (p1, f, p2)
+
+updateJoao :: (MonadIO m)
+           => SqlWriteT m ()
+updateJoao =
+  update $ \p -> do
+    set p [ PersonName =. val "João" ]
+    where_ (p ^. PersonName ==. val "Joao")
+
+deleteYoungsters :: (MonadIO m)
+                 => SqlWriteT m ()
+deleteYoungsters =
+  delete $
+    from $ \p -> do
+    where_ (p ^. PersonAge <. just (val 14))
+
+insertBlogPosts :: (MonadIO m)
+                => SqlWriteT m ()
+insertBlogPosts =
+  insertSelect $ from $ \p ->
+    return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId)
+
+testDb :: (MonadIO m)
+       => SqlWriteT m ()
+testDb = do
+  john <- insert $ Person "John" (Just 24)
+  sean <- insert $ Person "Seán" (Just 70)
+  joao <- insert $ Person "Joao" (Just 13)
+  void $ insertMany [ BlogPost "How to play a bodhrán" sean
+                    , BlogPost "Haskell for the working class hero" john
+                    ]
+  void $ insert $ Follow john sean
+  void $ insert $ Follow sean john
+  void $ insert $ Follow joao sean
+
+arith :: Num b => (a -> b) -> Integer -> a -> b
+arith f i a = (f a) + fromInteger i
+
+main :: IO ()
+main = runSqlite ":memory:" $ do
+  runMigration migrateAll
+  testDb
+
+  printMessage "Listing all names of the people in the database"
+  printMessage "==============================================="
+  putPersons
+  printMessage "==============================================="
+
+  printMessage "Listing all the people with the name John:"
+  printMessage "==============================================="
+  getJohns >>= printVals
+  printMessage "==============================================="
+
+  printMessage "Listing all people of the age 18 or over"
+  printMessage "==============================================="
+  getAdults >>= printVals
+  printMessage "==============================================="
+
+  printMessage "Listing all Blog Posts and their Authors"
+  printMessage "==============================================="
+  getBlogPostsByAuthors >>= printVals2
+  printMessage "==============================================="
+
+  printMessage "Listing all Authors and their possible Blog Posts"
+  printMessage "==============================================="
+  getAuthorMaybePosts >>= mapM_ print'
+  printMessage "==============================================="
+
+  printMessage "Listing all mutual Followers"
+  printMessage "==============================================="
+  followers >>= mapM_ print'
+  printMessage "==============================================="
+
+  printMessage "Updating Jaoa and checking the update"
+  printMessage "==============================================="
+  updateJoao
+  getJaoas >>= printVals
+  printMessage "==============================================="
+
+  printMessage "Deleting poor Jaoa because he is too young"
+  printMessage "==============================================="
+  deleteYoungsters
+  getJaoas >>= printVals
+  printMessage "==============================================="
+  where
+    -- | Helper for print Text and getting rid of pesky warnings to default
+    -- | literals to [Char]
+    printMessage :: (MonadIO m) => Text -> m ()
+    printMessage = liftIO . print
+
+    -- | Helper function for printing in our DB environment
+    print' :: (MonadIO m, Show a) => a -> m ()
+    print' = liftIO . print
+
+    -- | Helper to extract the entity values and print each one
+    printVals = liftIO . mapM_ (print . entityVal)
+
+    -- | TODO: Scrap this for something better
+    printVals2 = liftIO . mapM_ (print . both entityVal entityVal)
+    both f g (a, b) = (f a, g b)

examples/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2012, Felipe Lessa
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Felipe Lessa nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

examples/README.md

@@ -0,0 +1,3 @@
+# Esqueleto Examples
+
+These examples can be build via `stack build`.

examples/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

examples/package.yaml

@@ -0,0 +1,35 @@
+name: esqueleto-examples
+version: '0.0.0.0'
+category: Database
+author: Fintan Halpenny
+maintainer: fintan.halpenny@gmail.com
+copyright: 2017, Chris Allen
+license: BSD3
+github: FintanH/esqueleto
+extra-source-files:
+- README.md
+dependencies:
+- base
+- esqueleto
+- persistent
+- persistent-template
+- persistent-sqlite
+- text
+ghc-options:
+- -Wall
+- -threaded
+- -rtsopts
+- -with-rtsopts=-N
+when:
+- condition: flag(werror)
+  ghc-options: -Werror
+
+executables:
+  blog-example:
+    main: Blog.hs
+
+flags:
+  werror:
+    description: "Treat warnings as errors"
+    manual: true
+    default: false