commit 9e9e083bdca836ab125f16fd4329fbaecbc3514b Author: empathicqubit Date: Sun Dec 16 07:33:17 2018 -0800 Initial commit. diff --git a/README.md b/README.md new file mode 100644 index 0000000..6031e6a --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# haskell-trash + +This is just a place for me to mess around with Haskell, and also to work through examples from "Quantum Computing for Computer Scientists" by Yanofsky and Manucci. diff --git a/complexnums/.gitignore b/complexnums/.gitignore new file mode 100644 index 0000000..c287498 --- /dev/null +++ b/complexnums/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +complexnums.cabal +*~ \ No newline at end of file diff --git a/complexnums/ChangeLog.md b/complexnums/ChangeLog.md new file mode 100644 index 0000000..0915ea1 --- /dev/null +++ b/complexnums/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for complexnums + +## Unreleased changes diff --git a/complexnums/LICENSE b/complexnums/LICENSE new file mode 100644 index 0000000..e037c72 --- /dev/null +++ b/complexnums/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +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 Author name here 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. diff --git a/complexnums/README.md b/complexnums/README.md new file mode 100644 index 0000000..ea37648 --- /dev/null +++ b/complexnums/README.md @@ -0,0 +1 @@ +# complexnums diff --git a/complexnums/Setup.hs b/complexnums/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/complexnums/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/complexnums/app/Main.hs b/complexnums/app/Main.hs new file mode 100644 index 0000000..de1c1ab --- /dev/null +++ b/complexnums/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = someFunc diff --git a/complexnums/package.yaml b/complexnums/package.yaml new file mode 100644 index 0000000..9cef8cb --- /dev/null +++ b/complexnums/package.yaml @@ -0,0 +1,50 @@ +name: complexnums +version: 0.1.0.0 +github: "githubuser/complexnums" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2018 Author name here" + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- regex-pcre +- lens + +library: + source-dirs: src + +executables: + complexnums-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - complexnums + +tests: + complexnums-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - complexnums diff --git a/complexnums/src/Lib.hs b/complexnums/src/Lib.hs new file mode 100644 index 0000000..d54e280 --- /dev/null +++ b/complexnums/src/Lib.hs @@ -0,0 +1,64 @@ +module Lib + ( someFunc + ) where + +import qualified System.IO as SIO +import Data.Function ((&)) +import Control.Arrow ((>>>)) +import Text.Regex.PCRE ((=~)) +import qualified Text.Regex.PCRE as PCRE +import Control.Lens.Operators + +if' :: Bool -> a -> a -> a +if' True x _ = x +if' False _ y = y + +prompt :: (String -> Bool) -> String -> IO String +prompt loopCondition text = line >>= breakorcontinue + where + breakorcontinue a = if' (loopCondition a) (return a) (prompt loopCondition text) + line = (text & putStr) >> + (SIO.stdout & SIO.hFlush) >> + getLine + +complexNumber = "^\\s*\\+?(-?\\s*[0-9\\.]+)?\\s*(\\+?((-\\s*)?[0-9\\.]*)i)?\\s*$" + +data ComplexNumber = ComplexNumber { + complexNumberReal :: Float, + complexNumberImaginary :: Float +} + +instance Show ComplexNumber where + show (ComplexNumber real imaginary) = [real & show, if' (imaginary >= 0) " + " " ", imaginary & show, "i"] & concat + +stringToComplex :: String -> ComplexNumber +stringToComplex input = ComplexNumber realValue imaginaryValue + where + realValue = if' (null realDigits) 0 (realDigits & read) + imaginaryValue = + if' (null imaginaryDigits) + (if' (null imaginaryPart) + 0 + 1 + ) + (imaginaryDigits & read) + _:realDigits:imaginaryPart:imaginaryDigits:_ = match + match:_ = input =~ complexNumber :: [[String]] + +addComplex :: ComplexNumber -> ComplexNumber -> ComplexNumber +addComplex a b = ComplexNumber (complexNumberReal a + complexNumberReal b) (complexNumberImaginary a + complexNumberImaginary b) + +multiplyComplex :: ComplexNumber -> ComplexNumber -> ComplexNumber +multiplyComplex a b = ComplexNumber (complexNumberReal a * complexNumberReal b - complexNumberImaginary a * complexNumberImaginary b) (complexNumberReal a * complexNumberImaginary b + complexNumberReal b * complexNumberImaginary a) + +someFunc :: IO () +someFunc = showResults <$> firstNumber <*> secondNumber >>= putStrLn + where + showResults f s = + [ + addComplex f s & show, + "\n", + multiplyComplex f s & show + ] & concat + firstNumber = ("Enter a complex number in the form of a + bi: " & prompt(=~ complexNumber)) <&> stringToComplex + secondNumber = ("Enter a second complex number in the form of a + bi: " & prompt(=~ complexNumber)) <&> stringToComplex diff --git a/complexnums/stack.yaml b/complexnums/stack.yaml new file mode 100644 index 0000000..36ad678 --- /dev/null +++ b/complexnums/stack.yaml @@ -0,0 +1,64 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-12.22 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.9" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/complexnums/test/Spec.hs b/complexnums/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/complexnums/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/json-parser/.gitignore b/json-parser/.gitignore new file mode 100644 index 0000000..42c6f39 --- /dev/null +++ b/json-parser/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +json-parser.cabal +*~ \ No newline at end of file diff --git a/json-parser/ChangeLog.md b/json-parser/ChangeLog.md new file mode 100644 index 0000000..0e6c688 --- /dev/null +++ b/json-parser/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for json-parser + +## Unreleased changes diff --git a/json-parser/LICENSE b/json-parser/LICENSE new file mode 100644 index 0000000..e037c72 --- /dev/null +++ b/json-parser/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +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 Author name here 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. diff --git a/json-parser/README.md b/json-parser/README.md new file mode 100644 index 0000000..72c1107 --- /dev/null +++ b/json-parser/README.md @@ -0,0 +1 @@ +# json-parser diff --git a/json-parser/Setup.hs b/json-parser/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/json-parser/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/json-parser/app/Main.hs b/json-parser/app/Main.hs new file mode 100644 index 0000000..2902947 --- /dev/null +++ b/json-parser/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = someFunc \ No newline at end of file diff --git a/json-parser/package.yaml b/json-parser/package.yaml new file mode 100644 index 0000000..c08103b --- /dev/null +++ b/json-parser/package.yaml @@ -0,0 +1,57 @@ +name: json-parser +version: 0.1.0.0 +github: "githubuser/json-parser" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2018 Author name here" + +default-extensions: +- ScopedTypeVariables +- DataKinds +- TupleSections + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- containers +- criterion + +library: + source-dirs: src + +executables: + json-parser-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -fprof-auto + - -fprof-cafs + - -with-rtsopts=-N + dependencies: + - json-parser + +tests: + json-parser-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - json-parser diff --git a/json-parser/src/Lib.hs b/json-parser/src/Lib.hs new file mode 100644 index 0000000..112f416 --- /dev/null +++ b/json-parser/src/Lib.hs @@ -0,0 +1,99 @@ +module Lib + ( someFunc + ) where + +import qualified Data.Map as Map +import qualified Data.List as List +import Data.Function ((&)) +import Control.Arrow ((>>>)) +import qualified Data.Maybe as Maybe +import Criterion.Main as Criterion + +data JsonToken = + JsonArray [JsonToken] + | JsonObject (Map.Map String JsonToken) + | JsonNothing + | JsonDouble Double + | JsonString String + | JsonBool Bool + | JsonNull + deriving Show + +parse :: String -> JsonToken +parse input = input & parseValue & parseTrailing + +parseTrailing :: (JsonToken, String) -> JsonToken +parseTrailing (o, []) = o +parseTrailing (o, input) + | (input & dropWhile(`List.elem` whitespace)) == [] = o + +whitespace = "\t\n\r " +numbers = "-1234567890." +skipChars = "\t\n\r ," +keywordChars = ['a'..'z'] + +parseValue :: String -> (JsonToken, String) +parseValue [] = (JsonNothing, []) +parseValue (chr:rest) + | chr == '{' = rest & parseObject + | chr == '[' = rest & parseArray + | chr `List.elem` numbers = chr:rest & parseNumber + | chr `List.elem` keywordChars = chr:rest & parseKeyword + | chr == '"' = chr:rest & parseString + | chr `List.elem` whitespace = rest & (dropWhile(`List.elem` whitespace)) & parseValue + +parseKeyword :: String -> (JsonToken, String) +parseKeyword input = input & span(`List.elem` keywordChars) & tryKeyword + +tryKeyword :: (String, String) -> (JsonToken, String) +tryKeyword (keyword, rest) + | keyword == "true" = (JsonBool True, rest) + | keyword == "false" = (JsonBool False, rest) + | keyword == "null" = (JsonNull, rest) + +parseNumber :: String -> (JsonToken, String) +parseNumber input = (num & read & JsonDouble, nrest) + where + (num, nrest) = input & (span(`List.elem` numbers)) + +parseString :: String -> (JsonToken, String) +parseString input = (val & JsonString, vrest & tail) + where (val, vrest) = input & getString + +getString :: String -> (String, String) +getString input = input & tail & span(/= '"') + +parseSequence :: String -> Char -> ((a, String) -> (a, String)) -> (a, String) -> (a, String) +parseSequence foundChars termChar worker (o, []) = (o, []) +parseSequence foundChars termChar worker (o, chr:rest) + | chr `List.elem` skipChars = rest & dropWhile(`List.elem` skipChars) & (o,) & parseSequence foundChars termChar worker + | chr == termChar = (o, rest) + | foundChars == [] || chr `List.elem` foundChars = (o, chr:rest) & worker & parseSequence foundChars termChar worker + +parseObject :: String -> (JsonToken, String) +parseObject input = (map & JsonObject, rest) + where (map, rest) = (Map.empty, input) & (parseSequence "\"" '}' parseProperty) + +parseArray :: String -> (JsonToken, String) +parseArray input = (arr & reverse & JsonArray, rest) + where (arr, rest) = ([], input) & (parseSequence "" ']' parseArrayItem) + +parseArrayItem :: ([JsonToken], String) -> ([JsonToken], String) +parseArrayItem (o, rest) = (val:final, frest) + where + (val, vrest) = rest & parseValue + (final, frest) = (o, vrest) + +parseProperty :: (Map.Map String JsonToken, String) -> (Map.Map String JsonToken, String) +parseProperty (m, rest) = (newm, frest) + where + newm = m & (Map.insert name val) + (name, vrest) = rest & getString + (val, frest) = vrest & dropWhile(/= ':') & tail & parseValue + +someFunc :: IO () +someFunc = getContents >>= (parse >>> show >>> putStrLn) +-- someFunc = defaultMain [ bgroup "main" [ Criterion.bench "main" $ whnf parse " { \"hello\" : \"world \" , \" hungry\" : [ \"grimace \", \" hamburgular\" , 2 ] , \" ronald\" : -334.3987 , \"mcdonald\": true }"]] + +-- x@x:~/json-parser/src$ echo '{"hello":"world", "hungry": ["grimace", "hamburgular", 2], "ronald": -334.3987, "mcdonald": true } ' | stack run +-- JsonObject (fromList [("hello",JsonString "world"),("hungry",JsonArray [JsonString "grimace",JsonString "hamburgular",JsonDouble 2.0]),("mcdonald",JsonBool True),("ronald",JsonDouble (-334.3987))]) diff --git a/json-parser/stack.yaml b/json-parser/stack.yaml new file mode 100644 index 0000000..11061ae --- /dev/null +++ b/json-parser/stack.yaml @@ -0,0 +1,64 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-12.20 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver +# using the same syntax as the packages field. +# (e.g., acme-missiles-0.3) +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.9" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/json-parser/test/Spec.hs b/json-parser/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/json-parser/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"