summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKjetil Orbekk <kjetil.orbekk@gmail.com>2015-09-11 20:48:45 -0400
committerKjetil Orbekk <kjetil.orbekk@gmail.com>2015-09-11 20:48:45 -0400
commit6768e16cfcc471674b0a65581cf1ea90ec2e6b98 (patch)
treefb877bc41d18c5b0b8dc1d74703bde9acd237446
Basic functionality to list directories.
-rw-r--r--LICENSE30
-rw-r--r--Setup.hs2
-rw-r--r--photos.cabal31
-rw-r--r--src/Data.hs9
-rw-r--r--src/Main.hs54
-rw-r--r--src/PhotoStore.hs20
-rw-r--r--stack.yaml5
7 files changed, 151 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..a3945cf
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Example Author Name (c) 2015
+
+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 Example Author Name 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. \ No newline at end of file
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/photos.cabal b/photos.cabal
new file mode 100644
index 0000000..3112609
--- /dev/null
+++ b/photos.cabal
@@ -0,0 +1,31 @@
+name: photos
+version: 0.1.0.0
+synopsis: Simple project template from stack
+description: Please see README.md
+homepage: http://github.com/githubuser/photos#readme
+license: BSD3
+license-file: LICENSE
+author: Example Author Name
+maintainer: example@example.com
+copyright: 2010 Author Here
+category: Web
+build-type: Simple
+cabal-version: >=1.10
+
+executable photos
+ hs-source-dirs: src
+ main-is: Main.hs
+ other-modules:
+ Data
+ , PhotoStore
+ default-language: Haskell2010
+ build-depends:
+ base >= 4.7 && < 5
+ , servant
+ , servant-server
+ , aeson
+ , warp
+ , wai
+ , hflags
+ , directory
+ , transformers
diff --git a/src/Data.hs b/src/Data.hs
new file mode 100644
index 0000000..d40c95b
--- /dev/null
+++ b/src/Data.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Data where
+
+import GHC.Generics
+
+data Album = Album
+ { name :: String
+ , pending :: Bool
+ } deriving (Eq, Show, Generic)
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..c40af76
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Data.Aeson
+import GHC.Generics
+import Network.Wai
+import Network.Wai.Handler.Warp
+import Servant
+import HFlags
+import System.Exit
+import Control.Monad
+import Data
+import PhotoStore
+import Control.Monad.IO.Class
+
+defineFlag "port" (8081 :: Int) "Port to serve on"
+defineFlag "host" ("*6" :: String) "Host to serve on (*6 for ipv6 mode)"
+defineFlag "pending_path" ("" :: String) "Path to pending albums"
+defineFlag "photos_path" ("" :: String) "Path to permanent albums"
+$(return [])
+
+instance ToJSON Album
+
+type PhotoApi = "albums" :> Get '[JSON] [Album]
+
+config = Config
+ { pendingPath = flags_pending_path
+ , photosPath = flags_photos_path
+ }
+
+server :: Server PhotoApi
+server = liftIO (getAlbums config)
+
+photoApi :: Proxy PhotoApi
+photoApi = Proxy
+
+app :: Application
+app = serve photoApi server
+
+port = 8081
+settings :: Settings
+settings = setHost "*6" . setPort 8081 $ defaultSettings
+
+main :: IO ()
+main = do
+ $initHFlags "photos"
+ when (flags_pending_path == "") (die "--pending_path must be specified")
+ when (flags_photos_path == "") (die "--photos_path must be specified")
+ putStrLn $ "Starting server on port: " ++ (show port)
+ runSettings settings app
diff --git a/src/PhotoStore.hs b/src/PhotoStore.hs
new file mode 100644
index 0000000..57b2ccc
--- /dev/null
+++ b/src/PhotoStore.hs
@@ -0,0 +1,20 @@
+module PhotoStore where
+
+import Data
+import System.Directory
+
+data Config = Config
+ { pendingPath :: String
+ , photosPath :: String
+ }
+
+validAlbumName name =
+ name /= "."
+ && name /= ".."
+
+getAlbums :: Config -> IO [Album]
+getAlbums config = do
+ pending <- getDirectoryContents (pendingPath config)
+ permanent <- getDirectoryContents (photosPath config)
+ return ([Album name True | name <- filter validAlbumName pending] ++
+ [Album name False | name <- filter validAlbumName permanent])
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..bee0443
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,5 @@
+flags: {}
+packages:
+- '.'
+extra-deps: []
+resolver: lts-3.4