Cleaning up

src/Aggreact.hs

@@ -109,7 +109,7 @@ initialize :: Conf -> IO (Settings,Application)
 initialize Conf{..} = do
   uh <- newUserHandler userDBConf defaultAdminUser
   ch <- newCommentHandler (dbstore uh) commentDBConf
-  sh <- newSlugHandler (dbstore uh) slugDBConf
+  sh <- newSlugHandler slugDBConf
   ah <- newAuthorizationHandler authorizationStrategy
   myKey <- readKey jwtKeyFilePath
   let jwtSettings = defaultJWTSettings myKey

src/Aggreact/Slugs/StoreService.hs

@@ -43,12 +43,11 @@ import           Protolude
 
 --------------------------------------------------------------------------------
 import           Aggreact.Slugs.Types
-import qualified Aggreact.User                 as User
 
 --------------------------------------------------------------------------------
 import           Data.Time.Clock.Serialize     ()
 import           Data.Time.Format              ()
-import           Database.SQLite.Simple        (Only (..), query, query_)
+import           Database.SQLite.Simple        (query_)
 
 import           Database.Store                (DefaultMetas (..), Id (..),
                                                 Store (..))
@@ -105,10 +104,9 @@ data SlugHandler =
   }
 
 -- | Init a new slug handler
-newSlugHandler :: User.DBStore
-               -> SlugDBConf
+newSlugHandler :: SlugDBConf
                -> IO SlugHandler
-newSlugHandler userStore conf = do
+newSlugHandler conf = do
   dbstore <- initDBSlugs conf
   pure SlugHandler { createSlug     = createSlug' dbstore
                    , readSlug       = readSlug' dbstore

src/Aggreact/Slugs/Types.hs

@@ -54,21 +54,15 @@ import           Protolude
 
 import           Aggreact.User                    (User,UserId)
 
-import qualified Control.Exception                as Ex
 import           Data.Aeson                       (FromJSON (..), ToJSON (..),
                                                    defaultOptions,
                                                    genericParseJSON,
                                                    genericToJSON)
-import           Data.Char                        (isAlphaNum)
 import           Data.Data                        (Data (..))
 import qualified Data.IxSet.Typed                 as IxSet
-import qualified Data.Text                        as Text
 import           Data.Time.Clock.Serialize        ()
 import           Data.Time.Format                 ()
 import           Data.Typeable                    (Typeable)
-import           Data.UUID                        (UUID)
-import qualified Data.UUID                        as UUID
-import           Database.SQLite.Simple           (SQLData (..))
 import           Database.SQLite.Simple.FromField (FromField (..))
 import           Database.SQLite.Simple.FromRow   (FromRow (..), field)
 import           Database.SQLite.Simple.ToRow     (ToRow (..))

src/Service/Config.hs

@@ -48,7 +48,8 @@ import Data.Yaml
 import System.FilePath
 
 data ConfigService a
-newtype ConfigServiceConfig =  ConfigServiceConfig { configFile :: FilePath }
+newtype ConfigServiceConfig conf =
+  ConfigServiceConfig { config :: Either conf FilePath }
 newtype ConfigSvc a = ConfigSvc { getConfig :: a }
 
 {-
@@ -60,16 +61,19 @@ instance ( a ~ b
          , Interpret b
          , FromJSON b
          ) => Service (ConfigService a) b where
-  type Config (ConfigService a) b = ConfigServiceConfig
+  type Config (ConfigService a) b = ConfigServiceConfig b
   type Handle (ConfigService a) b = ConfigSvc b
   init _ ConfigServiceConfig{..} = ConfigSvc <$>
-    case takeExtension configFile of
-      ".dhall" -> input auto (toS configFile)
-      ".json" -> parseyaml -- json are yaml
-      ".yaml" -> parseyaml
-      _ -> die "unrecognized format (only .dhall, .json and .yaml are supported)"
+    case config of
+      Left c -> return c
+      Right configFile ->
+        case takeExtension configFile of
+          ".dhall" -> input auto (toS configFile)
+          ".json" -> parseyaml configFile -- json are yaml
+          ".yaml" -> parseyaml configFile
+          _ -> die "unrecognized format (only .dhall, .json and .yaml are supported)"
     where
-      parseyaml = do
+      parseyaml configFile = do
         parseResult <- decodeFileEither configFile
         case parseResult of
           Left err -> die ("Error while parsing " <> toS configFile <> ":\n"

src/Service/Service.hs

@@ -42,4 +42,3 @@ class Service s a where
   withService :: Config s a -> (Handle s a -> IO b) -> IO b
   withService config = bracket (init svc config) (stop svc)
     where svc = Proxy :: Proxy (Service s a)
-