Skip to content

Commit 5bbd2da

Browse files
ad-siad-si
committed
Upgrade to Stackage lts-21.15, clean up code, format code with fourmolu
1 parent e56141c commit 5bbd2da

13 files changed

+535
-382
lines changed

‎Setup.hs

+2
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,4 @@
11
import Distribution.Simple
2+
3+
24
main = defaultMain

‎app/Main.hs

+7-7
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
1-
21
module Main where
32

4-
import Network.Wai.Handler.Warp
5-
import Network.Wai.Middleware.RequestLogger hiding (destination)
6-
import Network.WebDav.Server
7-
8-
main :: IO ()
9-
main = run 20001 $ logStdoutDev $ webDavServer
3+
import Network.Wai.Handler.Warp (run)
4+
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
5+
import Network.WebDav.Server (webDavServer)
106

7+
8+
main :: IO ()
9+
main =
10+
run 20001 $ logStdoutDev webDavServer

‎fourmolu.yaml

+12
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
indentation: 2
2+
function-arrows: leading
3+
comma-style: leading
4+
import-export-style: diff-friendly
5+
indent-wheres: true
6+
record-brace-space: false
7+
newlines-between-decls: 2
8+
haddock-style: multi-line-compact
9+
let-style: auto
10+
in-style: left-align
11+
respectful: true
12+
unicode: never

‎package.yaml

+66
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,66 @@
1+
name: webdavServer
2+
version: '0.1.0.0'
3+
homepage: https://github.com/jamshidh/webdavServer#readme
4+
license: BSD3
5+
license-file: LICENSE
6+
author: Jamshid
7+
copyright: 2017 Jamshid
8+
category: Web
9+
extra-source-files:
10+
- README.md
11+
12+
dependencies:
13+
- aeson
14+
- base >= 4.7 && < 5
15+
- bytestring
16+
- directory
17+
- filepath
18+
- http-types
19+
- servant-foreign
20+
- servant-options
21+
- servant-server
22+
- time
23+
- unix
24+
- text
25+
- wai-extra
26+
- xml
27+
28+
library:
29+
source-dirs: src
30+
exposed-modules:
31+
- Network.WebDav.API
32+
- Network.WebDav.Constants
33+
- Network.WebDav.HTTPExtensions
34+
- Network.WebDav.Properties
35+
- Network.WebDav.Server
36+
language: GHC2021
37+
38+
executables:
39+
webdavServer-exe:
40+
main: Main.hs
41+
source-dirs: app
42+
ghc-options:
43+
- -threaded
44+
- -rtsopts
45+
- -with-rtsopts=-N
46+
dependencies:
47+
- base
48+
- wai-extra
49+
- warp
50+
- webdavServer
51+
language: GHC2021
52+
53+
tests:
54+
webdavServer-test:
55+
main: Spec.hs
56+
source-dirs: test
57+
ghc-options:
58+
- -threaded
59+
- -rtsopts
60+
- -with-rtsopts=-N
61+
dependencies:
62+
- base
63+
- webdavServer
64+
language: GHC2021
65+
66+
github: jamshidh/webdavServer

‎src/Network/WebDav/API.hs

+41-24
Original file line numberDiff line numberDiff line change
@@ -1,41 +1,58 @@
1-
{-# LANGUAGE
2-
DataKinds,
3-
FlexibleInstances,
4-
MultiParamTypeClasses,
5-
OverloadedStrings,
6-
RecordWildCards,
7-
TypeOperators
8-
#-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE ExplicitNamespaces #-}
93

104
module Network.WebDav.API where
115

126
import Data.ByteString (ByteString)
137

14-
15-
import Servant
16-
17-
18-
import Text.XML.Light
19-
20-
import Network.WebDav.HTTPExtensions
8+
import Network.WebDav.HTTPExtensions (Copy, Mkcol, Move, Propfind, XML)
219
import Network.WebDav.Properties
10+
import Servant (
11+
CaptureAll,
12+
Delete,
13+
Get,
14+
Header,
15+
JSON,
16+
OctetStream,
17+
PlainText,
18+
Proxy (..),
19+
Put,
20+
ReqBody,
21+
StdMethod (OPTIONS),
22+
Verb,
23+
type (:<|>),
24+
type (:>),
25+
)
26+
import Text.XML.Light (Element)
2227

2328

2429
type WebDavAPI =
25-
CaptureAll "segments" String :> Mkcol '[JSON] ()
26-
:<|> CaptureAll "segments" String :> ReqBody '[XML] Element :> Propfind '[XML] [PropResults]
27-
:<|> CaptureAll "segments" String :> Get '[PlainText] String
28-
:<|> CaptureAll "segments" String :> ReqBody '[OctetStream] ByteString :> Put '[JSON] ()
29-
:<|> CaptureAll "segments" String :> Delete '[JSON] ()
30-
:<|> CaptureAll "segments" String :> Header "Destination" String :> Move '[JSON] ()
31-
:<|> CaptureAll "segments" String :> Header "Destination" String :> Copy '[JSON] ()
32-
30+
CaptureAll "segments" String
31+
:> Mkcol '[JSON] ()
32+
:<|> CaptureAll "segments" String
33+
:> ReqBody '[JSON, XML] Element
34+
:> Propfind '[JSON, XML] [PropResults]
35+
:<|> CaptureAll "segments" String
36+
:> Get '[JSON, PlainText] String
37+
:<|> CaptureAll "segments" String
38+
:> ReqBody '[JSON, OctetStream] ByteString
39+
:> Put '[JSON] ()
40+
:<|> CaptureAll "segments" String
41+
:> Delete '[JSON] ()
42+
:<|> CaptureAll "segments" String
43+
:> Header "Destination" String
44+
:> Move '[JSON] ()
45+
:<|> CaptureAll "segments" String
46+
:> Header "Destination" String
47+
:> Copy '[JSON] ()
48+
49+
3350
-- :<|> Proppatch '[JSON] [Int]
3451
-- :<|> Lock '[JSON] [Int]
3552
-- :<|> Unlock '[JSON] [Int]
3653
-- :<|> Orderpatch '[JSON] [Int]
3754
-- :<|> Post '[JSON] [Int]
38-
55+
3956
-- :<|> Head '[JSON] [Int]
4057
-- :<|> Trace '[JSON] [Int]
4158

‎src/Network/WebDav/Constants.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
1+
module Network.WebDav.Constants where
12

23

3-
module Network.WebDav.Constants where
4+
fileBase :: FilePath
5+
fileBase = "/usr/share"
46

5-
fileBase::FilePath
6-
fileBase="/home/jim/webdav"
77

8-
webBase::String
9-
webBase="http://127.0.0.1:20001"
8+
webBase :: String
9+
webBase = "http://127.0.0.1:20001"

‎src/Network/WebDav/HTTPExtensions.hs

+26-42
Original file line numberDiff line numberDiff line change
@@ -1,47 +1,28 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE RecordWildCards #-}
14
{-# OPTIONS_GHC -fno-warn-orphans #-}
2-
{-# LANGUAGE
3-
DataKinds,
4-
FlexibleInstances,
5-
MultiParamTypeClasses,
6-
OverloadedStrings,
7-
RecordWildCards,
8-
TypeOperators
9-
#-}
105

116
module Network.WebDav.HTTPExtensions where
127

13-
{-
14-
import Control.Monad.IO.Class
15-
import Data.ByteString (ByteString)
16-
import qualified Data.ByteString as ByteString
17-
import qualified Data.ByteString.Char8 as Char8
18-
import qualified Data.ByteString.Lazy.Char8 as Lazy.Char8
19-
20-
import Data.List
21-
import Data.Traversable
22-
23-
import Network.HTTP.Types.URI
24-
-}
258
import Servant
269
import Servant.Foreign.Internal
27-
{-
28-
import System.Directory
29-
30-
import Network.Wai.Handler.Warp
31-
import Network.Wai.Middleware.AddHeaders
32-
import Network.Wai.Middleware.RequestLogger
33-
import Network.Wai.Middleware.Servant.Options
34-
-}
3510
import Text.XML.Light
36-
{-
37-
import Network.WebDav.Constants
38-
import Network.WebDav.Properties
39-
-}
4011

41-
data DavMethod = MKCOL | PROPFIND | PROPPATCH | LOCK | UNLOCK | ORDERPATCH | COPY | MOVE
12+
13+
data DavMethod
14+
= MKCOL
15+
| PROPFIND
16+
| PROPPATCH
17+
| LOCK
18+
| UNLOCK
19+
| ORDERPATCH
20+
| COPY
21+
| MOVE
4222

4323

4424
-- OPTIONS, GET, HEAD, POST, PUT, DELETE, TRACE, COPY, MOVE
25+
-- are already defined by Servant
4526

4627
instance ReflectMethod 'MKCOL where
4728
reflectMethod _ = "MKCOL"
@@ -55,38 +36,41 @@ instance ReflectMethod 'UNLOCK where
5536
reflectMethod _ = "UNLOCK"
5637
instance ReflectMethod 'ORDERPATCH where
5738
reflectMethod _ = "ORDERPATCH"
58-
--instance ReflectMethod 'HEAD where
39+
40+
41+
-- instance ReflectMethod 'HEAD where
5942
-- reflectMethod _ = "HEAD"
60-
--instance ReflectMethod 'TRACE where
43+
-- instance ReflectMethod 'TRACE where
6144
-- reflectMethod _ = "TRACE"
6245
instance ReflectMethod 'COPY where
6346
reflectMethod _ = "COPY"
6447
instance ReflectMethod 'MOVE where
6548
reflectMethod _ = "MOVE"
6649

6750

68-
6951
type Mkcol = Verb 'MKCOL 200
7052
type Propfind = Verb 'PROPFIND 207
7153
type Proppatch = Verb 'PROPPATCH 200
7254
type Lock = Verb 'LOCK 200
7355
type Unlock = Verb 'UNLOCK 200
7456
type Orderpatch = Verb 'ORDERPATCH 200
75-
--type Head = Verb 'HEAD 200
76-
--type Trace = Verb 'TRACE 200
57+
58+
59+
-- type Head = Verb 'HEAD 200
60+
-- type Trace = Verb 'TRACE 200
7761
type Copy = Verb 'COPY 200
7862
type Move = Verb 'MOVE 200
7963

64+
8065
data XML = XML
8166

67+
8268
instance MimeUnrender XML Element where
8369
mimeUnrender _ x =
8470
case parseXMLDoc x of
85-
Nothing -> Left $ "Bad XML Input: " ++ show x
86-
Just doc -> Right doc
71+
Nothing -> Left $ "Bad XML Input: " ++ show x
72+
Just doc -> Right doc
8773

8874

8975
instance Accept XML where
9076
contentType _ = "application/xml"
91-
instance NotFound where
92-

0 commit comments

Comments
 (0)