seperate haskell und purescript directories

This commit is contained in:
weiss
2020-04-19 05:51:24 +02:00
parent 7dfe85a5fd
commit 49481147ff
67 changed files with 5 additions and 0 deletions

3
haskell/vindinium/.gitignore vendored Normal file
View File

@@ -0,0 +1,3 @@
.stack-work/
*~
/Bundled.hs

View File

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

30
haskell/vindinium/LICENSE Normal file
View File

@@ -0,0 +1,30 @@
Copyright Author name here (c) 2020
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.

View File

@@ -0,0 +1 @@
# stackproject

View File

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

View File

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

View File

@@ -0,0 +1,4 @@
{
"email": "arne.weiss@udo.edu",
"password": "53gGVlg@EpNl"
}

View File

@@ -0,0 +1,57 @@
name: stackproject
version: 0.1.0.0
github: "githubuser/stackproject"
license: BSD3
author: "Author name here"
maintainer: "example@example.com"
copyright: "2020 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/stackproject#readme>
dependencies:
- base >= 4.7 && < 5
- aeson
- attoparsec
- bytestring
- codingame-hs
- directory
- filepath
- random
- containers >=0.5 && <0.7
- haskell-src-exts
library:
source-dirs: src
executables:
stackproject-exe:
main: Main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- stackproject
tests:
stackproject-test:
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- stackproject

View File

@@ -0,0 +1,30 @@
module BotRunner
( Bot
, escapedInputInErrorPrefix
, runBot
) where
import Control.Monad
import System.IO
-- A Codingame bot where input and output have been abstracted out.
type Bot = IO String -> (String -> IO ()) -> IO ()
escapedInputInErrorPrefix :: String
escapedInputInErrorPrefix = "#"
-- Run a bot in the Codingame Arena (or IDE).
runBot
:: Bool -- Shall the bots input be echoed on stderr to be able to replay any game result?
-> Bot -- The bot.
-> IO ()
runBot echoInput bot = do
hSetBuffering stdout NoBuffering
bot readLine writeLine
where
readLine = do
line <- getLine
when echoInput $
hPutStrLn stderr (escapedInputInErrorPrefix ++ line)
return line
writeLine = putStrLn

View File

@@ -0,0 +1,36 @@
module Codingame
( bundle
) where
import Codingame.WebServices
import Codingame.SourcePackager
import Language.Haskell.Exts
import BotRunner
import Player
import Debug
sourcePath = "src/Player.hs"
parseMode :: ParseMode
parseMode = ParseMode {
parseFilename = "<unknown>.hs",
baseLanguage = Haskell2010,
extensions = [EnableExtension ScopedTypeVariables, EnableExtension LambdaCase, EnableExtension MultiWayIf],
ignoreLanguagePragmas = False,
ignoreLinePragmas = True,
fixities = Just preludeFixities,
ignoreFunctionArity = False
}
bundle :: IO ()
bundle = do
source <- createMonolithicSourceWithMode parseMode sourcePath
credentials <- readCredentials "credentials.json"
putStrLn source
let file = "Bundled.hs"
writeFile file $ "{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}\n" ++ source

View File

@@ -0,0 +1,21 @@
module Debug
( trace
, _trace
, traceList
,_traceList
) where
import Data.List
import qualified Debug.Trace as Trace
trace :: Show a => String -> a -> a
trace message x = Trace.trace (message ++ " = " ++ show x) x
_trace :: String -> a -> a
_trace _ = id
traceList :: Show a => String -> [a] -> [a]
traceList message xs = Trace.trace (message ++ " = [\n\t" ++ intercalate "\n\t" (map show xs) ++ "\n]") xs
_traceList :: Show a => String -> [a] -> [a]
_traceList _ = id

View File

@@ -0,0 +1,99 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Graph where
import Prelude
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe
import qualified Data.Sequence as Seq
newtype Graph v = Graph (M.Map v (Seq.Seq v))
empty :: forall v. Graph v
empty = Graph M.empty
addNode :: forall v. Ord v => Graph v -> v -> Graph v
addNode (Graph m) v = Graph $ M.insert v Seq.empty m
-- adds an Edge from Node "from" to Node "to"
-- returns the graph unmodified if "to" does not exist
addEdge :: forall v. Ord v => Graph v -> v -> v -> Graph v
addEdge g@(Graph m) from to = Graph $ M.update updateVal from m
where
updateVal :: Seq.Seq v -> Maybe (Seq.Seq v)
updateVal nodes
| g `contains` to = Just $ to Seq.<| nodes
| otherwise = Just nodes
toMap :: forall v. Graph v -> M.Map v (Seq.Seq v)
toMap (Graph m) = m
adjacentEdges :: forall v. Ord v => Graph v -> v -> Seq.Seq v
adjacentEdges (Graph m) nodeId = fromMaybe Seq.empty $ M.lookup nodeId m
contains :: forall v. Ord v => Graph v -> v -> Bool
contains (Graph m) key = case M.lookup key m of
Just _ -> True
Nothing -> False
-- shortestPath :: forall v. Ord v => Graph v -> v -> v -> Seq v
-- shortestPath g@(Graph m) from to = reverse $ shortestPath' (from, Seq.empty) Seq.empty S.empty
-- where
-- shortestPath' :: (v, Seq v) -> [(v, Seq v)] -> S.Set v-> Seq v
-- shortestPath' from queue visited
-- | fst from == to = snd from
-- | length newQueue == 0 = Seq.empty
-- | otherwise = shortestPath' (head newQueue) newQueue (S.insert (fst from) visited)
-- where
-- adjacent :: S.Set v
-- adjacent = S.fromList $ adjacentEdges g (fst from)
-- newQueue :: [(v, Seq v)]
-- newQueue = drop 1 queue <> ( map (\x -> (x, fst from : snd from)) (S.toList $ S.difference adjacent visited) )
shortestPathList :: forall v. Ord v => Graph v -> v -> v -> Seq.Seq v
shortestPathList g@(Graph m) from to = Seq.reverse $ shortestPath' (from, Seq.empty) Seq.empty Seq.empty
where
shortestPath' :: (v, Seq.Seq v) -> Seq.Seq (v, Seq.Seq v) -> Seq.Seq v-> Seq.Seq v
shortestPath' from queue visited
| fst from == to = snd from
| otherwise = case Seq.viewl newQueue of
n Seq.:< _ -> shortestPath' n newQueue (fst from Seq.<| visited)
Seq.EmptyL -> Seq.empty
where
adjacent :: Seq.Seq v
adjacent = adjacentEdges g (fst from)
newQueue :: Seq.Seq (v, Seq.Seq v)
newQueue = Seq.drop 1 queue <> (fmap (\x -> (x, fst from Seq.<| snd from)) (adjacent `without` visited) )
without :: Eq a => Seq.Seq a -> Seq.Seq a -> Seq.Seq a
without seq1 seq2 = Seq.filter (\e -> all ((/=) e) seq2) seq1
with :: Eq a => Seq.Seq a -> Seq.Seq a -> Seq.Seq a
with seq1 seq2 = seq1 <> (seq2 `without` seq1)
-- pathExists :: forall v. Ord v => Graph v -> v -> v -> Bool
-- pathExists g@(Graph m) from to = shortestPath' from Seq.empty Seq.empty
-- where
-- shortestPath' :: v -> Seq v -> Seq v -> Bool
-- shortestPath' from queue visited
-- | from == to = True
-- | otherwise = case head $ newQueue of
-- Just n -> shortestPath' n newQueue (from : visited)
-- Nothing -> False
-- where
-- adjacent :: Seq v
-- adjacent = adjacentEdges g from
-- newQueue :: Seq v
-- newQueue = drop 1 queue <> (adjacent \\ visited)
dfs :: forall v. Ord v => Graph v -> v -> v -> Bool
dfs g@(Graph m) from to = dfs' g from to Seq.empty
dfs' :: forall v. Ord v => Graph v -> v -> v -> Seq.Seq v -> Bool
dfs' g@(Graph m) from to visited
| from == to = True
| otherwise = any ((==) True) $ subcalls (adjacent `without` visited)
where
subcalls = fmap (\f -> dfs' g f to visited')
visited' = with visited adjacent
adjacent = adjacentEdges g from

View File

@@ -0,0 +1,137 @@
{-# LANGUAGE ScopedTypeVariables, LambdaCase, MultiWayIf #-}
module Player
( runMain
) where
import System.IO
import Control.Monad
import System.Random
import Data.Char (digitToInt)
import Data.List (minimumBy)
import BotRunner
import Graph
data BoardEntity = BSpawnPoint Int | BWall | BTavern | BMine | BEmpty deriving (Show, Eq)
type Board = [[BoardEntity]]
type IndexedBoard = [(Pos, BoardEntity)]
type Pos = (Int, Int)
-- Id, Pos, life, gold
data Entity
= Hero Int Pos Int Int
| Mine Int Pos
runMain :: IO ()
runMain = runBot True bot
bot :: Bot
bot readLine writeLine = do
-- let graph = foldl addEdge' graph' $ concatMap nodeConnections nodes
-- hPrint stderr $ shortestPathList graph "[0,0]" "[6,5]"
input_line <- getLine
let size = read input_line :: Int
board' <- replicateM size getLine
let board :: Board = map (\br -> map (\se -> if
| se == '.' -> BEmpty
| se == '#' -> BWall
| se == 'T' -> BTavern
| se == 'M' -> BMine
| otherwise -> BSpawnPoint $ digitToInt se) br) board'
input_line <- getLine
let iBoard :: IndexedBoard = concatMap (\(i_r, br) -> map (\(i_c, bc) -> ((i_c, i_r), bc)) br) $ zip [0..9] $ map (zip [0..9]) board
let myId = read input_line :: Int -- ID of your hero
-- game loop
forever $ do
input_line <- getLine
let entitycount = read input_line :: Int -- the number of entities
entities <- replicateM entitycount $ do
input_line <- getLine
let input = words input_line
let entitytype = input!!0 -- HERO or MINE
let id = read (input!!1) :: Int -- the ID of a hero or the owner of a mine
let x = read (input!!2) :: Int -- the x position of the entity
let y = read (input!!3) :: Int -- the y position of the entity
let life = read (input!!4) :: Int -- the life of a hero (-1 for mines)
let gold = read (input!!5) :: Int -- the gold of a hero (-1 for mines)
pure $ if entitytype == "HERO"
then Hero id (x,y) life gold
else Mine id (x,y)
let heroes = filter (\e -> case e of
Hero _ _ _ _ -> True
_ -> False) entities
let hero = head $ filter (\e -> case e of
Hero id _ _ _ -> id == myId
_ -> False) heroes
let mines = filter (\e -> case e of
Mine oId _ -> oId /= myId
_ -> False) entities
let minMine = minimumBy (\e1 e2 -> compare (dist (posFromEntity e1) (posFromEntity hero)) (dist (posFromEntity e2) (posFromEntity hero))) mines
let minTavernPos = minimumBy (\p1 p2 -> compare (dist p1 (posFromEntity hero)) (dist p2 (posFromEntity hero))) $ map (\(p, be) -> p) $ filter (\(p, be) -> isTavern be) iBoard
-- hPrint stderr minMine
-- WAIT | NORTH | EAST | SOUTH | WEST
r <- randomRIO (0,3) :: IO Int
let dir = if r == 0
then "NORTH"
else if r == 1
then "EAST"
else if r == 2
then "SOUTH"
else
"WEST"
putStrLn $ case life hero of
Just lp -> if lp < 30 then moveToPos minTavernPos else moveToEntity minMine
Nothing -> moveToEntity minMine
moveToEntity :: Entity -> String
moveToEntity e = case e of
Hero _ p _ _ -> cout p
Mine _ p -> cout p
where cout (x,y) = "MOVE " <> (show x) <> " " <> (show y)
moveToPos :: (Int, Int) -> String
moveToPos (x, y) = "MOVE " <> (show x) <> " " <> (show y)
dist :: Pos -> Pos -> Int
dist (x1, y1) (x2, y2) = abs (x2 - x1) + abs (y2 - y1)
life :: Entity -> Maybe Int
life (Hero _ _ l _) = Just l
life _ = Nothing
posFromEntity :: Entity -> (Int, Int)
posFromEntity (Hero _ p _ _) = p
posFromEntity (Mine _ p) = p
isTavern :: BoardEntity -> Bool
isTavern BTavern = True
isTavern _ = False
addEdge' :: Ord v => Graph v -> [v] -> Graph v
addEdge' g v = addEdge'' g v
where
addEdge'' :: Ord v => Graph v -> [v] -> Graph v
addEdge'' g [a,b] = addEdge g a b
graph' = foldl addNode empty sNodes
sNodes :: [String]
sNodes = map (\n -> show n) nodes
nodes = do
x <- [0..9]
y <- [0..9]
return [x, y]
nodeConnections :: [Int] -> [[String]]
nodeConnections [x, y] = [ [o, show [x-1,y]], [o, show [x+1,y]], [o, show [x,y-1]], [o, show [x,y+1]] ]
where o = show [x, y]
nodeConnections _ = []

View File

@@ -0,0 +1,68 @@
# 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-15.8
# 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
# subdirs:
# - auto-update
# - wai
packages:
- .
- ../codingame-hs
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
extra-deps:
- 'hpp-0.6.2'
# 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: ">=2.1"
#
# 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

View File

@@ -0,0 +1,19 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
hackage: hpp-0.6.2@sha256:aa75b0471c0a8f68ccf823da37ea88b4187829972dc951651805a3722293a001,1969
pantry-tree:
size: 1357
sha256: c85fba4149618ab38a1eb2d369d46d78a58a2729cfcf9be93ff36936e6b9ffe5
original:
hackage: hpp-0.6.2
snapshots:
- completed:
size: 492015
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/8.yaml
sha256: 926bc3d70249dd0ba05277ff00943c0addb35b627cb641752669e7cf771310d0
original: lts-15.8

View File

@@ -0,0 +1,93 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.31.2.
--
-- see: https://github.com/sol/hpack
--
-- hash: 830ab1dfe911ba97d355d8cb635f3c8cb20a911f05b8cbcb68139e102b99cfd5
name: stackproject
version: 0.1.0.0
description: Please see the README on GitHub at <https://github.com/githubuser/stackproject#readme>
homepage: https://github.com/githubuser/stackproject#readme
bug-reports: https://github.com/githubuser/stackproject/issues
author: Author name here
maintainer: example@example.com
copyright: 2020 Author name here
license: BSD3
license-file: LICENSE
build-type: Simple
extra-source-files:
README.md
ChangeLog.md
source-repository head
type: git
location: https://github.com/githubuser/stackproject
library
exposed-modules:
BotRunner
Codingame
Debug
Graph
Player
other-modules:
Paths_stackproject
hs-source-dirs:
src
build-depends:
aeson
, attoparsec
, base >=4.7 && <5
, bytestring
, codingame-hs
, containers >=0.5 && <0.7
, directory
, filepath
, haskell-src-exts
, random
default-language: Haskell2010
executable stackproject-exe
main-is: Main.hs
other-modules:
Paths_stackproject
hs-source-dirs:
app
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
aeson
, attoparsec
, base >=4.7 && <5
, bytestring
, codingame-hs
, containers >=0.5 && <0.7
, directory
, filepath
, haskell-src-exts
, random
, stackproject
default-language: Haskell2010
test-suite stackproject-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_stackproject
hs-source-dirs:
test
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends:
aeson
, attoparsec
, base >=4.7 && <5
, bytestring
, codingame-hs
, containers >=0.5 && <0.7
, directory
, filepath
, haskell-src-exts
, random
, stackproject
default-language: Haskell2010

View File

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

View File

@@ -0,0 +1,11 @@
{
"folders": [
{
"path": "."
},
{
"path": "..\\codingame-hs"
}
],
"settings": {}
}