Export list on Foundation

src/Foundation.hs

-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE InstanceSigs               #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE InstanceSigs          #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeFamilies          #-}
 
-module Foundation where
+module Foundation
+  ( App(..)
+  , Handler
+  , Widget
+  , Form
+  , Route(..)
+  , resourcesApp
+  , unsafeHandler
+  ) where
 
 import qualified Calendar             as Cal
 import qualified Control.Monad.Catch  as MC
@@ -41,16 +48,6 @@ data App = App
     -- 'appCacheExpiry'.
   }
 
-data MenuItem = MenuItem
-  { menuItemLabel          :: Text
-  , menuItemRoute          :: Route App
-  , menuItemAccessCallback :: Bool
-  }
-
-data MenuTypes
-  = NavbarLeft MenuItem
-  | NavbarRight MenuItem
-
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
 -- http://www.yesodweb.com/book/routing-and-handlers
@@ -85,10 +82,7 @@ addScriptL route cdn attrs =
 
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
-instance Yesod App
-    -- Controls the base of generated URLs. For more information on modifying,
-    -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
-                                                                      where
+instance Yesod App where
   approot :: Approot App
   approot =
     ApprootRequest $ \app req ->
@@ -219,10 +213,3 @@ instance HasHttpManager App where
 
 unsafeHandler :: App -> Handler a -> IO a
 unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
--- Note: Some functionality previously present in the scaffolding has been
--- moved to documentation in the Wiki. Following are some hopefully helpful
--- links:
---
--- https://github.com/yesodweb/yesod/wiki/Sending-email
--- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
--- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding

src/Settings.hs

@@ -17,8 +17,9 @@ module Settings
   , TZLabelW
   , tzByLabel
   , Location(..)
+  , varGoogleClientId
+  , varGoogleSecret
   , varGoogleRefreshToken
-  , oauthClientFromEnv
   , compileTimeAppSettings
   , configSettingsYmlValue
   , widgetFile
@@ -39,21 +40,20 @@ import           Data.Time.Zones.All        (TZLabel, fromTZName, toTZName)
 import qualified Data.Time.Zones.All        as TZ
 import           Data.Yaml                  (decodeEither')
 import           Language.Haskell.TH.Syntax (Exp, Name, Q)
-import           Network.Google.Auth        (ClientId (..), OAuthClient (..),
-                                             Secret (..))
 import           Network.Wai.Handler.Warp   (HostPreference)
-import           System.Environment         (getEnv)
 import           Yesod.Default.Config2      (applyEnvValue, configSettingsYml)
 import           Yesod.Default.Util         (WidgetFileSettings,
                                              widgetFileNoReload,
                                              widgetFileReload)
 
+-- | Represent a location for an appointment
 data Location = Location
-  { locId     :: Text
-  , locSearch :: Text
-  , locDescr  :: Text
+  { locId     :: Text -- ^ Arbitrary identifier slug used as a path piece
+  , locSearch :: Text -- ^ Search string, can be blank to allow all available slots
+  , locDescr  :: Text -- ^ Description of location
   } deriving (Show, Eq)
 
+-- | Construct locations, adding IDs like "locA", "locB".
 makeLocs :: [(Text, Text)] -> [Location]
 makeLocs = zipWith mk ['A' ..]
   where
@@ -93,19 +93,29 @@ data AppSettings = AppSettings
   , appAnalytics              :: Maybe Text
     -- ^ Google Analytics code
   , appCredentials            :: Cal.Credentials
+    -- ^ Credentials needed for accessing the calendar
   , appDefaultTimeZone        :: TZLabelW
+    -- ^ Default time zone
   , appLocations              :: [Location]
-  , appFreeCalendarId         :: Text
-  , appBusyCalendarId         :: Text
+    -- ^ Available locations for appointments
+  , appFreeCalendarId         :: Cal.CalendarId
+    -- ^ Calender specifying available time slots
+  , appBusyCalendarId         :: Cal.CalendarId
+    -- ^ Calendar specifying busy times
   , appLookaheadWeeks         :: Int
+    -- ^ How far to look ahead when fetching calendar events
   , appApptLengthsMinutes     :: [Int]
+    -- ^ Valid lengths of appointments, in minutes
   , appCacheExpiry            :: NominalDiffTime
+    -- ^ Cached calendar data older than this will be refreshed
   }
 
+-- | Wrap a time zone label, so we can specify type classes.
 newtype TZLabelW = TZLabelW
   { unwrapTZLabel :: TZLabel
-  } deriving (Eq, Show, Read)
+  } deriving (Eq, Show)
 
+-- | Look up the time zone spec for given label.
 tzByLabel :: TZLabelW -> TZ
 tzByLabel = TZ.tzByLabel . unwrapTZLabel
 
@@ -163,8 +173,7 @@ widgetFileSettings = def
 combineSettings :: CombineSettings
 combineSettings = def
 
--- The rest of this file contains settings which rarely need changing by a
--- user.
+-- | Load a widget from files with or without dynamic reload.
 widgetFile :: String -> Q Exp
 widgetFile =
   (if appReloadTemplates compileTimeAppSettings
@@ -188,29 +197,26 @@ compileTimeAppSettings =
     Error e          -> error e
     Success settings -> settings
 
--- The following two functions can be used to combine multiple CSS or JS files
--- at compile time to decrease the number of http requests.
--- Sample usage (inside a Widget):
---
--- > $(combineStylesheets 'StaticR [style1_css, style2_css])
+-- | Combine CSS files at compile time to decrease the number of HTTP
+-- requests.
 combineStylesheets :: Name -> [Route Static] -> Q Exp
 combineStylesheets =
   combineStylesheets' (appSkipCombining compileTimeAppSettings) combineSettings
 
+-- | Combine JS files at compile time to decrease the number of HTTP
+-- requests.
 combineScripts :: Name -> [Route Static] -> Q Exp
 combineScripts =
   combineScripts' (appSkipCombining compileTimeAppSettings) combineSettings
 
+-- | Environment variable used for Google client ID.
 varGoogleClientId :: IsString s => s
 varGoogleClientId = "BOOKME_GOOGLE_ID"
 
+-- | Environment variable used for Google client secret.
 varGoogleSecret :: IsString s => s
 varGoogleSecret = "BOOKME_GOOGLE_SECRET"
 
+-- | Environment variable used for Google refresh token.
 varGoogleRefreshToken :: IsString s => s
 varGoogleRefreshToken = "BOOKME_GOOGLE_REFRESH"
-
-oauthClientFromEnv :: IO OAuthClient
-oauthClientFromEnv =
-  OAuthClient <$> (ClientId . pack <$> getEnv varGoogleClientId) <*>
-  (Secret . pack <$> getEnv varGoogleSecret)

src/Settings/Auth.hs

-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 {-|
 Module: Settings.Auth
-Description: TODO
+Description: Helper program to create Google refresh token
 
-TODO
+Given the client ID and secret, this program generates an oauth URL
+and after approval, a refresh token.
 -}
 module Settings.Auth
   ( authorizeMain
   ) where
 
-import qualified Calendar as Cal
+import qualified Calendar                    as Cal
 import           Import
-import           Network.Google              (LogLevel (Error), newLogger)
+import           Network.Google              (ClientId (..), LogLevel (Error),
+                                              Secret (..), newLogger)
 import           Network.Google.AppsCalendar (calendarScope)
 import           Network.Google.Auth         (Auth (..),
                                               Credentials (FromClient),
-                                              OAuthCode (..), OAuthToken (..),
+                                              OAuthClient (..), OAuthCode (..),
+                                              OAuthToken (..),
                                               RefreshToken (..), exchange,
                                               formURL)
 import           Network.HTTP.Client.TLS     (tlsManagerSettings)
+import           System.Environment          (getEnv)
+
+oauthClientFromEnv :: IO OAuthClient
+oauthClientFromEnv =
+  OAuthClient <$> (ClientId . pack <$> getEnv varGoogleClientId) <*>
+  (Secret . pack <$> getEnv varGoogleSecret)
 
 authorizeMain :: IO ()
 authorizeMain = do