├── README.md ├── 2019-02-15_2.hs ├── 2019-04-11_01.hs ├── cabal-script.hs ├── 2019-02-15_1.hs ├── 2018-11-10_2.hs ├── 2018-11-23_1.hs ├── 2018-11-14_1.hs ├── LICENSE ├── 2018-11-22_1.hs ├── 2018-11-28_1.hs ├── 2018-11-13_1.hs ├── aeson-objectlike.hs └── cabal.travis.yml /README.md: -------------------------------------------------------------------------------- 1 | # [@HandyHaskell](https://twitter.com/HandyHaskell) 2 | 3 | Code from the tweets. You're free to use it however you want :) 4 | -------------------------------------------------------------------------------- /2019-02-15_2.hs: -------------------------------------------------------------------------------- 1 | partition :: Foldable f => (a -> Either b c) -> f a -> ([b], [c]) 2 | partition p as = foldr (select p) ([],[]) as 3 | {-# INLINE partition #-} 4 | {-# SPECIALISE partition :: (a -> Either b c) -> [a] -> ([b], [c]) #-} 5 | 6 | select :: (a -> Either b c) -> a -> ([b], [c]) -> ([b], [c]) 7 | select p a ~(bs, cs) = 8 | case p a of 9 | Left b -> (b:bs, cs) 10 | Right c -> (bs, c:cs) 11 | -------------------------------------------------------------------------------- /2019-04-11_01.hs: -------------------------------------------------------------------------------- 1 | import Control.Concurrent.Async (mapConcurrently) 2 | import Control.Concurrent.QSem 3 | import Control.Exception (bracket_) 4 | 5 | speedyTraverse 6 | :: Traversable t 7 | => Maybe Int -- max jobs (-j) 8 | -> (a -> IO b) 9 | -> t a 10 | -> IO (t b) 11 | speedyTraverse Nothing f jobs = mapConcurrently f jobs 12 | speedyTraverse (Just j) f jobs = do 13 | sem <- newQSem j 14 | mapConcurrently (bracket_ (waitQSem sem) (signalQSem sem) . f) jobs 15 | -------------------------------------------------------------------------------- /cabal-script.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env cabal 2 | {- cabal: 3 | 4 | build-depends: base, wai-app-static, warp 5 | default-language: Haskell2010 6 | 7 | -} 8 | module Main (main) where 9 | 10 | import Network.Wai.Application.Static (staticApp, defaultWebAppSettings) 11 | import qualified Network.Wai.Handler.Warp as Warp 12 | 13 | main :: IO () 14 | main = do 15 | putStrLn "Serving on http://localhost:8080" 16 | Warp.run 8080 app 17 | 18 | where 19 | app = staticApp (defaultWebAppSettings ".") 20 | -------------------------------------------------------------------------------- /2019-02-15_1.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.List (sort) 4 | import Data.Ord (comparing) 5 | 6 | 7 | main :: IO () 8 | main = print . sort $ 9 | [ Person "A" "B" 10 | , Person "A" "A" 11 | , Person "B" "C" 12 | , Person "B" "A" 13 | ] 14 | -- [ Person "A" "A" 15 | -- , Person "A" "B" 16 | -- , Person "B" "A" 17 | -- , Person "B" "C" 18 | -- ] 19 | 20 | data Person = Person 21 | { firstName :: String 22 | , lastName :: String 23 | } deriving (Show, Eq) 24 | 25 | instance Ord Person where 26 | -- Semigroup b => Semigroup (a -> b) 27 | compare = comparing firstName <> comparing lastName 28 | 29 | --instance Semigroup Ordering where 30 | -- LT <> _ = LT 31 | -- EQ <> y = y 32 | -- GT <> _ = GT 33 | -------------------------------------------------------------------------------- /2018-11-10_2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | import GHC.Generics 6 | 7 | class Record f where 8 | fieldNames' :: f p -> [String] 9 | 10 | instance (Record a, Record b) => Record (a :*: b) where 11 | fieldNames' (a :*: b) = fieldNames' a <> fieldNames' b 12 | 13 | instance Record a => Record (C1 c a) where 14 | fieldNames' (M1 a) = fieldNames' a 15 | 16 | instance Record a => Record (D1 c a) where 17 | fieldNames' (M1 a) = fieldNames' a 18 | 19 | instance Selector s => Record (S1 s a) where 20 | fieldNames' x = [selName x] 21 | 22 | fieldNames :: (Generic a, Record (Rep a)) => a -> [String] 23 | fieldNames = fieldNames' . from 24 | -------------------------------------------------------------------------------- /2018-11-23_1.hs: -------------------------------------------------------------------------------- 1 | import System.Directory (listDirectory) 2 | import System.FilePath (()) 3 | import Control.Monad (foldM) 4 | import System.Posix.Files (getFileStatus, isDirectory) 5 | 6 | main :: IO () 7 | main = print =<< walk "." 8 | 9 | type Dir = FilePath -- you might want to use 10 | type File = FilePath -- stronger types here! 11 | 12 | data FileTree = Dir :> [Either File FileTree] 13 | deriving Show 14 | 15 | walk :: Dir -> IO FileTree 16 | walk dir = do 17 | paths' <- listDirectory dir 18 | let paths = fmap (dir ) paths' -- need to qualify paths 19 | children <- foldM go [] paths 20 | pure (dir :> children) 21 | where 22 | go :: [Either File FileTree] -> FilePath -> IO [Either File FileTree] 23 | go accum filePath = do 24 | stat <- getFileStatus filePath 25 | if isDirectory stat 26 | then do 27 | tree <- walk filePath 28 | pure (Right tree : accum) 29 | else do 30 | pure (Left filePath : accum) 31 | -------------------------------------------------------------------------------- /2018-11-14_1.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -Weverything -fno-warn-implicit-prelude #-} 2 | 3 | import qualified Data.Bifunctor 4 | import Control.Applicative.Lift (eitherToErrors, runErrors) 5 | import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT) 6 | 7 | 8 | sequenceEither :: (Traversable t, Monoid e) => t (Either e a) -> Either e (t a) 9 | sequenceEither = sequenceEither' id 10 | 11 | 12 | sequenceEither' 13 | :: (Traversable t, Monoid e) 14 | => (e' -> e) 15 | -> t (Either e' a) 16 | -> Either e (t a) 17 | sequenceEither' f = runErrors . traverse (eitherToErrors . mapLeft f) 18 | 19 | 20 | sequenceExceptT 21 | :: (Traversable t, Monoid e, Applicative f) 22 | => t (ExceptT e f a) 23 | -> ExceptT e f (t a) 24 | sequenceExceptT = sequenceExceptT' id 25 | 26 | 27 | sequenceExceptT' 28 | :: (Traversable t, Monoid e, Applicative f) 29 | => (e' -> e) 30 | -> t (ExceptT e' f a) 31 | -> ExceptT e f (t a) 32 | sequenceExceptT' f es = ExceptT (sequenceEither' f <$> traverse runExceptT es) 33 | 34 | 35 | mapLeft :: (e' -> e) -> Either e' a -> Either e a 36 | mapLeft = Data.Bifunctor.first 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /2018-11-22_1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PatternSynonyms #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | import qualified Network.HTTP.Client as Http 4 | import qualified Network.HTTP.Types.Status as Http (statusCode) 5 | import Control.Exception (try, throwIO) 6 | import Data.ByteString.Lazy (ByteString) 7 | 8 | 9 | pattern BadStatus :: Int -> Http.HttpException 10 | pattern BadStatus n <- 11 | Http.HttpExceptionRequest _ 12 | (Http.StatusCodeException (responseStatusCode -> n) _) 13 | 14 | 15 | pattern Status404 :: Http.HttpException 16 | pattern Status404 <- BadStatus 404 17 | 18 | 19 | responseStatusCode :: Http.Response a -> Int 20 | responseStatusCode = Http.statusCode . Http.responseStatus 21 | 22 | 23 | -- | Make a request and return `Nothing` if the response is 404. 24 | getMaybe 25 | :: Http.Manager 26 | -> Http.Request 27 | -> IO (Maybe (Http.Response ByteString)) 28 | getMaybe manager request = do 29 | result <- try (Http.httpLbs request manager) 30 | case result of 31 | Right response -> pure (Just response) 32 | Left Status404 -> pure Nothing 33 | Left err -> throwIO err 34 | 35 | 36 | main :: IO () 37 | main = do 38 | manager <- Http.newManager Http.defaultManagerSettings 39 | 40 | -- NOTE: parseUrlThrow throws an exception for non-2XX response codes 41 | let mkRequest = Http.parseUrlThrow 42 | 43 | -- e.g. Just 44 | mkRequest "http://httpbin.org/status/200" >>= getMaybe manager >>= print 45 | -- e.g. Nothing 46 | mkRequest "http://httpbin.org/status/404" >>= getMaybe manager >>= print 47 | -------------------------------------------------------------------------------- /2018-11-28_1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | {-# LANGUAGE KindSignatures #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE DataKinds #-} 6 | {-# LANGUAGE UndecidableInstances #-} -- trust me ghc, you got this 7 | {-# LANGUAGE FlexibleInstances #-} 8 | 9 | -- Natural numbers, promoted to the kind/type level via DataKinds 10 | data Nat = Zero | Succ Nat 11 | 12 | 13 | -- MultiParameterTypeClasses "declare" a type level function 14 | class GreaterThan (x :: Nat) (y :: Nat) (b :: Bool) | x y -> b 15 | -- ^^^^^^^^ 16 | -- This is the function bit 17 | -- `x` and `y` uniquely determine `b` 18 | 19 | 20 | -- Instances are where we implement a type level function (above). 21 | -- We match on types and return a type, much like we do with terms. 22 | instance GreaterThan Zero Zero False 23 | instance GreaterThan (Succ x') Zero False 24 | instance GreaterThan Zero (Succ y') True 25 | -- Recursive case: 26 | instance GreaterThan x' y' b => GreaterThan (Succ x') (Succ y') b 27 | 28 | 29 | -- PRACTICAL EXAMPLE 30 | 31 | newtype Vec (n :: Nat) a = Vec [a] 32 | 33 | -- Passing an empty vector to this function is a compile time error. 34 | safeHead :: GreaterThan Zero n True => Vec n a -> a 35 | safeHead (Vec as) = head as 36 | 37 | emptyVec :: Vec Zero Int 38 | emptyVec = Vec [] 39 | 40 | singletonVec :: Vec (Succ Zero) Int 41 | singletonVec = Vec [1] 42 | 43 | -- safeHead singletonVec <- fine 44 | -- safeHead emptyVec <- won't compile 45 | -------------------------------------------------------------------------------- /2018-11-13_1.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS -Weverything -fno-warn-implicit-prelude #-} 2 | 3 | import qualified Data.ByteString 4 | import qualified Data.ByteString.Char8 5 | import qualified Data.Text 6 | import qualified Data.Text.Encoding 7 | import qualified Test.Hspec as Test 8 | 9 | import Data.Either (isLeft) 10 | import Data.ByteString (ByteString) 11 | import Data.Text.Encoding.Error (UnicodeException) 12 | import Control.Exception (evaluate) 13 | 14 | 15 | -- "Hello world" 16 | helloAscii :: ByteString 17 | helloAscii = 18 | Data.ByteString.pack [72, 101, 108, 108, 111, 32, 119, 111, 114, 108, 100] 19 | 20 | -- "你好世界" (Chinese) 21 | helloUtf8 :: ByteString 22 | helloUtf8 = Data.ByteString.pack 23 | [228, 189, 160, 229, 165, 189, 228, 184, 150, 231, 149, 140] 24 | 25 | -- Dodgy unicode (invalid 2 octet sequence) 26 | helloInvalidUtf8 :: ByteString 27 | helloInvalidUtf8 = Data.ByteString.pack [195, 40] <> helloUtf8 28 | 29 | 30 | main :: IO () 31 | main = Test.hspec $ do 32 | Test.describe "Data.ByteString.Char8" $ do 33 | let decode :: ByteString -> String 34 | decode = Data.ByteString.Char8.unpack 35 | 36 | Test.it "works fine for ascii text" $ do 37 | decode helloAscii `Test.shouldBe` "Hello world" 38 | Test.it "garbles unicode" $ do 39 | decode helloUtf8 `Test.shouldNotBe` "你好世界" 40 | Test.it "garbles bad unicode" $ do 41 | decode helloInvalidUtf8 `Test.shouldNotBe` "你好世界" 42 | 43 | Test.describe "Data.Text.Encoding.decodeUtf8" $ do 44 | let decode :: ByteString -> String 45 | decode = Data.Text.unpack . Data.Text.Encoding.decodeUtf8 46 | 47 | unicodeException :: Test.Selector UnicodeException 48 | unicodeException _ = True 49 | 50 | Test.it "works fine for ascii text" $ do 51 | decode helloAscii `Test.shouldBe` "Hello world" 52 | Test.it "works fine for unicode" $ do 53 | decode helloUtf8 `Test.shouldBe` "你好世界" 54 | Test.it "throws an exception for bad unicode" $ do 55 | evaluate (decode helloInvalidUtf8) 56 | `Test.shouldThrow` unicodeException 57 | 58 | Test.describe "Data.Text.Encoding.decodeUtf8'" $ do 59 | let decode :: ByteString -> Either UnicodeException String 60 | decode = fmap Data.Text.unpack . Data.Text.Encoding.decodeUtf8' 61 | 62 | Test.it "works fine for ascii text" $ do 63 | decode helloAscii `Test.shouldBe` Right "Hello world" 64 | Test.it "works fine for unicode" $ do 65 | decode helloUtf8 `Test.shouldBe` Right "你好世界" 66 | Test.it "indicates bad unicode via Left value" $ do 67 | decode helloInvalidUtf8 `Test.shouldSatisfy` isLeft 68 | -------------------------------------------------------------------------------- /aeson-objectlike.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# LANGUAGE UndecidableInstances #-} 9 | {-# LANGUAGE TypeFamilies #-} 10 | {-# LANGUAGE TypeApplications #-} 11 | {-# LANGUAGE DerivingVia #-} 12 | {-# LANGUAGE ScopedTypeVariables #-} 13 | module ObjectLike where 14 | 15 | import Control.Applicative (liftA2) 16 | import Data.Aeson 17 | import Data.Aeson.Types (Parser) 18 | import Data.Proxy (Proxy(..)) 19 | import GHC.Generics 20 | import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) 21 | import qualified Data.HashMap.Strict as HashMap 22 | import qualified Data.Text as Text 23 | 24 | -- | 25 | -- Wouldn't it be /swell/ if we could have the logic for mapping record fields 26 | -- to json object keys all in one place? Currently you're options are pretty much: 27 | -- 28 | -- * Write the instances by hand (explicit, but tedious) 29 | -- * Put your mapping logic into aeson options (not always possible) 30 | -- * Use the same keys and embrace the pain of -XDuplicateRecordFields 31 | -- 32 | -- Here's what I want to write: 33 | 34 | data MyRecord = MyRecord 35 | { _myRecordFoo :: Prop "foo" Int 36 | , _myRecordBar :: Prop "bar" Bool 37 | } 38 | deriving stock (Generic, Show) 39 | deriving FromJSON via ObjectLike MyRecord -- <3 DerivingVia 40 | deriving ToJSON via ObjectLike MyRecord 41 | 42 | data MyProduct = MyProduct (Prop "x" Int) (Prop "y" Int) 43 | deriving stock (Generic, Show) 44 | deriving FromJSON via ObjectLike MyProduct 45 | deriving ToJSON via ObjectLike MyProduct 46 | 47 | -- | 48 | -- This does bring a little bit of newtype awkwardness around @Prop@, but I 49 | -- personally don't mind that so much. Lenses could also improve this. 50 | 51 | main :: IO () 52 | main = do 53 | print $ decode @MyRecord "{\"foo\": 42, \"bar\": true}" 54 | print $ encode (MyRecord (Prop 42) (Prop True)) 55 | 56 | print $ decode @MyProduct "{\"x\": 42, \"y\": 24}" 57 | print $ encode (MyProduct (Prop 42) (Prop 24)) 58 | -- yay 59 | 60 | -- | 61 | -- @Prop@ lets us capture the keys associated with parts of a product type. 62 | 63 | newtype Prop (key :: Symbol) a = Prop { unProp :: a } 64 | deriving stock (Generic) 65 | deriving newtype (Show) 66 | 67 | -- | 68 | -- @ObjectLike@ is our deriving via helper. 69 | 70 | newtype ObjectLike a = ObjectLike a 71 | 72 | instance (Generic a, FromObject (Rep a)) => FromJSON (ObjectLike a) where 73 | parseJSON value = do 74 | object <- parseJSON value 75 | x <- fromObject @(Rep a) object 76 | pure $ ObjectLike (to x) 77 | 78 | instance (Generic a, ToObject (Rep a)) => ToJSON (ObjectLike a) where 79 | toJSON (ObjectLike a) = Object $ toObject (from a) 80 | 81 | -- | 82 | -- If a data type is equivalent to a bunch of @Prop@s then it has an instance 83 | -- of @FromObject@. 84 | 85 | class FromObject f where 86 | fromObject :: Object -> Parser (f p) 87 | 88 | instance FromObject f => FromObject (M1 i c f) where 89 | fromObject object = M1 <$> fromObject @f object 90 | 91 | instance (FromObject f, FromObject g) => FromObject (f :*: g) where 92 | fromObject obj = liftA2 (:*:) (fromObject obj) (fromObject obj) 93 | 94 | instance (KnownSymbol key, FromJSON a) => FromObject (Rec0 (Prop key a)) where 95 | fromObject obj = K1 . Prop <$> obj .: key 96 | where key = Text.pack $ symbolVal (Proxy @key) 97 | 98 | -- | 99 | -- If a data type is equivalent to a bunch of @Prop@s then it has an instance 100 | -- of @ToObject@. 101 | 102 | class ToObject f where 103 | toObject :: f p -> Object 104 | 105 | instance ToObject f => ToObject (M1 i c f) where 106 | toObject (M1 f) = toObject f 107 | 108 | instance (ToObject f, ToObject g) => ToObject (f :*: g) where 109 | toObject (f :*: g) = toObject f <> toObject g 110 | 111 | instance (KnownSymbol key, ToJSON a) => ToObject (Rec0 (Prop key a)) where 112 | toObject (K1 (Prop a)) = HashMap.singleton key (toJSON a) 113 | where key = Text.pack $ symbolVal (Proxy @key) 114 | -------------------------------------------------------------------------------- /cabal.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: false 3 | 4 | git: 5 | submodules: false # don't recursively clone submodules 6 | 7 | # NOTE: build multiple executables by making $EXE a matrix var 8 | env: 9 | global: 10 | - EXE=hello # name of the executable to build (as it appears in the cabal stanza) 11 | 12 | matrix: 13 | include: 14 | - os: linux 15 | # NOTE: purescript prefers trusty for performance reasons? 16 | dist: trusty 17 | addons: 18 | apt: 19 | packages: 20 | - ghc-8.4.4 21 | - cabal-install-2.4 22 | sources: 23 | # https://launchpad.net/~hvr/+archive/ubuntu/ghc 24 | - hvr-ghc 25 | 26 | - os: osx 27 | # Install stuff with Homebrew (see before_install) 28 | 29 | - os: windows 30 | # Install stuff with Chocolatey (see before_install) 31 | 32 | # Make sure ghc and cabal are installed and on $PATH 33 | before_install: 34 | - | 35 | if [ "$TRAVIS_OS_NAME" = linux ] 36 | then 37 | export PATH=$PATH:"/opt/ghc/bin"; 38 | fi 39 | - | 40 | if [ "$TRAVIS_OS_NAME" = osx ] 41 | then 42 | brew update; 43 | # TODO: pin versions here 44 | brew install ghc; 45 | brew install cabal-install; 46 | fi 47 | - | 48 | if [ "$TRAVIS_OS_NAME" = windows ] 49 | then 50 | # NOTE: can't have secure (i.e. set in the Travis UI) env vars 51 | # otherwise this will hang 52 | # https://travis-ci.community/t/choco-install-hangs-forever/307 53 | choco install ghc --version 8.4.4 -y; 54 | choco install cabal --version 2.4.1.0 -y; 55 | 56 | # NOTE: Chocolatey $PATH changes don't take effect. 57 | # Need to modify the $PATH manually. 58 | export PATH=$PATH:"C:\ProgramData\chocolatey\lib\ghc\tools\ghc-8.4.4\bin"; 59 | fi 60 | 61 | # Update package list and install project dependencies (cached) 62 | install: 63 | # Print version numbers for debuggin' 64 | - ghc --version 65 | - cabal --version 66 | 67 | - travis_retry cabal new-update --verbose 68 | - cabal new-build --disable-tests --disable-benchmarks --dependencies-only -j2 all 69 | 70 | # Build and test the thing 71 | script: 72 | - cabal new-build --enable-tests --disable-benchmarks all 73 | # ^^^^^^^ enable if you want 74 | - cabal new-test all 75 | - cabal check 76 | 77 | # Deploy github release (optional) 78 | before_deploy: 79 | - cabal new-clean 80 | - travis_retry cabal new-update --verbose 81 | - cabal new-build --disable-tests --disable-benchmarks --enable-optimization=2 $EXE 82 | 83 | # Get path of the built executable 84 | - | 85 | if [ "$TRAVIS_OS_NAME" = windows ] 86 | then 87 | EXE_NAME=$EXE.exe; 88 | else 89 | EXE_NAME=$EXE; 90 | fi 91 | - EXE_PATH=$(find dist-newstyle/build/ -type f -name $EXE_NAME) # NOTE: assuming this finds only one file! 92 | 93 | # Build the tarball 94 | - tar --create --file $TRAVIS_OS_NAME.tar --files-from /dev/null 95 | - tar --append --file $TRAVIS_OS_NAME.tar -C $(dirname $EXE_PATH) $EXE_NAME 96 | - tar --append --file $TRAVIS_OS_NAME.tar LICENSE 97 | 98 | # Gzip the tarball 99 | - gzip --verbose $TRAVIS_OS_NAME.tar 100 | 101 | # Create the checksum 102 | - | 103 | if [ "$TRAVIS_OS_NAME" = windows ]; 104 | then 105 | openssl dgst -sha1 $TRAVIS_OS_NAME.tar.gz | tee $TRAVIS_OS_NAME.sha; 106 | else 107 | shasum $TRAVIS_OS_NAME.tar.gz | tee $TRAVIS_OS_NAME.sha; 108 | fi 109 | 110 | deploy: 111 | provider: releases 112 | api_key: 113 | # $ travis encrypt 114 | secure: "TODO" 115 | file: 116 | - $TRAVIS_OS_NAME.tar.gz 117 | - $TRAVIS_OS_NAME.sha 118 | skip_cleanup: true 119 | on: 120 | tags: true 121 | 122 | notifications: 123 | email: 124 | on_success: never 125 | on_failure: always 126 | 127 | cache: 128 | directories: 129 | - $HOME/.cabal/packages 130 | - $HOME/.cabal/store 131 | 132 | before_cache: 133 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log 134 | # remove files that are regenerated by `cabal update` 135 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* 136 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json 137 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache 138 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar 139 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx 140 | 141 | - rm -rfv $HOME/.cabal/packages/head.hackage 142 | --------------------------------------------------------------------------------