Remove weeds

Author: NickSeagull

.hlint.yaml

@@ -0,0 +1,67 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+# This file contains a template configuration file, which is typically
+# placed as .hlint.yaml in the root of your project
+
+
+# Specify additional command line arguments
+#
+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
+
+
+# Control which extensions/flags/modules/functions can be used
+#
+- extensions:
+  - name:
+    - TemplateHaskell
+    - OverloadedStrings
+    - RecordWildCards
+    - ScopedTypeVariables
+    - DeriveGeneric
+    - TypeApplications
+    - FlexibleContexts
+    - DeriveAnyClass
+    - QuasiQuotes
+#
+# - flags:
+#   - {name: -w, within: []} # -w is allowed nowhere
+#
+# - modules:
+#   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
+#   - {name: Control.Arrow, within: []} # Certain modules are banned entirely
+#
+# - functions:
+#   - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
+
+
+# Add custom hints for this project
+#
+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
+
+
+# Turn on hints that are off by default
+#
+# Ban "module X(module X) where", to require a real export list
+# - warn: {name: Use explicit module export list}
+#
+# Replace a $ b $ c with a . b $ c
+# - group: {name: dollar, enabled: true}
+#
+# Generalise map to fmap, ++ to <>
+# - group: {name: generalise, enabled: true}
+
+
+# Ignore some builtin hints
+# - ignore: {name: Use let}
+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
+
+
+# Define some custom infix operators
+# - fixity: infixr 3 ~^#^~
+
+
+# To generate a suitable file for HLint do:
+# $ hlint --default > .hlint.yaml

package.yaml

@@ -16,25 +16,21 @@ description: Please see the README on GitHub at <https://github.com/theam/aws-la
 
 dependencies:
   - base >= 4.7 && < 5
-  - mtl
-  - http-client
 
 library:
   dependencies:
     - aeson
     - bytestring
-    - case-insensitive
-    - conduit
-    - directory
-    - filepath
+    - http-client
     - http-types
-    - microlens-platform
     - optparse-generic
     - process
     - template-haskell
     - text
     - uuid
     - safe-exceptions-checked
+    - path
+    - path-io
   source-dirs: src
   exposed-modules:
     - Aws.Lambda
@@ -46,6 +42,7 @@ executables:
     main: Main.hs
     dependencies:
       - aws-lambda-haskell-runtime
+      - http-client
 
 tests:
   aws-lambda-haskell-runtime-test:
@@ -67,6 +64,7 @@ default-extensions:
   - TypeApplications
   - FlexibleContexts
   - DeriveAnyClass
+  - QuasiQuotes
 
 ghc-options:
   - -Wall

src/Aws/Lambda/Configuration.hs

@@ -12,24 +12,19 @@ where
 import Data.Aeson
 
 import Control.Monad
-import Control.Monad.Trans
 import qualified Data.ByteString.Lazy as LazyByteString
-import qualified Data.Conduit as Conduit
 import Data.Function ((&))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Encoding
-import Data.Void
 import GHC.Generics
 import Language.Haskell.TH
 import qualified Options.Generic as Options
-import qualified System.Directory as Directory
 import System.Exit (exitFailure, exitSuccess)
-import System.FilePath ((</>))
 import System.IO (hFlush, stderr, stdout)
-import System.IO.Error
-
 
+import Path
+import qualified Path.IO as PathIO
 
 import Aws.Lambda.ThHelpers
 
@@ -69,12 +64,11 @@ dispatcherCaseQ fileNames = do
 
 handlerCaseQ :: Text -> Q Match
 handlerCaseQ lambdaHandler = do
-  let pattern = LitP (StringL $ Text.unpack lambdaHandler)
+  let pat = LitP (StringL $ Text.unpack lambdaHandler)
   body <- [e|do
     result <- $(eName qualifiedName) (decodeObj $(eName "eventObject")) (decodeObj $(eName "contextObject"))
-    either (returnAndFail $(eName "executionUuid")) (returnAndSucceed $(eName "executionUuid")) result
-    |]
-  pure $ Match pattern (NormalB body) []
+    either (returnAndFail $(eName "executionUuid")) (returnAndSucceed $(eName "executionUuid")) result |]
+  pure $ Match pat (NormalB body) []
  where
   qualifiedName =
     lambdaHandler
@@ -123,51 +117,11 @@ decodeObj x =
     Left e  -> error e
     Right v -> v
 
-
-data DirContent = DirList [FilePath] [FilePath]
-                | DirError IOError
-data DirData = DirData FilePath DirContent
-
-
--- Produces directory data
-walk :: FilePath -> Conduit.ConduitM () DirData IO ()
-walk path = do
-  result <- lift $ tryIOError listdir
-  case result of
-    Right dl@(DirList subdirs _) -> do
-      Conduit.yield (DirData path dl)
-      forM_ subdirs (walk . (path </>))
-    Right e -> Conduit.yield (DirData path e)
-    Left e -> Conduit.yield (DirData path (DirError e))
- where
-  listdir = do
-    entries <- filterHidden <$> Directory.getDirectoryContents path
-    subdirs <- filterM isDir entries
-    files   <- filterM isFile entries
-    return $ DirList subdirs files
-   where
-    isFile entry = Directory.doesFileExist (path </> entry)
-    isDir entry = Directory.doesDirectoryExist (path </> entry)
-    filterHidden paths = filter (\p -> head p /= '.' && p /= "node_modules") paths
-
-
--- Consume directories
-myVisitor :: Conduit.ConduitM DirData Void IO [FilePath]
-myVisitor = loop []
- where
-  loop n = do
-    r <- Conduit.await
-    case r of
-      Nothing     -> return n
-      Just result -> loop (process result <> n)
-  process (DirData _ (DirError _))        = []
-  process (DirData dir (DirList _ files)) = map (\f -> dir <> "/" <> f) files
-
-
 getHandlers :: IO [Text]
 getHandlers = do
-  files <- Conduit.runConduit $ walk "." Conduit..| myVisitor
+  (_, files) <- PathIO.listDirRecurRel [reldir|.|]
   handlerFiles <- files
+                   & fmap toFilePath
                    & fmap Text.pack
                    & filter (Text.isSuffixOf ".hs")
                    & filterM containsHandler

src/Aws/Lambda/Runtime/Error.hs

@@ -1,7 +1,5 @@
 module Aws.Lambda.Runtime.Error
   ( EnvironmentVariableNotSet(..)
-  , ApiConnection(..)
-  , ApiHeaderNotSet(..)
   , Parsing(..)
   , Invocation(..)
   ) where
@@ -19,26 +17,6 @@ instance ToJSON EnvironmentVariableNotSet where
     , "errorMessage" .= msg
     ]
 
-data ApiConnection =
-  ApiConnection
-  deriving (Show, Exception)
-
-instance ToJSON ApiConnection where
-  toJSON ApiConnection = object
-    [ "errorType" .= ("ApiConnection" :: String)
-    , "errorMessage" .= ("Could not connect to API to retrieve AWS Lambda parameters" :: String)
-    ]
-
-newtype ApiHeaderNotSet =
-  ApiHeaderNotSet String
-  deriving (Show, Exception)
-
-instance ToJSON ApiHeaderNotSet where
-  toJSON (ApiHeaderNotSet headerName) = object
-    [ "errorType" .= ("ApiHeaderNotSet" :: String)
-    , "errorMessage" .= headerName
-    ]
-
 data Parsing = Parsing
   { errorMessage :: String
   , actualValue  :: String