├── .gitignore ├── Haskell ├── AlternativeTest.hs ├── AzureCLICodegen.hs ├── Conduits.hs ├── Deployment.hs ├── ForceSSL.hs ├── Java.hs ├── Pyfi.hs ├── PythonImports.hs ├── Retry.hs ├── SBV.hs ├── Strategies.hs ├── Stratos.hs ├── THProlog │ ├── Main.hs │ ├── README.md │ ├── THProlog.hs │ └── insurance.pl ├── Terraform.hs ├── TestReflex.hs ├── UnagiBloom.hs └── WebBlog.hs ├── LICENSE └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | cabal.project.local~ 21 | .HTF/ 22 | .ghc.environment.* 23 | *.js_o 24 | *.js_hi 25 | *.jsexe 26 | -------------------------------------------------------------------------------- /Haskell/AlternativeTest.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | module Main where 6 | import Control.Monad 7 | 8 | -- Maybe has Alternative instance 9 | -- no IFs no nested code 10 | testWhenYourMonadHasAlternative1 :: Maybe Int 11 | testWhenYourMonadHasAlternative1 = do 12 | x <- Just 5 13 | y <- Nothing 14 | let w = x + y 15 | guard $ w `mod` 2 == 0 16 | return w 17 | 18 | -- List has Alternative instance 19 | -- no IFs no nested code 20 | testWhenYourMonadHasAlternative2 :: [Int] 21 | testWhenYourMonadHasAlternative2 = do 22 | x <- [1 .. 5] 23 | y <- [1 .. 5] 24 | let w = x + y 25 | guard $ w `mod` 2 == 0 26 | return w 27 | 28 | -- IO doesn't have alternative instance 29 | -- can't use "guard" to short-circut run and "return something" 30 | testNoAlternative1 :: IO (Maybe Int) 31 | testNoAlternative1 = do 32 | guard $ False -- exception = AlternativeTest.hs: user error (mzero) 33 | print "shouldn't get here" 34 | return Nothing 35 | 36 | -- IO doesn't have alternative instance 37 | testNoAlternative2 :: IO (Maybe Int) 38 | testNoAlternative2 = do 39 | when False $ do 40 | return () 41 | print "shouldn't get here" 42 | return Nothing 43 | 44 | -- IO doesn't have alternative instance 45 | -- using "Maybe"s as return values doesn't change the monad 46 | -- it's still IO (and still no Alternative in your monadic-do actions) 47 | 48 | testNoAlternative3 :: IO (Maybe Int) 49 | testNoAlternative3 = do 50 | x <- return (Just 5) 51 | y <- return (Just 6) 52 | 53 | -- let w = x + y -- won't compile no `Num (Maybe)` 54 | -- guard $ w `mod` 2 == 0 -- won't compile, `w` is a Maybe 55 | 56 | let w = (+) <$> x <*> y 57 | -- Python / C : 58 | case w of 59 | Nothing -> return (Just 0) 60 | Just x' -> return (Just x') 61 | 62 | 63 | main :: IO () 64 | main = do 65 | print testWhenYourMonadHasAlternative1 66 | print testWhenYourMonadHasAlternative2 67 | print =<< testNoAlternative3 68 | _ <- testNoAlternative2 69 | _ <- testNoAlternative1 70 | return () 71 | -------------------------------------------------------------------------------- /Haskell/AzureCLICodegen.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "pkgs.haskell.packages.ghc843.ghcWithPackages (ps: with ps; [template-haskell split process containers casing wreq lens tagsoup bytestring text])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE QuasiQuotes #-} 8 | {-# LANGUAGE DeriveLift #-} 9 | {-# LANGUAGE StandaloneDeriving #-} 10 | 11 | import "base" Data.Monoid ((<>)) 12 | {-import "base" System.Environment (getArgs)-} 13 | import "base" Data.List (groupBy) 14 | import "bytestring" Data.ByteString.Lazy.Char8 (toStrict) 15 | import "text" Data.Text (Text) 16 | import qualified "text" Data.Text as T (strip, unwords, words, unpack, isPrefixOf, filter) 17 | import "text" Data.Text.Encoding (decodeUtf8) 18 | import "lens" Control.Lens 19 | import "casing" Text.Casing 20 | import "tagsoup" Text.HTML.TagSoup 21 | import "wreq" Network.Wreq 22 | import "template-haskell" Language.Haskell.TH 23 | 24 | type Command = Text 25 | type Subcommand = Text 26 | type Flag = Text 27 | 28 | analyzeAzureCLIDocumentation :: String -> IO [(Command, Subcommand, [Flag])] 29 | analyzeAzureCLIDocumentation uri = do 30 | response <- get uri 31 | let body = response ^. responseBody 32 | return $ -- take definition (not example) 33 | map head 34 | . groupBy (\(_, subC1, _) (_, subC2, _) -> subC1 == subC2) 35 | 36 | -- turn to command list 37 | . map toCommand 38 | 39 | -- partition by "code" "lang-azurecli" 40 | . partitions (~== TagOpen ("code" :: Text) [("class","lang-azurecli")]) 41 | . parseTags 42 | 43 | -- turn to Text 44 | . decodeUtf8 45 | . toStrict 46 | $ body 47 | where 48 | toCommand :: [Tag Text] -> (Command, Subcommand, [Flag]) 49 | toCommand tags 50 | = (\(command : subCommand : flags) -> (command, subCommand, flags)) 51 | . drop 1 -- drop "az" 52 | . T.words 53 | . T.unwords 54 | . map T.strip 55 | . map fromTagText 56 | 57 | -- filter only "TagText" until "TagClose" 58 | . filter isTagText 59 | . takeWhile (~/= TagClose ("code" :: Text)) 60 | 61 | -- drop the "TagOpen" "code" 62 | . drop 1 63 | $ tags 64 | 65 | 66 | deriveCommand :: String -> DecsQ 67 | deriveCommand uri = do 68 | cmds <- runIO $ analyzeAzureCLIDocumentation uri 69 | let name = mkName . fix . T.unpack . (\(cmd, _, _) -> cmd) . head $ cmds 70 | let dataType = DataD [] 71 | name 72 | [] 73 | Nothing 74 | (map toCon cmds) 75 | [ DerivClause Nothing -- [DerivClause] 76 | [ ConT $ mkName "Show" 77 | , ConT $ mkName "Read" 78 | , ConT $ mkName "Eq" 79 | ] 80 | ] 81 | return [dataType] 82 | where 83 | fix :: String -> String 84 | fix = toPascal . fromAny 85 | 86 | toField command subCommand flag 87 | = ( mkName fieldName 88 | , Bang NoSourceUnpackedness SourceStrict 89 | , type' 90 | ) 91 | where 92 | fieldName = "_" <> (toCamel . fromAny . T.unpack $ command) 93 | <> (toPascal . fromAny . T.unpack $ subCommand) 94 | <> "_" <> (toCamel . fromAny . T.unpack . T.filter (not . (`elem` ("[]" :: String))) $ flag) 95 | 96 | type' | "[" `T.isPrefixOf` flag = AppT (ConT $ mkName "Maybe") (ConT $ mkName "String") 97 | | otherwise = (ConT $ mkName "String") 98 | 99 | toCon (command, subCommand, flags) 100 | = RecC (mkName . fix . T.unpack $ subCommand) 101 | (map (toField command subCommand) flags) 102 | 103 | 104 | 105 | 106 | main :: IO () 107 | main = do 108 | -- (uri:_) <- getArgs 109 | let uri = "https://docs.microsoft.com/en-us/cli/azure/group?view=azure-cli-latest#az-group-list" 110 | xs <- runQ $ deriveCommand uri 111 | putStrLn $ pprint xs 112 | -------------------------------------------------------------------------------- /Haskell/Conduits.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [conduit conduit-extra resourcet])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module Conduits where 7 | 8 | import "base" System.IO (stdin, stdout) 9 | import "base" Data.Monoid ((<>)) 10 | import "base" Data.Char (toUpper) 11 | import qualified "bytestring" Data.ByteString.Char8 as B8 12 | import "resourcet" Control.Monad.Trans.Resource (runResourceT) 13 | import "conduit" Data.Conduit 14 | import qualified "conduit" Data.Conduit.Combinators as CC (map) 15 | import qualified "conduit-extra" Data.Conduit.Binary as CB 16 | 17 | main :: IO () 18 | main = runResourceT . runConduit 19 | $ CB.sourceHandle stdin 20 | .| CB.lines 21 | .| CC.map (B8.map toUpper) 22 | .| CC.map (<> "\n") 23 | .| CB.sinkHandle stdout 24 | -------------------------------------------------------------------------------- /Haskell/Deployment.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/19.03.tar.gz -i runhaskell -p "(pkgs.haskell.packages.ghc864.extend (self: super: with haskell; rec { stratosphere = self.callPackage ( { mkDerivation, aeson, aeson-pretty, base, bytestring, containers , fetchgit, hashable, hpack, hspec, hspec-discover, lens, stdenv , template-haskell, text, unordered-containers }: mkDerivation { pname = \"stratosphere\"; version = \"0.50.0\"; src = fetchgit { url = \"https://github.com/freckle/stratosphere\"; sha256 = \"045x6rw7b85zxxv4mm3i3dz21n5cc5212maxckl1bvkdywwadqmp\"; rev = \"8981ed145a0e582981403fb7ee7e10d5be5de508\"; fetchSubmodules = true; }; isLibrary = true; isExecutable = true; libraryHaskellDepends = [ aeson aeson-pretty base bytestring containers hashable lens template-haskell text unordered-containers ]; libraryToolDepends = [ hpack ]; testHaskellDepends = [ aeson aeson-pretty base bytestring containers hashable hspec hspec-discover lens template-haskell text unordered-containers ]; testToolDepends = [ hspec-discover ]; preConfigure = \"hpack\"; homepage = \"https://github.com/frontrowed/stratosphere#readme\"; description = \"EDSL for AWS CloudFormation\"; license = stdenv.lib.licenses.mit; }) {}; })).ghcWithPackages (ps: with ps; [stratosphere heredoc])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE OverloadedLists #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE QuasiQuotes #-} 7 | 8 | module Main where 9 | 10 | import "lens" Control.Lens 11 | import "aeson" Data.Aeson (Value (Array), object) 12 | import qualified "bytestring" Data.ByteString.Lazy.Char8 as B 13 | import "text" Data.Text (Text) 14 | import "stratosphere" Stratosphere 15 | import "heredoc" Text.Heredoc 16 | 17 | 18 | -- 19 | main :: IO () 20 | main = B.putStrLn $ encodeTemplate myTemplate 21 | 22 | 23 | -- Helpers 24 | arn :: Resource -> Val Text 25 | arn = flip GetAtt "Arn" . _resourceName 26 | 27 | 28 | -- Template 29 | myTemplate :: Template 30 | myTemplate 31 | = template 32 | [ role' 33 | , ecs 34 | , apiGateway 35 | , apiGatewayRootMethod 36 | , apiGatewayDeployment' 37 | , lambda 38 | , lambdaApiGatewayInvoke 39 | ] 40 | & templateDescription ?~ "Lambda example" 41 | & templateFormatVersion ?~ "2010-09-09" 42 | & templateParameters ?~ 43 | [ apiGatewayStageName 44 | , lambdaFunctionName 45 | ] 46 | & templateOutputs ?~ 47 | [ lambdaArn 48 | , apiGatewayInvokeUrl 49 | ] 50 | 51 | 52 | -- Parameters 53 | apiGatewayStageName :: Parameter 54 | apiGatewayStageName 55 | = parameter "apiGatewayStageName" 56 | "String" 57 | & parameterAllowedPattern ?~ "^[a-z0-9]+$" 58 | & parameterDefault' ?~ "call" 59 | 60 | lambdaFunctionName :: Parameter 61 | lambdaFunctionName 62 | = parameter "lambdaFunctionName" 63 | "String" 64 | & parameterAllowedPattern ?~ "^[a-zA-Z0-9]+[a-zA-Z0-9-]+[a-zA-Z0-9]+$" 65 | & parameterDefault' ?~ "my-function" 66 | 67 | 68 | -- Outputs 69 | lambdaArn :: Output 70 | lambdaArn 71 | = output "lambdaArn" $ arn lambda 72 | 73 | apiGatewayInvokeUrl :: Output 74 | apiGatewayInvokeUrl 75 | = output "apiGatewayInvokeUrl" 76 | $ Sub uri Nothing 77 | where 78 | uri :: Text 79 | uri = "https://${" <> gw <> "}.execute-api.${AWS::Region}.amazonaws.com/${" <> gwStageName <> "}" 80 | gw :: Text 81 | gw = apiGateway ^. resourceName 82 | 83 | gwStageName :: Text 84 | gwStageName = apiGatewayStageName ^. parameterName 85 | 86 | 87 | -- Resources 88 | ecs :: Resource 89 | ecs = resource "ECSCluster" ecsCluster 90 | 91 | apiGateway :: Resource 92 | apiGateway 93 | = resource "apiGateway" 94 | $ apiGatewayRestApi 95 | & agraName ?~ "my-api" 96 | & agraDescription ?~ "My API" 97 | 98 | 99 | apiGatewayRootMethod :: Resource 100 | apiGatewayRootMethod 101 | = resource "apiGatewayRootMethod" method 102 | where 103 | method :: ApiGatewayMethod 104 | method = apiGatewayMethod (Literal POST) 105 | (GetAtt (apiGateway ^. resourceName) "RootResourceId") 106 | (Ref $ apiGateway ^. resourceName) 107 | & agmeAuthorizationType ?~ Literal NONE 108 | & agmeIntegration ?~ integration 109 | 110 | integration :: ApiGatewayMethodIntegration 111 | integration = apiGatewayMethodIntegration 112 | & agmiType ?~ Literal AWS_PROXY 113 | & agmiIntegrationHttpMethod ?~ Literal POST 114 | & agmiUri ?~ uri 115 | 116 | uri :: Val Text 117 | uri = Sub "arn:aws:apigateway:${AWS::Region}:lambda:path/2015-03-31/functions/${lambdaArn}/invocations" 118 | (Just [("lambdaArn", arn lambda)]) 119 | 120 | 121 | apiGatewayDeployment' :: Resource 122 | apiGatewayDeployment' 123 | = ( resource "apiGatewayDeployment" 124 | $ apiGatewayDeployment (Ref $ apiGateway ^. resourceName) 125 | ) 126 | & resourceDependsOn ?~ [apiGatewayRootMethod ^. resourceName] 127 | 128 | 129 | lambda :: Resource 130 | lambda 131 | = resource "LambdaFunction" function 132 | & resourceDependsOn ?~ [ role' ^. resourceName ] 133 | where 134 | function :: LambdaFunction 135 | function = lambdaFunction lambdaCode 136 | "index.handler" 137 | (arn role') 138 | (Literal NodeJS12x) 139 | 140 | lambdaCode :: LambdaFunctionCode 141 | lambdaCode = lambdaFunctionCode 142 | & lfcZipFile ?~ code 143 | 144 | code :: Val Text 145 | code = [str|exports.handler = (event, context, callback) => { 146 | | const name = event.name || 'World'; 147 | | const response = {greeting: `Hello, ${name}!`}; 148 | | callback(null, response); 149 | |}; 150 | |] 151 | 152 | 153 | lambdaApiGatewayInvoke :: Resource 154 | lambdaApiGatewayInvoke 155 | = resource "lambdaApiGatewayInvoke" permission 156 | where 157 | permission :: LambdaPermission 158 | permission = lambdaPermission "lambda:InvokeFunction" 159 | (arn lambda) 160 | "apigateway.amazonaws.com" 161 | & lpSourceArn ?~ arn' 162 | 163 | arn' :: Val Text 164 | arn' = Sub ("arn:aws:execute-api:${AWS::Region}:${AWS::AccountId}:${" <> apiGateway ^. resourceName <> "}/*/POST/") Nothing 165 | 166 | 167 | role' :: Resource 168 | role' = 169 | resource "IAMRole" $ 170 | iamRole 171 | rolePolicyDocumentObject 172 | & iamrPolicies ?~ [ executePolicy ] 173 | & iamrRoleName ?~ "MyLambdaBasicExecutionRole" 174 | & iamrPath ?~ "/" 175 | where 176 | executePolicy = 177 | iamRolePolicy 178 | [ ("Version", "2012-10-17") 179 | , ("Statement", statement) 180 | ] 181 | "MyLambdaExecutionPolicy" 182 | 183 | where 184 | statement = object 185 | [ ("Effect", "Allow") 186 | , ("Action", actions) 187 | , ("Resource", "*") 188 | ] 189 | 190 | actions = Array 191 | [ "logs:CreateLogGroup" 192 | , "logs:CreateLogStream" 193 | , "logs:PutLogEvents" 194 | ] 195 | 196 | rolePolicyDocumentObject = 197 | [ ("Version", "2012-10-17") 198 | , ("Statement", statement) 199 | ] 200 | 201 | where 202 | statement = object 203 | [ ("Effect", "Allow") 204 | , ("Principal", principal) 205 | , ("Action", "sts:AssumeRole") 206 | ] 207 | 208 | principal = object 209 | [ ("Service", "lambda.amazonaws.com") ] 210 | -------------------------------------------------------------------------------- /Haskell/ForceSSL.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [wai warp warp-tls http-types wai-extra])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module Main where 7 | 8 | import "base" Control.Concurrent 9 | import "http-types" Network.HTTP.Types 10 | import "wai" Network.Wai 11 | import "wai-extra" Network.Wai.Middleware.ForceSSL 12 | import "warp" Network.Wai.Handler.Warp 13 | import "warp-tls" Network.Wai.Handler.WarpTLS 14 | 15 | 16 | serveApp :: IO () 17 | serveApp = do 18 | -- HTTPS 19 | _ <- forkIO $ do 20 | let tls = tlsSettings "test.crt" 21 | "test.key" 22 | runTLS tls (setPort 443 defaultSettings) (forceSSL app) 23 | -- HTTP 24 | run 80 $ forceSSL $ app 25 | 26 | 27 | app :: p -> (Response -> t) -> t 28 | app _ respond = do 29 | respond $ responseLBS status200 [] "Hello World" 30 | 31 | 32 | main :: IO () 33 | main = do 34 | serveApp 35 | -------------------------------------------------------------------------------- /Haskell/Java.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i ghc -p jdk8 -p gradle -p "pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [text jvm inline-java])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# OPTIONS_GHC -fplugin=Language.Java.Inline.Plugin #-} 5 | {-# LANGUAGE PackageImports #-} 6 | {-# LANGUAGE DataKinds #-} 7 | {-# LANGUAGE QuasiQuotes #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | module Main where 10 | import "text" Data.Text (Text) 11 | import "jvm" Language.Java (withJVM) 12 | import "jvm" Language.Java (reflect) 13 | import "inline-java" Language.Java.Inline (java) 14 | 15 | 16 | main :: IO () 17 | main = withJVM [] $ do 18 | message <- reflect ("Hello World!" :: Text) 19 | [java| { 20 | javax.swing.JOptionPane.showMessageDialog(null, $message); 21 | } 22 | |] 23 | -------------------------------------------------------------------------------- /Haskell/Pyfi.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "python27.withPackages (ps: with ps; [numpy pandas])" -p "(pkgs.haskellPackages.extend (self: super: with haskell; rec { pyfi = haskell.lib.doJailbreak super.pyfi; })).ghcWithPackages (ps: with ps; [aeson pyfi])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE QuasiQuotes #-} 6 | module Pyfi where 7 | 8 | import "pyfi" Python 9 | 10 | pandasExample :: [[Int]] -> IO [Int] 11 | pandasExample = defVV [str| 12 | import pandas as pd 13 | def export(matrix): 14 | df = pd.DataFrame(matrix) 15 | print "------------" 16 | print "From Python:" 17 | print df 18 | return list(df.sum()) 19 | |] 20 | 21 | main :: IO () 22 | main = do 23 | xs <- pandasExample [ [1,2,3] 24 | , [4,5,6] 25 | , [7,8,9] 26 | ] 27 | print "-------------" 28 | print "From Haskell:" 29 | print xs 30 | -------------------------------------------------------------------------------- /Haskell/PythonImports.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/19.03.tar.gz -i runhaskell -p "(pkgs.haskell.packages.ghc864.extend (self: super: with haskell; { language-python = lib.doJailbreak super.language-python; })).ghcWithPackages (ps: with ps; [language-python uniplate])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | module Main where 7 | import "base" Data.Monoid ((<>)) 8 | import "base" Data.List (intercalate) 9 | import "base" System.IO (hGetContents, stdin) 10 | import "uniplate" Data.Generics.Uniplate.Data (universeBi, childrenBi) 11 | import "language-python" Language.Python.Common hiding ((<>), Assignment) 12 | import "language-python" Language.Python.Version3.Parser 13 | 14 | -- 15 | type PythonSourceCode = String 16 | type PythonPackageName = String 17 | 18 | getImports :: PythonSourceCode -> Maybe [PythonPackageName] 19 | getImports source = do 20 | case parseModule source "" of 21 | Left _ -> Nothing 22 | Right (pyModule, _) -> do 23 | Just $ concat $ imports pyModule <> froms pyModule 24 | 25 | where 26 | -- 27 | imports :: Module SrcSpan -> [[String]] 28 | imports pyModule = do 29 | let getImportItems = universeBi :: (Module SrcSpan -> [ImportItem SrcSpan]) 30 | let getIdentifiers = childrenBi :: ([ImportItem SrcSpan] -> [[Ident SrcSpan]]) 31 | let packageNames = map (intercalate "." . map ident_string) 32 | . getIdentifiers 33 | . getImportItems 34 | $ pyModule 35 | return packageNames 36 | 37 | -- 38 | froms :: Module SrcSpan -> [[String]] 39 | froms pyModule = do 40 | let getImportRelatives = universeBi :: (Module SrcSpan -> [ImportRelative SrcSpan]) 41 | let getIdentifiers = childrenBi :: ([ImportRelative SrcSpan] -> [[Ident SrcSpan]]) 42 | let packageNames = map (intercalate "." . map ident_string) 43 | . getIdentifiers 44 | . getImportRelatives 45 | $ pyModule 46 | return packageNames 47 | 48 | -- 49 | main :: IO () 50 | main = do 51 | source <- hGetContents stdin 52 | let ps = getImports source 53 | print ps 54 | -------------------------------------------------------------------------------- /Haskell/Retry.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [retry])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | module Retry where 7 | 8 | import "retry" Control.Retry 9 | import "directory" System.Directory (doesFileExist) 10 | 11 | myPolicy :: RetryPolicy 12 | myPolicy = exponentialBackoff 1000000 <> limitRetries 5 13 | 14 | predicate :: RetryStatus -> a -> IO Bool 15 | predicate _ _ = not <$> doesFileExist "/tmp/nonexist" 16 | 17 | main :: IO () 18 | main = do 19 | _ <- retrying myPolicy predicate $ \_ -> do 20 | print "Still waiting for file..." 21 | return False 22 | return () 23 | -------------------------------------------------------------------------------- /Haskell/SBV.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/20.03-beta.tar.gz --pure -i runhaskell -p z3 -p "pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [sbv])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# OPTIONS_GHC -fno-warn-type-defaults #-} 5 | {-# LANGUAGE PackageImports #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 8 | module SBV where 9 | 10 | import "sbv" Data.SBV 11 | import qualified "sbv" Data.SBV.Internals as SI 12 | 13 | newtype LengthInIntegerMetres 14 | = LengthInIntegerMetres Integer 15 | deriving (Real, Integral, Num, Enum, Eq, Ord) 16 | 17 | type SLenIntMetres = SBV LengthInIntegerMetres 18 | 19 | instance HasKind LengthInIntegerMetres where 20 | kindOf _ = KUnbounded 21 | 22 | instance SymVal LengthInIntegerMetres where 23 | mkSymVal = SI.genMkSymVar KUnbounded 24 | literal = SI.genLiteral KUnbounded 25 | fromCV = SI.genFromCV 26 | 27 | newtype LengthInFloatingMetres 28 | = LengthInFloatingMetres Float 29 | deriving (Real, Num, Enum, Eq, Ord, Fractional, Floating, RealFrac, RealFloat) 30 | 31 | type SLenFMetres = SBV LengthInFloatingMetres 32 | 33 | instance HasKind LengthInFloatingMetres where 34 | kindOf _ = KFloat 35 | 36 | instance SymVal LengthInFloatingMetres where 37 | mkSymVal = SI.genMkSymVar KFloat 38 | literal (LengthInFloatingMetres l) = SI.SBV . SI.SVal KFloat . Left . SI.CV KFloat . SI.CFloat $ l 39 | fromCV (SI.CV _ (SI.CFloat a)) = LengthInFloatingMetres a 40 | fromCV c = error $ "SymVal.LengthInFloatingMetres: Unexpected non-float value: " ++ show c 41 | 42 | instance IEEEFloating LengthInFloatingMetres 43 | 44 | newtype LengthInDoubleMetres 45 | = LengthInDoubleMetres Double 46 | deriving (Real, Num, Enum, Eq, Ord, Fractional, Floating, RealFrac, RealFloat) 47 | 48 | type SLenDMetres = SBV LengthInDoubleMetres 49 | 50 | instance HasKind LengthInDoubleMetres where 51 | kindOf _ = KDouble 52 | 53 | instance SymVal LengthInDoubleMetres where 54 | mkSymVal = SI.genMkSymVar KDouble 55 | literal (LengthInDoubleMetres l) = SI.SBV . SI.SVal KDouble . Left . SI.CV KDouble . SI.CDouble $ l 56 | fromCV (SI.CV _ (SI.CDouble a)) = LengthInDoubleMetres a 57 | fromCV c = error $ "SymVal.LengthInDoubleMetres: Unexpected non-float value: " ++ show c 58 | 59 | instance IEEEFloating LengthInDoubleMetres 60 | 61 | formula :: Symbolic SBool 62 | formula = do 63 | n :: SLenIntMetres <- exists "n" 64 | x :: SLenFMetres <- exists "x" 65 | y :: SLenDMetres <- exists "y" 66 | constrain $ y .< literal 3.14 67 | return $ (n .== literal 3) .&& (sFromIntegral n .== x) 68 | 69 | main :: IO () 70 | main = print =<< sat formula 71 | -------------------------------------------------------------------------------- /Haskell/Strategies.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i ghcjs -p "(pkgs.haskell.packages.ghcjs.extend (self: super: with haskell; {})).ghcWithPackages (ps: with ps; [parallel])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | module Main where 6 | 7 | import "parallel" Control.Parallel.Strategies 8 | 9 | -- fails on runtime 10 | main :: IO () 11 | main = do 12 | let x = map (+1) [(1 :: Int) .. 1000000] `using` rpar 13 | print x 14 | 15 | -------------------------------------------------------------------------------- /Haskell/Stratos.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/19.03.tar.gz -i runhaskell -p "pkgs.haskell.packages.ghc864.ghcWithPackages (ps: with ps; [stratosphere])" 3 | {-# LANGUAGE OverloadedLists #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | module Main where 7 | 8 | import qualified Data.ByteString.Lazy.Char8 as B 9 | import Stratosphere 10 | 11 | main :: IO () 12 | main = B.putStrLn $ encodeTemplate instanceTemplate 13 | 14 | instanceTemplate :: Template 15 | instanceTemplate 16 | = template [ resource "EC2Instance" 17 | ( EC2InstanceProperties 18 | $ ec2Instance 19 | & eciImageId ?~ "ami-22111148" 20 | & eciKeyName ?~ (Ref "KeyName") 21 | ) 22 | & resourceDeletionPolicy ?~ Retain 23 | ] 24 | & templateDescription ?~ "Sample template" 25 | & templateParameters ?~ 26 | [ parameter "KeyName" "AWS::EC2::KeyPair::KeyName" 27 | & parameterDescription ?~ "Name of an existing EC2 KeyPair to enable SSH access to the instance" 28 | & parameterConstraintDescription ?~ "Must be the name of an existing EC2 KeyPair." 29 | ] 30 | -------------------------------------------------------------------------------- /Haskell/THProlog/Main.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz -i runhaskell -p swiProlog -p "pkgs.haskell.packages.ghc864.ghcWithPackages (ps: with ps; [template-haskell process lens])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE QuasiQuotes #-} 7 | {-# LANGUAGE DeriveLift #-} 8 | {-# LANGUAGE StandaloneDeriving #-} 9 | 10 | import "base" Control.Monad (void) 11 | import "base" Data.Char (toUpper) 12 | import "lens" Control.Lens 13 | import "process" System.Process (readProcess) 14 | import "template-haskell" Language.Haskell.TH 15 | import "template-haskell" Language.Haskell.TH.Syntax 16 | import "template-haskell" Language.Haskell.TH.Quote 17 | import "template-haskell" Language.Haskell.TH.Ppr 18 | 19 | import qualified THProlog as PL 20 | 21 | $(PL.deriveTypes "insurance.pl") 22 | 23 | testFunction :: Term -> Universal -> Variable 24 | testFunction t w = undefined 25 | 26 | 27 | $(PL.testCompileTimeCheck 'testFunction) 28 | 29 | main :: IO () 30 | main = do 31 | return () 32 | 33 | -------------------------------------------------------------------------------- /Haskell/THProlog/README.md: -------------------------------------------------------------------------------- 1 | # Example 2 | ~~~ shell 3 | 14:50 barak@berkos:~/Development/atidot/snippets/Haskell/THProlog (master) $ ./Main.hs 4 | -------------------------------------------------------------- 5 | Function: testFunction 6 | Type: AppT (AppT ArrowT (ConT Main.Term)) (AppT (AppT ArrowT (ConT Main.Universal)) (ConT Main.Variable)) 7 | Pretty Type: Main.Term -> Main.Universal -> Main.Variable 8 | -------------------------------------------------------------- 9 | TODO: analyze this type using Prolog, does it make sense? 10 | 14:50 barak@berkos:~/Development/atidot/snippets/Haskell/THProlog (master) $ 11 | ~~~ 12 | -------------------------------------------------------------------------------- /Haskell/THProlog/THProlog.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz -i runhaskell -p swiProlog -p "pkgs.haskell.packages.ghc864.ghcWithPackages (ps: with ps; [template-haskell process lens])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE QuasiQuotes #-} 7 | {-# LANGUAGE DeriveLift #-} 8 | {-# LANGUAGE StandaloneDeriving #-} 9 | module THProlog where 10 | 11 | import "base" Control.Monad (void) 12 | import "base" Data.Char (toUpper) 13 | import "lens" Control.Lens 14 | import "process" System.Process (readProcess) 15 | import "template-haskell" Language.Haskell.TH 16 | import "template-haskell" Language.Haskell.TH.Syntax 17 | import "template-haskell" Language.Haskell.TH.Quote 18 | import "template-haskell" Language.Haskell.TH.Ppr 19 | 20 | -- 21 | deriveTypes :: FilePath -> DecsQ 22 | deriveTypes prologPath = do 23 | xs <- runIO 24 | $ readProcess "swipl" 25 | [ "-f", prologPath 26 | -- 27 | , "-g", "forall(type(X, life), writeln(X))." 28 | -- 29 | , "-t", "halt." 30 | ] 31 | "" 32 | let typesNames = map (over _head toUpper) 33 | . filter (not . elem '(') 34 | . lines 35 | $ xs 36 | 37 | let dataTypes = map mkDataType typesNames 38 | return dataTypes 39 | where 40 | mkDataType name 41 | = DataD [] 42 | (mkName name) 43 | [] 44 | Nothing 45 | [] 46 | [] 47 | 48 | -- 49 | testCompileTimeCheck :: Name -> DecsQ 50 | testCompileTimeCheck name = do 51 | (VarI name' type' _) <- reify name 52 | runIO $ putStrLn $ "--------------------------------------------------------------" 53 | runIO $ putStrLn $ "Function: " <> nameBase name' 54 | runIO $ putStrLn $ "Type: " <> show type' 55 | runIO $ putStrLn $ "Pretty Type: " <> pprint type' 56 | runIO $ putStrLn $ "--------------------------------------------------------------" 57 | runIO $ putStrLn $ "TODO: analyze this type using Prolog, does it make sense?" 58 | return [] 59 | 60 | 61 | -- 62 | main :: IO () 63 | main = do 64 | xs <- runQ $ deriveTypes "insurance.pl" 65 | putStrLn $ pprint xs 66 | -------------------------------------------------------------------------------- /Haskell/THProlog/insurance.pl: -------------------------------------------------------------------------------- 1 | % -*- Mode: Prolog -*- 2 | :- discontiguous type/2. 3 | :- discontiguous reference/2. 4 | 5 | type(insurance, contract). 6 | 7 | type(life, insurance). 8 | type(health, insurance). 9 | type(disability, insurance). 10 | type(long_term_care, insurance). 11 | type(home, insurance). 12 | type(auto, insurance). 13 | reference(type(_, insurance), uri("https://www.investopedia.com/terms/i/insurance.asp")). 14 | 15 | type(term, life). 16 | type(universal, life). 17 | type(variable, life). 18 | reference(type(_, life), uri("https://www.investopedia.com/terms/l/lifeinsurance.asp")). 19 | 20 | type(level_term, term). 21 | type(yearly_renewable_term, term). 22 | type(decreasing_term, term). 23 | reference(type(_, term), uri("https://www.investopedia.com/terms/t/termlife.asp")). 24 | 25 | sub_type(X,Y) :- type(X,Y). 26 | sub_type(X,Y) :- type(X,Z), sub_type(Z,Y). 27 | -------------------------------------------------------------------------------- /Haskell/Terraform.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/19.03.tar.gz -i runhaskell -p "(pkgs.haskell.packages.ghc864.extend (self: super: with haskell; { language-python = lib.doJailbreak super.language-python; terraform-hs = lib.doJailbreak (self.callPackage({ mkDerivation, base, containers, data-default, fetchgit, filepath, stdenv, text, transformers}: mkDerivation {pname = \"terraform-hs\";version = \"0.1.0.0\";src = fetchgit { url = \"https://github.com/Atidot/terraform-hs\"; sha256 = \"1bxfpi686b6278bln5bdj57jw3cizyvwjb0vnq08swvg4l5j2z9w\"; rev = \"1bxfpi686b6278bln5bdj57jw3cizyvwjb0vnq08swvg4l5j2z9w\"; fetchSubmodules = true;};libraryHaskellDepends = [ base containers data-default filepath text transformers];homepage = \"https://github.com/timbod7/terraform-hs#readme\";description = \"Initial project template from stack\";license = stdenv.lib.licenses.bsd3;}) {}); })).ghcWithPackages (ps: with ps; [containers lens ps.terraform-hs])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | module Main where 7 | 8 | import "base" Control.Monad(void) 9 | import "base" Data.Monoid 10 | import "lens" Control.Lens 11 | import "terraform-hs" Language.Terraform.Core 12 | import "terraform-hs" Language.Terraform.Aws 13 | 14 | import qualified "containers" Data.Map as M 15 | import qualified "text" Data.Text as T 16 | import qualified "terraform-hs" Language.Terraform.Util.Text as T 17 | 18 | 19 | -- generates simple configuration as used in the tutorial for terrform 20 | -- https://learn.hashicorp.com/terraform/getting-started/build 21 | -- the difference is only in instances name, due to the terraform-hs name labeling 22 | simpleConfig :: TF AwsInstance 23 | simpleConfig = awsInstance' "example" "ami-2757f631" "t2.micro" 24 | 25 | main :: IO () 26 | main = generateFiles "" $ do 27 | withNameScope "example" $ do 28 | newAws (makeAwsParams "us-east-1"){aws_profile="default"} 29 | simpleConfig 30 | return () 31 | -------------------------------------------------------------------------------- /Haskell/TestReflex.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.03.tar.gz --pure -i ghcjs -p "(pkgs.haskell.packages.ghcjsHEAD.extend (self: super: with haskell; rec { exception-transformers = haskell.lib.doJailbreak (haskell.lib.dontCheck super.exception-transformers); \"reflex\" = self.callPackage ({ mkDerivation, base, bifunctors, comonad, containers, criterion , data-default, deepseq, dependent-map, dependent-sum , exception-transformers, fetchgit, haskell-src-exts , haskell-src-meta, lens, loch-th, MemoTrie, monad-control, mtl , prim-uniq, primitive, process, random, ref-tf, reflection , semigroupoids, semigroups, split, stdenv, stm, syb , template-haskell, these, time, transformers, transformers-compat , unbounded-delays , ghcjs-base }: mkDerivation { pname = \"reflex\"; version = \"0.5\"; src = fetchgit { url = \"https://github.com/reflex-frp/reflex\"; sha256 = \"1lbsy7lycxg3g6nzxs57rhh851xj8b61jvnwmvc3acr70wcmdq3w\"; rev = \"5d9c8a00f2eb832f109c870963182149b988062a\"; }; configureFlags = [ \"-fexpose-all-unfoldings\" \"-f-use-template-haskell\" ]; libraryHaskellDepends = [ base bifunctors comonad containers data-default dependent-map dependent-sum exception-transformers haskell-src-exts haskell-src-meta lens MemoTrie monad-control mtl prim-uniq primitive random ref-tf reflection semigroupoids semigroups stm syb template-haskell these time transformers transformers-compat unbounded-delays ghcjs-base ]; testHaskellDepends = [ base bifunctors containers deepseq dependent-map dependent-sum lens mtl ref-tf semigroups split these transformers ]; benchmarkHaskellDepends = [ base containers criterion deepseq dependent-map dependent-sum loch-th mtl primitive process ref-tf split stm time transformers ]; jailbreak = true; doHaddock = false; doCheck = false; homepage = \"https://github.com/reflex-frp/reflex\"; description = \"Higher-order Functional Reactive Programming\"; license = stdenv.lib.licenses.bsd3; }) {}; \"reflex-dom-core\" = self.callPackage ({ mkDerivation, aeson, base, bifunctors, bimap, blaze-builder , bytestring, constraints, containers, contravariant, data-default , dependent-map, dependent-sum, dependent-sum-template, directory , exception-transformers, fetchgit, ghcjs-dom, hlint, jsaddle , jsaddle-warp, keycode, lens, linux-namespaces, monad-control, mtl , network-uri, primitive, process, ref-tf, reflex, semigroups , stdenv, stm, template-haskell, temporary, text, these , transformers, unix, zenc }: mkDerivation { pname = \"reflex-dom-core\"; version = \"0.4\"; src = fetchgit { url = \"https://github.com/reflex-frp/reflex-dom\"; sha256 = \"0fx9dmgzzvy42g5by6g1fgl6ma8qql9qln2kr27rjg36za3prmh0\"; rev = \"14f14464e29a36e473c0bc2a6933575aab8c1ab5\"; }; postUnpack = \"sourceRoot+=/reflex-dom-core; echo source root reset to $sourceRoot\"; libraryHaskellDepends = [ aeson base bifunctors bimap blaze-builder bytestring constraints containers contravariant data-default dependent-map dependent-sum dependent-sum-template directory exception-transformers ghcjs-dom jsaddle keycode lens monad-control mtl network-uri primitive ref-tf reflex semigroups stm template-haskell text these transformers unix zenc ]; testHaskellDepends = [ base hlint jsaddle jsaddle-warp linux-namespaces process reflex temporary unix ]; description = \"Functional Reactive Web Apps with Reflex\"; license = stdenv.lib.licenses.bsd3; }) {}; \"reflex-dom\" = self.callPackage ({ mkDerivation, base, bytestring, fetchgit , reflex, reflex-dom-core, stdenv, text }: mkDerivation { pname = \"reflex-dom\"; version = \"0.4\"; src = fetchgit { url = \"https://github.com/reflex-frp/reflex-dom\"; sha256 = \"0fx9dmgzzvy42g5by6g1fgl6ma8qql9qln2kr27rjg36za3prmh0\"; rev = \"14f14464e29a36e473c0bc2a6933575aab8c1ab5\"; }; postUnpack = \"sourceRoot+=/reflex-dom; echo source root reset to $sourceRoot\"; isLibrary = true; isExecutable = true; libraryHaskellDepends = [ base bytestring reflex reflex-dom-core text ]; description = \"Functional Reactive Web Apps with Reflex\"; license = stdenv.lib.licenses.bsd3; }) {}; \"jsaddle\" = self.callPackage ({ mkDerivation, aeson, attoparsec, base, base64-bytestring , bytestring, containers, deepseq, exceptions, fetchgit, filepath , ghc-prim, http-types, lens, primitive, process, random, ref-tf , scientific, stdenv, stm, text, time, transformers, unliftio-core , unordered-containers, vector , ghcjs-base }: mkDerivation { pname = \"jsaddle\"; version = \"0.9.4.0\"; src = fetchgit { url = \"https://github.com/ghcjs/jsaddle\"; sha256 = \"143r9nfglkydhp6rl0qrsyfpjnxfj04fhn96cf8hkx2mk09baa01\"; rev = \"6a8fbe20cfd4ea00e197acdf311a650b97cb9a61\"; }; postUnpack = \"sourceRoot+=/jsaddle; echo source root reset to $sourceRoot\"; libraryHaskellDepends = [ aeson attoparsec base base64-bytestring bytestring containers deepseq exceptions filepath ghc-prim http-types lens primitive process random ref-tf scientific stm text time transformers unliftio-core unordered-containers vector ghcjs-base ]; description = \"Interface for JavaScript that works with GHCJS and GHC\"; license = stdenv.lib.licenses.mit; }) {}; })).ghcWithPackages (ps: with ps; [exception-transformers jsaddle reflex reflex-dom reflex-dom-core])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE TypeFamilies #-} 7 | module Main where 8 | 9 | import "base" Control.Monad.IO.Class (liftIO) 10 | import "time" Data.Time.Clock (getCurrentTime) 11 | import "reflex" Reflex 12 | import "reflex-dom" Reflex.Dom 13 | 14 | main :: IO () 15 | main = mainWidget $ do 16 | cb1 <- checkbox True def 17 | cb2 <- checkbox True def 18 | cb3 <- checkbox True def 19 | let sequencedD = sequence [ _checkbox_value cb1 20 | , _checkbox_value cb2 21 | , _checkbox_value cb3 22 | ] 23 | display sequencedD 24 | now <- liftIO getCurrentTime 25 | timerE <- tickLossy 0.5 now 26 | ticksD <- count timerE 27 | display ticksD 28 | -------------------------------------------------------------------------------- /Haskell/UnagiBloom.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.03.tar.gz --pure -i ghcjs -p "(pkgs.haskell.packages.ghcjsHEAD.extend (self: super: with haskell; {})).ghcWithPackages (ps: with ps; [unagi-bloomfilter text bytestring])" 3 | {-# OPTIONS_GHC -Wall -Werror #-} 4 | {-# LANGUAGE PackageImports #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | module Main where 9 | 10 | import "unagi-bloomfilter" Control.Concurrent.BloomFilter as Bloom 11 | import "text" Data.Text (Text) 12 | 13 | main :: IO () 14 | main = do 15 | b_5_20 <- Bloom.new (Bloom.SipKey 1 1) 5 20 16 | _ <- Bloom.insert b_5_20 "test" 17 | p <- Bloom.lookup b_5_20 ("test" :: Text) 18 | print p 19 | 20 | b_5_20' <- deserialize (Bloom.SipKey 1 1) =<< serialize b_5_20 21 | p' <- Bloom.lookup b_5_20' ("test" :: Text) 22 | print p' 23 | -------------------------------------------------------------------------------- /Haskell/WebBlog.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell -I nixpkgs=https://github.com/NixOS/nixpkgs/archive/18.09.tar.gz --pure -i runhaskell -p "pkgs.haskellPackages.ghcWithPackages (ps: with ps; [aeson text lucid shakespeare clay])" 3 | {-# LANGUAGE PackageImports #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE QuasiQuotes #-} 7 | {-# LANGUAGE FlexibleContexts #-} 8 | 9 | import "text" Data.Text (Text) 10 | import "text" Data.Text.Lazy (toStrict) 11 | import qualified "text" Data.Text.IO as T (putStrLn) 12 | import "lucid" Lucid 13 | import "shakespeare" Text.Julius 14 | 15 | 16 | main :: IO () 17 | main = do 18 | T.putStrLn . toStrict $ renderText blog 19 | 20 | 21 | blog :: Html () 22 | blog = html_ $ do 23 | blogHead 24 | body_ $ do 25 | intro 26 | part1 27 | part2 28 | conclusion 29 | 30 | 31 | blogHead :: Html () 32 | blogHead = head_ $ do 33 | title_ "The Title" 34 | meta_ [charset_ "utf-8"] 35 | meta_ [ name_ "viewport" 36 | ,content_ "width=device-width, initial-scale=1" 37 | ] 38 | script' "https://cdnjs.cloudflare.com/ajax/libs/d3/5.9.1/d3.min.js" 39 | link' "https://cdnjs.cloudflare.com/ajax/libs/c3/0.6.12/c3.min.css" 40 | script' "https://cdnjs.cloudflare.com/ajax/libs/c3/0.6.12/c3.min.js" 41 | 42 | 43 | intro :: Html () 44 | intro = do 45 | h1_ "Intorduction" 46 | p_ $ do 47 | "lorem ipsum" 48 | "lorem ipsum" 49 | "lorem ipsum" 50 | "lorem ipsum" 51 | 52 | 53 | part1 :: Html () 54 | part1 = do 55 | h2_ "Part 1" 56 | p_ $ do 57 | "lorem ipsum" 58 | "lorem ipsum" 59 | "lorem ipsum" 60 | newline 61 | newline 62 | "lorem ipsum" 63 | ul_ $ do 64 | li_ $ "A" --> "http://www.wikipedia.org" 65 | li_ $ "B" --> "http://www.wikipedia.org" 66 | li_ $ "C" --> "http://www.wikipedia.org" 67 | 68 | 69 | part2 :: Html () 70 | part2 = do 71 | h2_ "Part 2" 72 | p_ $ do 73 | "lorem ipsum" 74 | "lorem ipsum" 75 | "lorem ipsum" >> b_ "lorem ipsum" >> "lorem ipsum" 76 | newline 77 | "lorem ipsum" >> b_ "lorem ipsum" >> "lorem ipsum" 78 | ul_ $ do 79 | li_ $ "X" --> "http://www.wikipedia.org" 80 | li_ $ "Y" --> "http://www.wikipedia.org" 81 | li_ $ "Z" --> "http://www.wikipedia.org" 82 | div_ [id_ "chart"] "" 83 | barChart 84 | where 85 | 86 | 87 | conclusion :: Html () 88 | conclusion = do 89 | h2_ $ "Conslusion" 90 | p_ $ do 91 | "lorem ipsum" 92 | "lorem ipsum" 93 | newline 94 | "lorem ipsum" 95 | newline 96 | 97 | 98 | barChart :: Html () 99 | barChart = do 100 | scriptJs [js| 101 | var chart = c3.generate({ 102 | bindto: "#chart", 103 | grid: { 104 | x: { 105 | show: true 106 | }, 107 | y: { 108 | show: true 109 | } 110 | }, 111 | axis: { 112 | y : { 113 | tick: { 114 | format: d3.format("$,") 115 | } 116 | } 117 | }, 118 | data: { 119 | type: "bar", 120 | x: "x", 121 | json: { 122 | x: [2010, 2011, 2012, 2013, 2014, 2015], 123 | A: [30, 20, 50, 40, 60, 50], 124 | B: [200, 130, 90, 240, 130, 220], 125 | C: [300, 200, 160, 400, 250, 250] 126 | } 127 | } 128 | }); 129 | |] 130 | 131 | 132 | -- helpers 133 | text --> uri = a_ [href_ uri] text 134 | script' uri = script_ [src_ uri] ("" :: Text) 135 | scriptJs js = script_ [] $ renderJs js 136 | link' uri = link_ [ rel_ "stylesheet", href_ uri ] 137 | 138 | newline :: Html () 139 | newline = br_ [] 140 | 141 | renderJs = renderJavascriptUrl (\_ _ -> undefined) 142 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2019, Atidot 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # snippets 2 | ### Atidot Code Snippets 3 | * Single file 4 | * Runnable 5 | * Reproducible 6 | * 0 setup (no hard build / install) 7 | * Using Nix-"shebang" line (https://nixos.org/nix/manual/#use-as-a-interpreter) 8 | 9 | These are useful as a starting point for playing around and experimenting with Haskell packages, without caring too much about build environment or tools (Cabal, Stack, Nix, etc.). 10 | #### Disclaimer 11 | We DO NOT encourage this hack-ish ugly one-liner style for production code. 12 | For production we recommend using organized Nix source trees with as much https://dhall-lang.org/ as possible. 13 | ## Credits 14 | Credit goes to these wonderful packages and their creators: 15 | ~~~shell 16 | ~/atidot/snippets/Haskell (master) $ grep import *.hs | grep -o '".*"' | sort | uniq | sed -E 's|"(.*)"|http://hackage.haskell.org/package/\1|g' 17 | http://hackage.haskell.org/package/base 18 | http://hackage.haskell.org/package/bytestring 19 | http://hackage.haskell.org/package/casing 20 | http://hackage.haskell.org/package/conduit 21 | http://hackage.haskell.org/package/conduit-extra 22 | http://hackage.haskell.org/package/directory 23 | http://hackage.haskell.org/package/http-types 24 | http://hackage.haskell.org/package/inline-java 25 | http://hackage.haskell.org/package/jvm 26 | http://hackage.haskell.org/package/lens 27 | http://hackage.haskell.org/package/lucid 28 | http://hackage.haskell.org/package/parallel 29 | http://hackage.haskell.org/package/pyfi 30 | http://hackage.haskell.org/package/reflex 31 | http://hackage.haskell.org/package/reflex-dom 32 | http://hackage.haskell.org/package/resourcet 33 | http://hackage.haskell.org/package/retry 34 | http://hackage.haskell.org/package/sbv 35 | http://hackage.haskell.org/package/shakespeare 36 | http://hackage.haskell.org/package/tagsoup 37 | http://hackage.haskell.org/package/template-haskell 38 | http://hackage.haskell.org/package/text 39 | http://hackage.haskell.org/package/time 40 | http://hackage.haskell.org/package/unagi-bloomfilter 41 | http://hackage.haskell.org/package/wai 42 | http://hackage.haskell.org/package/wai-extra 43 | http://hackage.haskell.org/package/warp 44 | http://hackage.haskell.org/package/warp-tls 45 | http://hackage.haskell.org/package/wreq 46 | ~~~ 47 | ## AlternativeTest.hs 48 | ~~~shell 49 | ~/atidot/snippets/Haskell (master) $ ./AlternativeTest.hs 50 | Nothing 51 | [2,4,6,4,6,4,6,8,6,8,6,8,10] 52 | Just 11 53 | "shouldn't get here" 54 | AlternativeTest.hs: user error (mzero) 55 | ~~~ 56 | ## AzureCLICodegen.hs 57 | Generating Haskell data types for Azure CLI commands based on online documentation. 58 | For example: https://docs.microsoft.com/en-us/cli/azure/group?view=azure-cli-latest#az-group-list 59 | ~~~shell 60 | ~/atidot/snippets/Haskell (master) $ ./AzureCLICodegen.hs 61 | data Group 62 | = Create {_groupCreate_location :: !String, 63 | _groupCreate_name :: !String, 64 | _groupCreate_subscription :: !(Maybe String), 65 | _groupCreate_tags :: !(Maybe String)} 66 | | Delete {_groupDelete_name :: !String, 67 | _groupDelete_noWait :: !(Maybe String), 68 | _groupDelete_subscription :: !(Maybe String), 69 | _groupDelete_yes :: !(Maybe String)} 70 | | Exists {_groupExists_name :: !String, 71 | _groupExists_subscription :: !(Maybe String)} 72 | | Export {_groupExport_name :: !String, 73 | _groupExport_includeComments :: !(Maybe String), 74 | _groupExport_includeParameterDefaultValue :: !(Maybe String), 75 | _groupExport_subscription :: !(Maybe String)} 76 | | List {_groupList_subscription :: !(Maybe String), 77 | _groupList_tag :: !(Maybe String)} 78 | | Show {_groupShow_name :: !String, 79 | _groupShow_subscription :: !(Maybe String)} 80 | | Update {_groupUpdate_name :: !String, 81 | _groupUpdate_add :: !(Maybe String), 82 | _groupUpdate_forceString :: !(Maybe String), 83 | _groupUpdate_remove :: !(Maybe String), 84 | _groupUpdate_set :: !(Maybe String), 85 | _groupUpdate_subscription :: !(Maybe String), 86 | _groupUpdate_tags :: !(Maybe String)} 87 | | Wait {_groupWait_name :: !String, 88 | _groupWait_created :: !(Maybe String), 89 | _groupWait_custom :: !(Maybe String), 90 | _groupWait_deleted :: !(Maybe String), 91 | _groupWait_exists :: !(Maybe String), 92 | _groupWait_interval :: !(Maybe String), 93 | _groupWait_subscription :: !(Maybe String), 94 | _groupWait_timeout :: !(Maybe String), 95 | _groupWait_updated :: !(Maybe String)} 96 | deriving (Show, Read, Eq) 97 | ~~~ 98 | ## Conduits.hs 99 | ~~~shell 100 | ~/atidot/snippets/Haskell (master) $ echo -e "hello\nworld" | ./Conduits.hs 101 | HELLO 102 | WORLD 103 | ~~~ 104 | ## ForceSSL.hs 105 | ~~~shell 106 | root@berkos:/home/barak/Development/atidot/snippets/Haskell# ./ForceSSL.hs 107 | ~~~ 108 | ## Java.hs 109 | ~~~shell 110 | ~/atidot/snippets/Haskell (master) $ ./Java.hs 111 | [1 of 1] Compiling Main ( Java.hs, Java.o ) [flags changed] 112 | Linking Java ... 113 | ~/atidot/snippets/Haskell (master) $ ./Java 114 | ~~~ 115 | ## Pyfi.hs 116 | ~~~shell 117 | ~/atidot/snippets/Haskell (master) $ ./Pyfi.hs 118 | ------------ 119 | From Python: 120 | 0 1 2 121 | 0 1 2 3 122 | 1 4 5 6 123 | 2 7 8 9 124 | "-------------" 125 | "From Haskell:" 126 | [12,15,18] 127 | ~~~ 128 | ## Retry.hs 129 | ~~~shell 130 | ~/atidot/snippets/Haskell (master) $ ./Retry.hs 131 | "Still waiting for file..." 132 | "Still waiting for file..." 133 | "Still waiting for file..." 134 | "Still waiting for file..." 135 | "Still waiting for file..." 136 | "Still waiting for file..." 137 | ~~~ 138 | ## SBV.hs 139 | ~~~shell 140 | ~/atidot/snippets/Haskell (master) $ ./SBV.hs 141 | Satisfiable. Model: 142 | x = 4 :: Integer 143 | y = -3 :: Integer 144 | ~~~ 145 | ## Strategies.hs 146 | ~~~shell 147 | ~/atidot/snippets/Haskell (master) $ ./Strategies.hs 148 | [1 of 1] Compiling Main ( Strategies.hs, Strategies.js_o ) 149 | Linking Strategies.jsexe (Main) 150 | ~/atidot/snippets/Haskell (master) $ node Strategies.jsexe/all.js 151 | warning, unhandled primop: SparkOp (1,1) 152 | uncaught exception in Haskell main thread: ReferenceError: h$primop_SparkOp is not defined 153 | ReferenceError: h$primop_SparkOp is not defined 154 | at h$$wV (/home/barak/Development/atidot/snippets/Haskell/Strategies.jsexe/all.js:46753:3) 155 | at h$runThreadSlice (/home/barak/Development/atidot/snippets/Haskell/Strategies.jsexe/all.js:8625:11) 156 | at h$runThreadSliceCatch (/home/barak/Development/atidot/snippets/Haskell/Strategies.jsexe/all.js:8577:12) 157 | at Immediate.h$mainLoop [as _callback] (/home/barak/Development/atidot/snippets/Haskell/Strategies.jsexe/all.js:8572:9) 158 | at runCallback (timers.js:781:20) 159 | at tryOnImmediate (timers.js:743:5) 160 | at processImmediate [as _immediateCallback] (timers.js:714:5) 161 | 162 | ~~~ 163 | ## TestReflex.hs 164 | ~~~shell 165 | ~/atidot/snippets/Haskell (master) $ ./TestReflex.hs 166 | Linking TestReflex.jsexe (Main) 167 | ~/atidot/snippets/Haskell (master) $ firefox TestReflex.jsexe/index.html 168 | ~~~ 169 | ## UnagiBloom.hs 170 | ~~~shell 171 | ~/atidot/snippets/Haskell (master) $ ./UnagiBloom.hs 172 | Linking UnagiBloom.jsexe (Main) 173 | ~/atidot/snippets/Haskell (master) $ node UnagiBloom.jsexe/all.js 174 | True 175 | True 176 | ~~~ 177 | ## WebBlog.hs 178 | ~~~shell 179 | ~/atidot/snippets/Haskell (master) $ ./WebBlog.hs 180 | The Title

Intorduction

lorem ipsumlorem ipsumlorem ipsumlorem ipsum

Part 1

lorem ipsumlorem ipsumlorem ipsum

lorem ipsum

Part 2

lorem ipsumlorem ipsumlorem ipsumlorem ipsumlorem ipsum
lorem ipsumlorem ipsumlorem ipsum

Conslusion

lorem ipsumlorem ipsum
lorem ipsum

210 | ~/atidot/snippets/Haskell (master) $ ./WebBlog.hs > WebBlog.html 211 | ~/atidot/snippets/Haskell (master) $ firefox WebBlog.html 212 | ~~~ 213 | --------------------------------------------------------------------------------