Browse code
(init)
Ed Langley authored on 08/05/2019 06:29:51Showing 5 changed files
| 0 | 3 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,45 @@ |
| 1 |
+{-# LANGUAGE RankNTypes #-}
|
|
| 2 |
+{-# LANGUAGE TypeApplications #-}
|
|
| 3 |
+{-# LANGUAGE DeriveGeneric #-}
|
|
| 4 |
+{-# LANGUAGE DataKinds #-}
|
|
| 5 |
+ |
|
| 6 |
+module Main where |
|
| 7 |
+ |
|
| 8 |
+import GHC.Generics |
|
| 9 |
+import Control.Lens |
|
| 10 |
+import Data.Generics.Product |
|
| 11 |
+ |
|
| 12 |
+data Person = Person { name :: String, age :: Int, eye_color :: String }
|
|
| 13 |
+ deriving (Show, Generic) |
|
| 14 |
+ |
|
| 15 |
+data Person' = Person' { name' :: String, age' :: String, eye_color' :: String }
|
|
| 16 |
+ deriving (Show, Generic, Eq) |
|
| 17 |
+ |
|
| 18 |
+ageT :: Functor f => (Int -> f String) -> Person -> f Person' |
|
| 19 |
+ageT f (Person name p_age eye_color) = fmap (\v -> Person' name v eye_color) (f p_age) |
|
| 20 |
+ |
|
| 21 |
+printAndReturn :: String -> IO String |
|
| 22 |
+printAndReturn v = do |
|
| 23 |
+ putStrLn v |
|
| 24 |
+ pure v |
|
| 25 |
+ |
|
| 26 |
+intoIdentity :: String -> Identity String |
|
| 27 |
+intoIdentity v = pure $ "{" ++ v ++ "}"
|
|
| 28 |
+ |
|
| 29 |
+printFocus :: (Show a, Functor m) => (a -> m a') -> Lens s s' a a' -> s -> m s' |
|
| 30 |
+printFocus f lens struct = lens f struct |
|
| 31 |
+ |
|
| 32 |
+doMain :: Monad m => (String -> m String) -> Person -> m Person' |
|
| 33 |
+doMain f p = do |
|
| 34 |
+ p <- printFocus f (field @ "name") p |
|
| 35 |
+ p <- printFocus f (field @ "eye_color") p |
|
| 36 |
+ printFocus (f . show) ageT p |
|
| 37 |
+ |
|
| 38 |
+doMainWorks :: Bool |
|
| 39 |
+doMainWorks = (runIdentity $ doMain intoIdentity person) == Person' "{Bob}" "{12}" "{hazel}"
|
|
| 40 |
+ |
|
| 41 |
+person = Person "Bob" 12 "hazel" |
|
| 42 |
+main :: IO () |
|
| 43 |
+main = do |
|
| 44 |
+ doMain printAndReturn person |
|
| 45 |
+ putStrLn $ "works? " ++ (show doMainWorks) |
| 0 | 46 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,24 @@ |
| 1 |
+name: lens-test |
|
| 2 |
+version: 0.1.0.0 |
|
| 3 |
+github: "githubuser/lens-test" |
|
| 4 |
+license: BSD3 |
|
| 5 |
+author: "Author name here" |
|
| 6 |
+maintainer: "example@example.com" |
|
| 7 |
+copyright: "2019 Author name here" |
|
| 8 |
+ |
|
| 9 |
+description: Please see the README on GitHub at <https://github.com/githubuser/lens-test#readme> |
|
| 10 |
+ |
|
| 11 |
+dependencies: |
|
| 12 |
+- base >= 4.7 && < 5 |
|
| 13 |
+ |
|
| 14 |
+executables: |
|
| 15 |
+ lens-test-exe: |
|
| 16 |
+ main: Main.hs |
|
| 17 |
+ source-dirs: app |
|
| 18 |
+ ghc-options: |
|
| 19 |
+ - -threaded |
|
| 20 |
+ - -rtsopts |
|
| 21 |
+ - -with-rtsopts=-N |
|
| 22 |
+ dependencies: |
|
| 23 |
+ - generic-lens |
|
| 24 |
+ - lens |
| 0 | 25 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,65 @@ |
| 1 |
+# This file was automatically generated by 'stack init' |
|
| 2 |
+# |
|
| 3 |
+# Some commonly used options have been documented as comments in this file. |
|
| 4 |
+# For advanced use and comprehensive documentation of the format, please see: |
|
| 5 |
+# https://docs.haskellstack.org/en/stable/yaml_configuration/ |
|
| 6 |
+ |
|
| 7 |
+# Resolver to choose a 'specific' stackage snapshot or a compiler version. |
|
| 8 |
+# A snapshot resolver dictates the compiler version and the set of packages |
|
| 9 |
+# to be used for project dependencies. For example: |
|
| 10 |
+# |
|
| 11 |
+# resolver: lts-3.5 |
|
| 12 |
+# resolver: nightly-2015-09-21 |
|
| 13 |
+# resolver: ghc-7.10.2 |
|
| 14 |
+# |
|
| 15 |
+# The location of a snapshot can be provided as a file or url. Stack assumes |
|
| 16 |
+# a snapshot provided as a file might change, whereas a url resource does not. |
|
| 17 |
+# |
|
| 18 |
+# resolver: ./custom-snapshot.yaml |
|
| 19 |
+# resolver: https://example.com/snapshots/2018-01-01.yaml |
|
| 20 |
+resolver: lts-13.19 |
|
| 21 |
+ |
|
| 22 |
+# User packages to be built. |
|
| 23 |
+# Various formats can be used as shown in the example below. |
|
| 24 |
+# |
|
| 25 |
+# packages: |
|
| 26 |
+# - some-directory |
|
| 27 |
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz |
|
| 28 |
+# - location: |
|
| 29 |
+# git: https://github.com/commercialhaskell/stack.git |
|
| 30 |
+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
|
| 31 |
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
|
| 32 |
+# subdirs: |
|
| 33 |
+# - auto-update |
|
| 34 |
+# - wai |
|
| 35 |
+packages: |
|
| 36 |
+- . |
|
| 37 |
+# Dependency packages to be pulled from upstream that are not in the resolver |
|
| 38 |
+# using the same syntax as the packages field. |
|
| 39 |
+# (e.g., acme-missiles-0.3) |
|
| 40 |
+extra-deps: |
|
| 41 |
+- intero-0.1.39 |
|
| 42 |
+ |
|
| 43 |
+# Override default flag values for local packages and extra-deps |
|
| 44 |
+# flags: {}
|
|
| 45 |
+ |
|
| 46 |
+# Extra package databases containing global packages |
|
| 47 |
+# extra-package-dbs: [] |
|
| 48 |
+ |
|
| 49 |
+# Control whether we use the GHC we find on the path |
|
| 50 |
+# system-ghc: true |
|
| 51 |
+# |
|
| 52 |
+# Require a specific version of stack, using version ranges |
|
| 53 |
+# require-stack-version: -any # Default |
|
| 54 |
+# require-stack-version: ">=1.9" |
|
| 55 |
+# |
|
| 56 |
+# Override the architecture used by stack, especially useful on Windows |
|
| 57 |
+# arch: i386 |
|
| 58 |
+# arch: x86_64 |
|
| 59 |
+# |
|
| 60 |
+# Extra directories used by stack for building |
|
| 61 |
+# extra-include-dirs: [/path/to/dir] |
|
| 62 |
+# extra-lib-dirs: [/path/to/dir] |
|
| 63 |
+# |
|
| 64 |
+# Allow a newer minor version of GHC than the snapshot specifies |
|
| 65 |
+# compiler-check: newer-minor |