Fork me on GitHub

Files

mon@razerRamon:~/tmp/haskell/rhythm_counting$ ll
total 24K
-rwxrwxr-x 1 mon mon  960 Jul 10 21:31 Example.hs*
-rw-rw-r-- 1 mon mon 1.4K Jul 10 21:03 Rhythm.hs
mon@razerRamon:~/tmp/haskell/rhythm_counting$ 

Haskell Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
module Rhythm (nextBin,nextDec,nextHex,nextVar) where

import qualified Numeric   as Num
import qualified Data.Char as Char

{- The Rhythm of Counting -}

count :: Int -> Int -> Int -> [Int] -> [Int]
count up low val =
  let
    f [    ] = [val]
    f (x:xs) =
      case x == up of
        True  -> low : f xs
        False -> x + 1 : xs
  in
    f

hlp ::  Int -> Int -> Int -> [Int] -> Maybe [Int]
hlp up low val xs =
  case all (\x -> x >= low && x <= up) xs of
    True  -> Just (count up low val xs)
    False -> Nothing

nextHlp :: ([Int] -> Maybe [Int]) -> [Char] -> Maybe [Char]
nextHlp f xs =
  let
    ys = reverse xs
    ds = map Char.digitToInt ys
  in
    case f ds of
      Just vs -> Just (reverse (map Char.intToDigit vs))
      Nothing -> Nothing

nextBin :: [Char] -> Maybe [Char]
nextBin =
  nextHlp (hlp 1 0 1)

nextDec :: [Char] -> Maybe [Char]
nextDec =
  nextHlp (hlp 9 0 1)

nextHex :: [Char] -> Maybe [Char]
nextHex xs =
  let
    ys = reverse xs
    ds = map Char.digitToInt ys
  in
    case hlp 0xf 0x0 0x1 ds of
      Just vs -> Just (reverse (foldl (\a v -> a ++ Num.showHex v "") "" vs))
      Nothing -> Nothing

nextVar :: [Char] -> Maybe [Char]
nextVar xs =
  let
    ys = reverse xs
    cs = map Char.ord ys
  in
    case hlp 122 97 97 cs of
      Just vs -> Just (reverse (map Char.chr vs))
      Nothing -> Nothing
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
#!/usr/bin/env stack
{- stack
   --resolver lts-8.21
   --install-ghc
   runghc
   --
   -Wall -Werror
-}

module Main (main) where

import qualified Data.List as List
import qualified Rhythm    as Rhythm

main :: IO ()
main =
  let
    {- Infinity many unique (and optimal shortest?) variables -}
    vs x = List.unfoldr(\(Just v) -> Just (v, Rhythm.nextVar v)) (Just x)
  in
    do
      {- The next binary after 3 is 4: -}
      putStrLn (show (Just "1000" == Rhythm.nextBin "111"))
    
      {- The next number after 999 is 1000: -}
      putStrLn (show (Just "1000" == Rhythm.nextDec "999"))

      {- The next number after "fff" is 1000: -}
      putStrLn (show (Just "1000" == Rhythm.nextHex "fff"))

      {- The next variable after "zzz" is "aaaa": -}
      putStrLn (show (Just "aaaa" == Rhythm.nextVar "zzz"))

      {- We retrieve a 10 unique of the shortest variables, starting from "z" -}
      let ten = take 10 (vs "z") in putStrLn (show ten)

Haskell Code output:

mon@razerRamon:~/tmp/haskell/rhythm_counting$ ./Example.hs 
True
True
True
True
["z","aa","ab","ac","ad","ae","af","ag","ah","ai"]
mon@razerRamon:~/tmp/haskell/rhythm_counting$

References:

Idris Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
module Evoting

import Data.Vect
import Data.List

%default total

Name : Type
Name = String

Surname : Type
Surname = String

data Candidate = Person Name Surname
data Vote      = Blank | For Candidate
data Validity  = Valid Vote | Invalid

Eq Candidate where 
  (Person name1 surname1) == (Person name2 surname2) =
    name1 == name2 && surname1 == surname2
  (Person name1 surname1) /= (Person name2 surname2) =
    name1 /= name2 || surname1 /= surname2

validity : List Candidate -> Vote -> Validity
validity (Nil    ) __________ = Invalid
validity _________ (Blank   ) = Valid Blank
validity (x :: xs) (For vote) = 
  if x == vote then Valid (For vote) else validity xs (For vote)

invalidate : Vect n Vote -> Vect n Validity
invalidate (Nil    ) = Nil
invalidate (_ :: xs) = Invalid :: invalidate xs

election : List Candidate -> Vect n Vote -> Vect n Validity
election __________ (Nil          ) = Nil
election Nil        (votes        ) = invalidate votes
election candidates (vote :: votes) =
  validity candidates vote :: election candidates votes
                          
candidates : List Candidate
candidates =
  Person "John" "Doe" ::
  Person "Jane" "Doe" :: 
  []

{- Version 1: Replicate real life behaviour -}
votes : Vect 3 Vote {- We know the number of citizens -}
votes = 
  For (Person "Jane" "Doe") :: 
  For (Person "John" "Hoe") :: {- Invalid candidate -}
  Blank ::
  [] 

Idris Code output:

Welcome to the Idris REPL!
Idris 1.0

Type checking ./evoting.idr
λΠ> election candidates votes
[Valid (For (Person "Jane" "Doe")), Invalid, Valid Blank] : Vect 3 Validity
λΠ>

References:

Files

mon@razerRamon:~/tmp/haskell/howtoscript$ ll
total 24K
-rw-rw-r-- 1 mon mon 445 Jul  6 13:02 Logic.hs
-rwxrwxr-x 1 mon mon 457 Jul  6 14:12 Script.hs*
mon@razerRamon:~/tmp/haskell/howtoscript$

Haskell Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
module Logic (dimensions) where

{- Dependency to a Hackage pkg: https://hackage.haskell.org/package/terminfo -}
import qualified System.Console.Terminfo.Base as Term
import           System.Console.Terminfo.Cursor

dimensions :: IO (Int,Int)
dimensions =
  do
    term <- Term.setupTermFromEnv
    
    let (Just height) = Term.getCapability term termLines
    let (Just width)  = Term.getCapability term termColumns

    return (height,width)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
#!/usr/bin/env stack
{- stack
   --resolver lts-8.21
   --install-ghc
   script
   --package terminfo
   --
   -Wall -Werror
-}

module Main (main) where

{- Import local file which has a dependency to a Hackage pkg:
   https://hackage.haskell.org/package/terminfo
-}
import qualified Logic as Terminal

main :: IO ()
main =
  do
    (height,width) <- Terminal.dimensions
    
    putStrLn ("Term height: " ++ (show height) ++ " & width: " ++ (show width))

Haskell Code output:

mon@razerRamon:~/tmp/haskell/howtoscript$ ./Script.hs 
Term height: 57 & width: 199
mon@razerRamon:~/tmp/haskell/howtoscript$ 

References:

Files

mon@razerRamon:~/tmp/encapsulation$ ll -R
.:
total 12K
drwxrwxr-x 2 mon mon 4.0K May 31 23:08 cs/
drwxrwxr-x 2 mon mon 4.0K May 31 23:10 fs/
drwxrwxr-x 2 mon mon 4.0K May 31 23:03 hs/

./cs:
total 36K
-rwxrwxr-x 1 mon mon   57 May 31 21:36 build.bash*
-rw-rw-r-- 1 mon mon  662 May 31 23:07 Movie.cs
-rwxrwxr-x 1 mon mon 3.5K May 31 23:08 Movie.exe*

./fs:
total 12K
-rwxrwxr-x 1 mon mon 694 May 31 23:10 Movie.fsx*

./hs:
total 24K
-rw-rw-r-- 1 mon mon 470 May 31 23:03 Movie.hs
-rwxrwxr-x 1 mon mon 466 May 31 23:02 Program.hs*
mon@razerRamon:~/tmp/encapsulation$ 

C# Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
using System;

class Program
{
    public class Movie
    {
	private uint rating = 0;

	public uint Rating /* Values between 0 (default) and 5 */
	{
	    get
	    {
		return rating;
	    }
	    set
	    {
		if (value > 5)
		{
		    rating = 5; /* Normalize high values to 0 - 5 scale */
		}
		else
		{
		    rating = value;
		}
	    }
	}
    }

    static void Main()
    {
	var movie = new Movie();
	/* Computer says no:
	   
	   Movie.cs(33,8): error CS0122: `Program.Movie.rating' is inaccessible 
	   due to its protection level
	   
	movie.rating = 1024; */
	movie.Rating = 1024;
	Console.WriteLine("Movie rating equals 5: {0}", movie.Rating == 5);
    }
}

C# Code output:

mon@razerRamon:~/tmp/encapsulation/cs$ ./build.bash && ./Movie.exe 
Movie rating equals 5: True

F# Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
#!/usr/bin/env fsharpi

module Movie =
  type movie = { rating : rating }
  and rating = private Rating of uint32 (* Values between 0 (default) and 5 *)
  
  let init () = { rating = Rating 0u }
  
  let get { rating = Rating value } = value
  let set value movie =
    let value' =
      match value > 5u with
        | true  -> 5u
        | false -> value
    { movie with rating = Rating value' }

let movie  = Movie.init()
(* Computer says no:

   Movie.fsx(23,36): error FS0039: The value or constructor 'Rating' is not
   defined
   
let movie' = { movie with rating = Rating 1024u } *)
let movie' = movie |> Movie.set 1024u
printfn "Movie rating equals 5: %b" (movie' |> Movie.get = 5u)

F# Code output:

mon@razerRamon:~/tmp/encapsulation/fs$ ./Movie.fsx 
Movie rating equals 5: true

Haskell Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
module Movie (Movie, create, get, set) where

newtype Rating = Rating Integer

data Movie = Movie { rating :: Rating } {- Values between 0 (default) and 5 -}

create () = Movie (Rating 0)

get (Movie (Rating ( value ))) = value
set movie value =
  let value' =
        case value > 5 of
          True -> 5
          False -> value
      value'' =
          case value' < 0 of
            True -> 0
            False -> value'
  in
    movie { rating = Rating value'' }
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#!/usr/bin/env runhaskell

module Main (main) where

import Movie(Movie, create, get, set)

main =
  let movie  = create ()
      {- Computer says no:
      
         Program.hs:9:24: ‘rating’ is not a (visible) constructor field name
         Program.hs:9:33: Not in scope: data constructor ‘Rating’
      
      movie' = movie { rating = Rating 1024 } -}
      movie' = set movie 1024
  in
    print ("Movie rating equals 5: " ++ show ((get movie') == 5))

Haskell Code output:

mon@razerRamon:~/tmp/encapsulation/hs$ ./Program.hs 
"Movie rating equals 5: True"

References:

Inline functions with member constraints Code Snippet

1
2
3
4
5
6
let inline fmap  f (x: ^t) =
  (^t : (static member fmap  : unit -> ((^a -> ^b) -> ^t -> ^c)) ()) f x
let inline liftA f (x: ^t) =
  (^t : (static member liftA : unit ->  (^a -> ^t  -> ^b)) ()) f x
let inline liftM (x: ^t) f =
  (^t : (static member liftM : unit ->  (^t -> ^a  -> ^b)) ()) x f

Inline functions with member constraints Code output:

> val inline fmap :
  f:( ^a ->  ^b) -> x: ^t ->  ^c
    when  ^t : (static member fmap : -> ( ^a ->  ^b) ->  ^t ->  ^c)
> val inline liftA :
  f: ^a -> x: ^t ->  ^b
    when  ^t : (static member liftA : ->  ^a ->  ^t ->  ^b)
> val inline liftM :
  x: ^t -> f: ^a ->  ^b
    when  ^t : (static member liftM : ->  ^t ->  ^a ->  ^b)

Inline operators with member constraints Code Snippet

1
2
3
let inline (<@>) f  m = fmap  f  m (* Sadly, <$> can't be used *)
let inline (<*>) fm m = liftA fm m
let inline (>>=) m  f = liftM m  f

Inline operators with member constraints Code output:

> val inline ( <@> ) :
  f:( ^a ->  ^b) -> m: ^c ->  ^d
    when  ^c : (static member fmap : -> ( ^a ->  ^b) ->  ^c ->  ^d)
> val inline ( <*> ) :
  fm: ^a -> m: ^b ->  ^c
    when  ^b : (static member liftA : ->  ^a ->  ^b ->  ^c)
> val inline ( >>= ) :
  m: ^a -> f: ^b ->  ^c
    when  ^a : (static member liftM : ->  ^a ->  ^b ->  ^c)

Maybe (Option) with fmap, liftA and liftM Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
type 'a Maybe = Just of 'a | Nothing

(* Functor *)
type 'a Maybe with
  static member fmap  () : ('a -> 'b) -> 'a Maybe -> 'b Maybe =
    fun f -> function | Just x -> f x |> Just | Nothing -> Nothing

(* Applicative *)
type 'a Maybe with
  static member liftA () : ('a -> 'b) Maybe -> 'a Maybe -> 'b Maybe =
    fun fm ->
      fun m ->
        match fm,m with
          | Just f, Just x -> f x |> Just
          | ______________ -> Nothing

(* Monad *)
type 'a Maybe with
  static member liftM () : 'a Maybe -> ('a -> 'b Maybe) -> 'b Maybe =
    fun m ->
      fun f ->
        match m with
          | Nothing -> Nothing
          | Just x  -> f x
		  
(* Maybe with functions, the amount of parenthesis is to damn high *)
fmap  ((+) 1)        (Just 42);;
liftA (Just ((+) 1)) (Just 42);;
liftM (Just 42)      (fun x -> x + 1 |> Just);;

(* Maybe with operators, fewer parenthesis *)
(     (+) 1) <@> Just 42;;
Just ((+) 1) <*> Just 42;;
Just 42      >>= fun x -> x + 1 |> Just;;

Maybe (Option) with fmap, liftA and liftM Code output:

>
type 'a Maybe =
  | Just of 'a
  | Nothing
  with
    static member fmap : unit -> (('a -> 'b) -> 'a Maybe -> 'b Maybe)
    static member liftA : unit -> (('a -> 'b) Maybe -> 'a Maybe -> 'b Maybe)
    static member liftM : unit -> ('a Maybe -> ('a -> 'b Maybe) -> 'b Maybe)
  end
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43
> val it : int Maybe = Just 43

Vect (list) with fmap, liftA and liftM Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
(* A list in F# is just a type abbreviation of a FSharpList *)
typedefof<List<_>> = typedefof<_ list>

(* Functor *)
type 'a List with
  static member fmap  () : ('a -> 'b) -> 'a list -> 'b list = List.map

(* This works *)
List.fmap () ((+) 1) [ 0 .. 10 ]

(* but this doesn't *)
// fmap ((+) 1) <@> [ 42 ]
(* error FS0001: The type ''a list' does not support the operator 'fmap' *)

(* Therefore, lets create our own type wrapping native lists in a Vector *)
type 'a Vect = Vect of 'a list

(* Functor *)
type 'a Vect with
  static member fmap  () : ('a -> 'b) -> 'a Vect -> 'b Vect =
    fun f ->
      fun (Vect xs) ->
        List.map f xs |> Vect

(* Applicative *)
type 'a Vect with
  static member liftA () : ('a -> 'b) Vect -> 'a Vect -> 'b Vect =
    fun (Vect fs) ->
      fun (Vect xs) ->
        fs
        |> List.map (fun f -> xs |> List.map f)
        |> List.concat |> Vect

(* Monad *)
type 'a Vect with
  static member liftM () : 'a Vect -> ('a list -> 'b Vect) -> 'b Vect =
    fun (Vect xs) ->
      fun f ->
        f xs
		
(* Vect with operators, fewer parenthesis *)
(           (+) 1)   <@> Vect [ 0 .. 5 ];;
Vect [ id; ((+) 1) ] <*> Vect [ 0 .. 5 ];;
Vect [ 0   ..   5  ] >>= fun xs -> xs |> List.map ((+) 1) |> Vect;;

Vect (list) with fmap, liftA and liftM Code output:

> 
type List<'T> with
  static member fmap : unit -> (('T -> 'b) -> 'T list -> 'b list)
type 'a Vect =
  | Vect of 'a list
  with
    static member fmap : unit -> (('a -> 'b) -> 'a Vect -> 'b Vect)
    static member liftA : unit -> (('a -> 'b) Vect -> 'a Vect -> 'b Vect)
    static member liftM : unit -> ('a Vect -> ('a list -> 'b Vect) -> 'b Vect)
  end
> val it : int Vect = Vect [1; 2; 3; 4; 5; 6]
> val it : int Vect = Vect [0; 1; 2; 3; 4; 5; 1; 2; 3; 4; 5; 6]
> val it : int Vect = Vect [1; 2; 3; 4; 5; 6]

Result (Choice) with fmap, liftA and liftM Code Snippet

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
type ('error,'a) Result = Ok of 'a | Err of 'error

(* Functor *)
type ('c,'a) Result with
  static member fmap  () : ('a -> 'b) -> ('c,'a) Result -> ('c,'b) Result =
    fun f -> function | Ok x -> f x |> Ok | Err e -> Err e

(* Applicative *)
type ('c,'a) Result with
  static member liftA () :
    ('c,('a -> 'b)) Result -> ('c,'a) Result -> ('c,'b) Result =
    fun fm ->
      fun m ->
        match fm,m with
          | Ok  f, Ok x  -> f x |> Ok
          | Err e, _
          | _    , Err e -> Err e

(* Monad *)
type ('c,'a) Result with
  static member liftM () :
    ('c,'a) Result -> ('a -> ('c,'b) Result) -> ('c,'b) Result =
    fun m ->
      fun f ->
        match m with
          | Err e -> Err e
          | Ok  x -> f x

(* Result with operators, fewer parenthesis *)
(    ((+) 1) <@> Ok 42                  : (exn,int) Result);;
( Ok ((+) 1) <*> Ok 42                  : (exn,int) Result);;
( Ok 42      >>= (fun x -> x + 1 |> Ok) : (exn,int) Result);;

Result (Choice) with fmap, liftA and liftM Code output:

>
type ('error,'a) Result =
  | Ok of 'a
  | Err of 'error
  with
    static member
      fmap : unit -> (('a -> 'b) -> ('c,'a) Result -> ('c,'b) Result)
    static member
      liftA : unit ->
                (('c,('a -> 'b)) Result -> ('c,'a) Result -> ('c,'b) Result)
    static member
      liftM : unit ->
                (('c,'a) Result -> ('a -> ('c,'b) Result) -> ('c,'b) Result)
  end
> val it : (exn,int) Result = Ok 43
> val it : (exn,int) Result = Ok 43
> val it : (exn,int) Result = Ok 43

Combining Maybe and Result using (»=) Code Snippet

1
2
3
4
5
6
7
8
9
10
11
let inc  x = x + 1
let incM x = inc x    |> Just
let defM x = function |  Just y -> y | Nothing -> x
let incR x = inc x    |> Ok 
let defR   = function |  Ok   x -> x | Err e -> raise e

42
|> Just >>= incM >>= incM >>= incM >>= incM
|> defM 0
|> Ok   >>= incR >>= incR >>= incR >>= incR
|> defR

Combining Maybe and Result using (»=) Code output:

> val inc : x:int -> int
> val incM : x:int -> int Maybe
> val defM : x:'a -> _arg1:'a Maybe -> 'a
> val incR : x:int -> ('a,int) Result
> val defR : _arg1:(#System.Exception,'b) Result -> 'b
> val it : int = 50

References: