{-
  Travel within trees and grids and have a unique random number
  generator at each location.

  Copyright 2019 Ken Takusagawa

  This program is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program.  If not, see
  <http://www.gnu.org/licenses/>.

-}

{-# LANGUAGE ScopedTypeVariables, LambdaCase, PackageImports #-}
module Main where {
import Data.Function((&));
import Control.Category((>>>));
import Prelude hiding((.),(>>));
import qualified Data.List as List;

import Data.Word(Word64);
import qualified System.Random.TF;
import qualified Data.ByteString as Strict;
import qualified Data.Text;
import qualified Data.Text.Encoding;
import qualified Data.Text.ICU;
import qualified "cryptohash-sha256" Crypto.Hash.SHA256;
-- we use the cereal package instead of the binary package to avoid lazy bytestrings
import qualified Data.Serialize;

main :: IO();
main = do {
 print test;
 print $ (test & togen);
};

type Ii = Integer;

data Location = Gridcoordinates Coordinates
              | Binarytree (Treepath Bool) | Integertree (Treepath Ii) | Chartree (Treepath Char) deriving (Show);

type Manyworlds = [Location];
type Coordinates = [Ii]; -- arbitrary number of dimensions
newtype Dimensions = Dimensions Integer deriving (Show);

-- path within a tree from local root
type Treepath a = [a];

start :: Manyworlds;
start= [];

-- boilerplate

down :: a -> Treepath a -> Treepath a;
down = (:);

atroot :: Treepath a -> Bool;
atroot = null;

origin :: Dimensions -> Coordinates;
origin (Dimensions d) = List.genericReplicate d 0;

atorigin :: Coordinates -> Bool;
atorigin = all (== 0);

move :: Coordinates -> Coordinates -> Coordinates;
move [] [] = [];
-- do we want seq here?
move (x:xrest) (y:yrest) = (x+y):move xrest yrest;
move _ _ = error "delta and coordinates are different dimensions";

pushgridworld :: [Ii] -> Manyworlds -> Manyworlds;
pushgridworld c l = Gridcoordinates c:l;

newgridworld :: Dimensions -> ([Ii] -> [Ii]) -> Manyworlds -> Manyworlds;
-- last argument (Manyworlds) is curried
newgridworld dimensions movement = origin dimensions & movement & pushgridworld;

pushbinaryworld :: Treepath Bool -> Manyworlds -> Manyworlds;
pushbinaryworld x l = Binarytree x:l;

newbinaryworld :: (Treepath Bool -> Treepath Bool) -> Manyworlds -> Manyworlds;
newbinaryworld movement = root & movement & pushbinaryworld;

pushcharworld :: Treepath Char -> Manyworlds -> Manyworlds;
pushcharworld x l = Chartree x:l;

pushintegerworld :: Treepath Integer -> Manyworlds -> Manyworlds;
pushintegerworld x l = Integertree x:l;

newcharworld :: (Treepath Char -> Treepath Char) -> Manyworlds -> Manyworlds;
newcharworld movement = root & movement & pushcharworld;

newintegerworld :: (Treepath Integer -> Treepath Integer) -> Manyworlds -> Manyworlds;
newintegerworld movement = root & movement & pushintegerworld;

root :: Treepath a;
root = [];

-- use a zipper?
upsafely :: Treepath a -> Treepath a;
upsafely [] = [];
upsafely (_:rest) = rest;

manydown :: [a] -> Treepath a -> Treepath a;
manydown x l = List.foldl' (flip down) l x;

test :: Manyworlds;
test = start
       & newgridworld (Dimensions 2) (move [10,20] >>> move [1,2])
       & newbinaryworld (down True >>> down True >>> upsafely >>> down False)
       & newintegerworld (upsafely >>> down 10 >>> down 20 >>> down 30)
       & newcharworld (down 'a' >>> down 'b' >>> down 'c')
       & newcharworld (manydown "abc")
       & newcharworld (manydown "abc" >>> manydown "xy")
       ;

tobytestring :: String -> Strict.ByteString;
tobytestring = Data.Text.pack >>> Data.Text.ICU.normalize Data.Text.ICU.NFC >>> Data.Text.Encoding.encodeUtf8;

togen :: Manyworlds -> System.Random.TF.TFGen;
-- "show" might not be the best way to serialize, as it is sensitive to code changes
togen = show >>> tobytestring
>>> Crypto.Hash.SHA256.hash
>>> cereal >>> System.Random.TF.seedTFGen;

-- "decode" works because there are built-in decoders for Word64 and
-- (a,b,c,d).  Neither have metadata.
cereal :: Strict.ByteString -> (Word64, Word64, Word64, Word64);
cereal = Data.Serialize.decode >>> fromRight;

-- custom fromRight to take advantage of the error string provided by decode.
fromRight :: Either String a -> a;
fromRight (Left s) = error s;
fromRight (Right x) = x;

} --end