From b8821e100e0d8b02cde5392a2bb7d5f71428de87 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 15 Sep 2018 15:20:50 +0200 Subject: Disable thermoprint via flag --- .gitignore | 1 + Foundation.hs | 2 +- Handler/Common.hs | 3 +- Handler/Common/Types.hs | 2 - Handler/List.hs | 29 +++++--- Import/NoFoundation.hs | 1 - Model.hs | 5 +- Model/Types.hs | 2 - Settings.hs | 9 ++- bar.cabal | 140 ----------------------------------- package.yaml | 106 ++++++++++++++++++++++++++ stack.nix | 14 ++++ stack.yaml | 28 ++++--- templates/list-no-thermoprint.hamlet | 8 ++ 14 files changed, 179 insertions(+), 171 deletions(-) delete mode 100644 bar.cabal create mode 100644 package.yaml create mode 100644 stack.nix create mode 100644 templates/list-no-thermoprint.hamlet diff --git a/.gitignore b/.gitignore index 5747830..d72cafe 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,4 @@ cabal.sandbox.config **/.gup static/webshim/ static/jquery.js +bar.cabal diff --git a/Foundation.hs b/Foundation.hs index 22e5d49..7c44498 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -39,7 +39,7 @@ data MenuItem = MenuItem mkYesodData "App" $(parseRoutesFile "config/routes") -- | A convenient synonym for creating forms. -type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) +type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget) -- Please see the documentation for the Yesod typeclass. There are a number -- of settings which can be configured by overriding methods here. diff --git a/Handler/Common.hs b/Handler/Common.hs index 88cbd8d..11a9431 100644 --- a/Handler/Common.hs +++ b/Handler/Common.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE ApplicativeDo + #-} module Handler.Common ( inventoryListing diff --git a/Handler/Common/Types.hs b/Handler/Common/Types.hs index 9150f16..491468c 100644 --- a/Handler/Common/Types.hs +++ b/Handler/Common/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE FunctionalDependencies #-} - module Handler.Common.Types where import Import diff --git a/Handler/List.hs b/Handler/List.hs index 522f6f5..a2194ba 100644 --- a/Handler/List.hs +++ b/Handler/List.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE PatternGuards #-} - module Handler.List where import Import @@ -12,8 +10,18 @@ import qualified Data.Map as Map import qualified Data.Text as Text import qualified Data.Text.Lazy as Lazy.Text +#ifdef THERMOPRINT import Thermoprint.Client +mkPrintout :: Set (WithType Text) -> Printout +mkPrintout list = Printout ps + where + ps = Map.foldMapWithKey (fmap (pure . Paragraph . pure . Cooked) . toLines) $ group list + group = Map.fromListWith (<>) . fmap (\(kind `WithType` t) -> (t, Set.singleton kind)) . Set.toAscList + toLines t (Set.toAscList -> kinds) = either id Line . text . Lazy.Text.fromStrict . Text.unlines $ + pure t ++ map (" - " <>) kinds +#endif + list :: Handler (Set (WithType Text)) list = runDB $ do today <- liftIO $ utctDay <$> getCurrentTime @@ -34,14 +42,8 @@ list = runDB $ do return $ Set.map (fmap referenceKind) references' -mkPrintout :: Set (WithType Text) -> Printout -mkPrintout list = Printout ps - where - ps = Map.foldMapWithKey (fmap (pure . Paragraph . pure . Cooked) . toLines) $ group list - group = Map.fromListWith (<>) . fmap (\(kind `WithType` t) -> (t, Set.singleton kind)) . Set.toAscList - toLines t (Set.toAscList -> kinds) = either id Line . text . Lazy.Text.fromStrict . Text.unlines $ - pure t ++ map (" - " <>) kinds +#ifdef THERMOPRINT getListR, postListR :: Handler TypedContent getListR = postListR postListR = do @@ -99,3 +101,12 @@ postListR = do selectRep $ do provideJson $ typeToJSON "item" <$> Set.toAscList list provideRep $ defaultLayout $(widgetFile "list") +#else +getListR, postListR :: Handler TypedContent +getListR = postListR +postListR = do + list <- list + selectRep $ do + provideJson $ typeToJSON "item" <$> Set.toAscList list + provideRep $ defaultLayout $(widgetFile "list-no-thermoprint") +#endif diff --git a/Import/NoFoundation.hs b/Import/NoFoundation.hs index 1a5b107..7fe2807 100644 --- a/Import/NoFoundation.hs +++ b/Import/NoFoundation.hs @@ -8,7 +8,6 @@ import Model as Import import Model.Types as Import import Settings as Import import Settings.StaticFiles as Import -import Yesod.Auth as Import import Yesod.Core.Types as Import (loggerSet) import Yesod.Default.Config2 as Import import Yesod.EmbeddedStatic as Import diff --git a/Model.hs b/Model.hs index 6d0fd04..02d3387 100644 --- a/Model.hs +++ b/Model.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE GeneralizedNewtypeDeriving + #-} module Model where diff --git a/Model/Types.hs b/Model/Types.hs index 61bebfd..5e2a6ef 100644 --- a/Model/Types.hs +++ b/Model/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Model.Types ( ItemDate(..) , isNever, isUnknown, isKnown diff --git a/Settings.hs b/Settings.hs index 8a98c7a..a79f6f8 100644 --- a/Settings.hs +++ b/Settings.hs @@ -1,4 +1,3 @@ -{-# Language CPP #-} -- | Settings are centralized, as much as possible, into this file. This -- includes database connection settings, static file locations, etc. -- In addition, you can configure a number of different aspects of Yesod @@ -19,7 +18,9 @@ import Yesod.Default.Config2 (applyEnvValue, configSettingsYml) import Yesod.Default.Util (WidgetFileSettings, widgetFileNoReload, widgetFileReload) +#ifdef THERMOPRINT import Thermoprint.Client (BaseUrl(..), parseBaseUrl) +#endif #ifdef DEVELOPMENT #define DEV_BOOL True @@ -51,13 +52,14 @@ data AppSettings = AppSettings , appReloadTemplates :: Bool -- ^ Use the reload version of templates +#ifdef THERMORPINT , appThermoprintBase :: BaseUrl +#endif } instance FromJSON AppSettings where parseJSON = withObject "AppSettings" $ \o -> do let defaultDev = DEV_BOOL - parseUrl' = either (fail . show) return . parseBaseUrl appStaticDir <- o .: "static-dir" appDatabaseConf <- o .: "database" appRoot' <- o .:? "approot" @@ -73,7 +75,10 @@ instance FromJSON AppSettings where appShouldLogAll <- o .:? "should-log-all" .!= defaultDev appReloadTemplates <- o .:? "reload-templates" .!= defaultDev +#ifdef THERMOPRINT + let parseUrl' = either (fail . show) return . parseBaseUrl appThermoprintBase <- parseUrl' =<< o .: "thermoprint-url" +#endif return AppSettings {..} diff --git a/bar.cabal b/bar.cabal deleted file mode 100644 index 7ed983b..0000000 --- a/bar.cabal +++ /dev/null @@ -1,140 +0,0 @@ -name: bar -version: 0.6.6 -cabal-version: >= 1.8 -build-type: Simple - -Flag dev - Description: Turn on development settings, like auto-reload templates. - Default: False - -Flag library-only - Description: Build for use with "yesod devel" - Default: False - -library - hs-source-dirs: ., app - exposed-modules: Application - Foundation - Import - Import.NoFoundation - Model - Model.Types - Settings - Settings.StaticFiles - Handler.Common - Handler.Common.Types - Handler.InventoryListing - Handler.UpdateItem - Handler.OpenItem - Handler.LowItem - Handler.DeleteItem - Handler.Item - Handler.ReferenceListing - Handler.ReferenceItem - Handler.DeleteRefItem - Handler.Kinds - Handler.Types - Handler.List - Handler.InventoryList - - if flag(dev) || flag(library-only) - cpp-options: -DDEVELOPMENT - ghc-options: -Wall -fwarn-tabs -O0 - else - ghc-options: -Wall -fwarn-tabs -O2 - - extensions: TemplateHaskell - QuasiQuotes - OverloadedStrings - NoImplicitPrelude - MultiParamTypeClasses - TypeFamilies - GADTs - GeneralizedNewtypeDeriving - FlexibleContexts - FlexibleInstances - EmptyDataDecls - NoMonomorphismRestriction - DeriveDataTypeable - ViewPatterns - TupleSections - RecordWildCards - CPP - - build-depends: - -- Due to a bug in GHC 8.0.1, we block its usage - -- See: https://ghc.haskell.org/trac/ghc/ticket/12130 - base >= 4.8.2.0 && < 4.9 - || >= 4.9.1.0 && < 5 - - , yesod >= 1.6.0 && < 1.7 - , yesod-core >= 1.6.2 && < 1.7 - , yesod-auth >= 1.6.2 && < 1.7 - , yesod-static >= 1.6.0 && < 1.7 - , yesod-form >= 1.6.1 && < 1.7 - , classy-prelude >= 0.10.2 - , classy-prelude-conduit >= 0.10.2 - -- version 1.0 had a bug in reexporting Handler, causing trouble - , classy-prelude-yesod >= 0.10.2 && < 1.0 - || >= 1.1 - , bytestring >= 0.9 && < 0.11 - , text >= 0.11 && < 2.0 - , persistent >= 2.8.1 && < 2.9 - , persistent-postgresql >= 2.8.2 && < 2.9 - , persistent-template >= 2.0 && < 2.7 - , template-haskell - , shakespeare >= 2.0 && < 2.1 - , hjsmin >= 0.1 && < 0.3 - , monad-control >= 0.3 && < 1.1 - , wai-extra >= 3.0 && < 3.1 - , yaml >= 0.8 && < 0.9 - , http-conduit >= 2.3.0 && < 2.4 - , directory >= 1.1 && < 1.4 - , warp >= 3.0 && < 3.3 - , data-default - , aeson >= 1.2.4 && < 1.5 - , conduit >= 1.0 && < 2.0 - , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.2 && < 2.5 - , wai-logger >= 2.2 && < 2.4 - , file-embed - , safe - , unordered-containers - , containers - , vector - , time - , case-insensitive - , wai - , mtl - , lens - , thermoprint-client - , hashids - , systemd - -executable bar - if flag(library-only) - Buildable: False - - main-is: main.hs - hs-source-dirs: app - build-depends: base, bar - - ghc-options: -threaded -rtsopts -with-rtsopts=-N - - extensions: TemplateHaskell - QuasiQuotes - OverloadedStrings - NoImplicitPrelude - MultiParamTypeClasses - TypeFamilies - GADTs - GeneralizedNewtypeDeriving - FlexibleContexts - FlexibleInstances - EmptyDataDecls - NoMonomorphismRestriction - DeriveDataTypeable - ViewPatterns - TupleSections - RecordWildCards - CPP diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..e7ea47d --- /dev/null +++ b/package.yaml @@ -0,0 +1,106 @@ +name: bar +version: 0.6.6 + +flags: + dev: + description: Turn on development settings + default: false + manual: false + library-only: + description: Build for use with "yesod devel" + default: false + manual: false + thermoprint: + description: Use thermoprint-client + default: false + manual: false + +when: + - condition: flag(dev) || flag(library-only) + then: + cpp-options: -DDEVELOPMENT + ghc-options: -Wall -fwarn-tabs -O0 + else: + ghc-options: -Wall -fwarn-tabs -O2 + - condition: flag(thermoprint) + cpp-options: -DTHERMOPRINT + dependencies: + - thermoprint-client + +default-extensions: + - DeriveGeneric + - TupleSections + - RecordWildCards + - DeriveDataTypeable + - EmptyDataDecls + - FlexibleContexts + - FlexibleInstances + - TypeFamilies + - MultiParamTypeClasses + - NoImplicitPrelude + - PatternGuards + - DeriveFunctor + - GADTs + - CPP + - TemplateHaskell + - ViewPatterns + - PatternGuards + - QuasiQuotes + - FunctionalDependencies + - OverloadedStrings + +other-extensions: + - GeneralizedNewtypeDeriving + - ApplicativeDo + - PackageImports + +library: + source-dirs: . + dependencies: + - base + - yesod + - yesod-core + - yesod-static + - yesod-form + - classy-prelude + - classy-prelude-yesod + - bytestring + - text + - persistent + - persistent-postgresql + - persistent-template + - template-haskell + - shakespeare + - wai-extra + - yaml + - http-conduit + - warp + - aeson + - conduit + - monad-logger + - fast-logger + - wai-logger + - file-embed + - unordered-containers + - containers + - vector + - time + - wai + - mtl + - lens + - hashids + - systemd + +executables: + bar: + when: + - condition: flag(library-only) + buildable: false + main: main.hs + source-dirs: app + dependencies: + - base + - bar + - foreign-store + - warp + ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/stack.nix b/stack.nix new file mode 100644 index 0000000..98b31c1 --- /dev/null +++ b/stack.nix @@ -0,0 +1,14 @@ +{ ghc, nixpkgs ? (import {}) }: + +let + inherit (nixpkgs) haskell pkgs; + haskellPackages = if ghc.version == pkgs.haskellPackages.ghc.version then pkgs.haskellPackages else pkgs.haskell.packages."ghc${builtins.replaceStrings ["."] [""] ghc.version}"; +in haskell.lib.buildStackProject { + inherit ghc; + name = "stackenv"; + buildInputs = (with pkgs; + [ postgresql zlib + ]) ++ (with haskellPackages; + [ yesod-bin + ]); +} diff --git a/stack.yaml b/stack.yaml index dcf0bec..fe07aac 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: ghc-8.2.2 +resolver: lts-11.22 # User packages to be built. # Various formats can be used as shown in the example below. @@ -36,10 +36,21 @@ resolver: ghc-8.2.2 # non-dependency (i.e. a user package), and its test suites and benchmarks # will not be run. This is useful for tweaking upstream packages. packages: -- '.' + - '.' + - location: ../thermoprint/client + extra-dep: true + - location: ../thermoprint/spec + extra-dep: true + - location: + git: https://github.com/pngwjpgh/encoding.git + commit: f07769687b5cab12bbcab55eab51d629d54c2023 + extra-dep: true + # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) -extra-deps: [] +extra-deps: + - systemd-1.1.2 + - cabal-test-quickcheck-0.1.8.1 # Override default flag values for local packages and extra-deps flags: {} @@ -48,7 +59,7 @@ flags: {} extra-package-dbs: [] # Control whether we use the GHC we find on the path -system-ghc: true +# system-ghc: true # # Require a specific version of stack, using version ranges # require-stack-version: -any # Default @@ -65,9 +76,6 @@ system-ghc: true # Allow a newer minor version of GHC than the snapshot specifies # compiler-check: newer-minor nix: - enable: false - packages: - - postgresql - - zlib - - haskellPackages.yesod-bin - - haskellPackages.stack + packages: [] + pure: false + shell-file: ./stack.nix diff --git a/templates/list-no-thermoprint.hamlet b/templates/list-no-thermoprint.hamlet new file mode 100644 index 0000000..4292dc3 --- /dev/null +++ b/templates/list-no-thermoprint.hamlet @@ -0,0 +1,8 @@ +
+
+
Item +
Type + $forall WithType item itemType <- Set.toAscList list +
+
#{item} +
#{itemType} -- cgit v1.2.3