Initial commit.

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.

complexnums/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+complexnums.cabal
+*~

complexnums/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for complexnums
+
+## Unreleased changes

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.

complexnums/README.md

@@ -0,0 +1 @@
+# complexnums

complexnums/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

complexnums/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

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 <https://github.com/githubuser/complexnums#readme>
+
+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

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

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

complexnums/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"

json-parser/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+json-parser.cabal
+*~

json-parser/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for json-parser
+
+## Unreleased changes

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.

json-parser/README.md

@@ -0,0 +1 @@
+# json-parser

json-parser/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

json-parser/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = someFunc

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 <https://github.com/githubuser/json-parser#readme>
+
+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

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))])

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

json-parser/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"