module Path(showPath, subPath, absPath, path, turn, here,
            Path(..), Direction(..)) where
import Direction
import Utils(lhead)

type Path = [Direction]

here :: Path
here :: [Direction]
here = []

turn :: Direction -> Path -> Path
turn :: Direction -> [Direction] -> [Direction]
turn Direction
dir [Direction]
p = Direction
dir forall a. a -> [a] -> [a]
: [Direction]
p

path :: Path -> (Direction, Path)
path :: [Direction] -> (Direction, [Direction])
path (Direction
dir : [Direction]
p) = (Direction
dir, [Direction]
p)
path [] = forall a. HasCallStack => [Char] -> a
error [Char]
"path.m: path []"

absPath :: Path -> Path -> Path
absPath :: [Direction] -> [Direction] -> [Direction]
absPath [Direction]
absp [Direction]
relp = [Direction]
absp forall a. [a] -> [a] -> [a]
++ [Direction]
relp

subPath :: Path -> Path -> Bool
subPath :: [Direction] -> [Direction] -> Bool
subPath [Direction]
subp [Direction]
p = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Direction]
subp forall a. Ord a => a -> a -> Bool
<= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Direction]
p Bool -> Bool -> Bool
&& forall {a1} {a2}. [a1] -> [a2] -> [a2]
lhead [Direction]
subp [Direction]
p forall a. Eq a => a -> a -> Bool
== [Direction]
subp

showPath :: Path -> String
showPath :: [Direction] -> [Char]
showPath =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Direction
x ->
               case Direction
x of
                 Direction
L -> [Char]
"L"
                 Direction
R -> [Char]
"R"
                 Dno Int
n -> [Char]
"N(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
")")