{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

module Test.Sandwich.Interpreters.RunTree.Util where

import Control.Concurrent.STM
import Control.Monad.Free
import Control.Monad.Logger
import qualified Data.List as L
import Data.Sequence as Seq hiding ((:>))
import Data.String.Interpolate
import Data.Time.Clock
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
import Text.Printf


-- | Wait for a tree, catching any synchronous exceptions and returning them as a list
waitForTree :: RunNode context -> IO Result
waitForTree :: RunNode context -> IO Result
waitForTree RunNode context
node = STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$
  TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar (RunNodeCommonWithStatus
  (TVar Status) (Var (Seq LogEntry)) (Var Bool)
-> TVar Status
forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus (RunNodeCommonWithStatus
   (TVar Status) (Var (Seq LogEntry)) (Var Bool)
 -> TVar Status)
-> RunNodeCommonWithStatus
     (TVar Status) (Var (Seq LogEntry)) (Var Bool)
-> TVar Status
forall a b. (a -> b) -> a -> b
$ RunNode context
-> RunNodeCommonWithStatus
     (TVar Status) (Var (Seq LogEntry)) (Var Bool)
forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNode context
node) STM Status -> (Status -> STM Result) -> STM Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Done {Result
statusResult :: Status -> Result
statusResult :: Result
statusResult} -> Result -> STM Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
statusResult
    NotStarted {} -> STM Result
forall a. STM a
retry
    Running {} -> STM Result
forall a. STM a
retry

-- | Append a log message outside of ExampleT. Only stored to in-memory logs, not disk.
-- Only for debugging the interpreter, should not be exposed.
appendLogMessage :: ToLogStr msg => TVar (Seq LogEntry) -> msg -> IO ()
appendLogMessage :: Var (Seq LogEntry) -> msg -> IO ()
appendLogMessage Var (Seq LogEntry)
logs msg
msg = do
  UTCTime
ts <- IO UTCTime
getCurrentTime
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Var (Seq LogEntry) -> (Seq LogEntry -> Seq LogEntry) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Var (Seq LogEntry)
logs (Seq LogEntry -> LogEntry -> Seq LogEntry
forall a. Seq a -> a -> Seq a
|> UTCTime -> Loc -> LogSource -> LogLevel -> LogStr -> LogEntry
LogEntry UTCTime
ts (String -> String -> String -> CharPos -> CharPos -> Loc
Loc String
"" String
"" String
"" (Int
0, Int
0) (Int
0, Int
0)) LogSource
"manual" LogLevel
LevelDebug (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg))

getImmediateChildren :: Free (SpecCommand context m) () -> [Free (SpecCommand context m) ()]
getImmediateChildren :: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren (Free (It'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
ex Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> next
-> SpecCommand context m next
It'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
ex (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (Before'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
f Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> SpecFree context m ()
-> next
-> SpecCommand context m next
Before'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
f Free (SpecCommand context m) ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (After'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
f Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> ExampleT context m ()
-> SpecFree context m ()
-> next
-> SpecCommand context m next
After'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m ()
f Free (SpecCommand context m) ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (Introduce'' Maybe SrcLoc
loc NodeOptions
no String
l Label l intro
cl ExampleT context m intro
alloc intro -> ExampleT context m ()
cleanup SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall intro (l :: Symbol) context (m :: * -> *) next.
Typeable intro =>
Maybe SrcLoc
-> NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> next
-> SpecCommand context m next
Introduce'' Maybe SrcLoc
loc NodeOptions
no String
l Label l intro
cl ExampleT context m intro
alloc intro -> ExampleT context m ()
cleanup SpecFree (LabelValue l intro :> context) m ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (IntroduceWith'' Maybe SrcLoc
loc NodeOptions
no String
l Label l intro
cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
action SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> Label l intro
-> ((intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall (l :: Symbol) intro context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> Label l intro
-> ((intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> next
-> SpecCommand context m next
IntroduceWith'' Maybe SrcLoc
loc NodeOptions
no String
l Label l intro
cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
action SpecFree (LabelValue l intro :> context) m ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (Around'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m [Result] -> ExampleT context m ()
f Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> (ExampleT context m [Result] -> ExampleT context m ())
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> (ExampleT context m [Result] -> ExampleT context m ())
-> SpecFree context m ()
-> next
-> SpecCommand context m next
Around'' Maybe SrcLoc
loc NodeOptions
no String
l ExampleT context m [Result] -> ExampleT context m ()
f Free (SpecCommand context m) ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (Describe'' Maybe SrcLoc
loc NodeOptions
no String
l Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> String
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> String
-> SpecFree context m ()
-> next
-> SpecCommand context m next
Describe'' Maybe SrcLoc
loc NodeOptions
no String
l Free (SpecCommand context m) ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Free (Parallel'' Maybe SrcLoc
loc NodeOptions
no Free (SpecCommand context m) ()
subspec Free (SpecCommand context m) ()
next)) = (SpecCommand context m (Free (SpecCommand context m) ())
-> Free (SpecCommand context m) ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Maybe SrcLoc
-> NodeOptions
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
-> SpecCommand context m (Free (SpecCommand context m) ())
forall context (m :: * -> *) next.
Maybe SrcLoc
-> NodeOptions
-> SpecFree context m ()
-> next
-> SpecCommand context m next
Parallel'' Maybe SrcLoc
loc NodeOptions
no Free (SpecCommand context m) ()
subspec (() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()))) Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
-> [Free (SpecCommand context m) ()]
forall a. a -> [a] -> [a]
: Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren Free (SpecCommand context m) ()
next
getImmediateChildren (Pure ()) = [() -> Free (SpecCommand context m) ()
forall (f :: * -> *) a. a -> Free f a
Pure ()]

countChildren :: Free (SpecCommand context m) () -> Int
countChildren :: Free (SpecCommand context m) () -> Int
countChildren = [Free (SpecCommand context m) ()] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ([Free (SpecCommand context m) ()] -> Int)
-> (Free (SpecCommand context m) ()
    -> [Free (SpecCommand context m) ()])
-> Free (SpecCommand context m) ()
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
forall context (m :: * -> *).
Free (SpecCommand context m) ()
-> [Free (SpecCommand context m) ()]
getImmediateChildren

countImmediateFolderChildren :: Free (SpecCommand context m) a -> Int
countImmediateFolderChildren :: Free (SpecCommand context m) a -> Int
countImmediateFolderChildren (Free (It'' Maybe SrcLoc
_loc NodeOptions
no String
_l ExampleT context m ()
_ex Free (SpecCommand context m) a
next))
  | NodeOptions -> Bool
nodeOptionsCreateFolder NodeOptions
no = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context m) a
next
  | Bool
otherwise = Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context m) a
next
countImmediateFolderChildren (Free (Introduce'' Maybe SrcLoc
_loc NodeOptions
no String
_l Label l intro
_cl ExampleT context m intro
_alloc intro -> ExampleT context m ()
_cleanup SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) a
next))
  | NodeOptions -> Bool
nodeOptionsCreateFolder NodeOptions
no = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context m) a
next
  | Bool
otherwise = SpecFree (LabelValue l intro :> context) m () -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren SpecFree (LabelValue l intro :> context) m ()
subspec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context m) a
next
countImmediateFolderChildren (Free (IntroduceWith'' Maybe SrcLoc
_loc NodeOptions
no String
_l Label l intro
_cl (intro -> ExampleT context m [Result]) -> ExampleT context m ()
_action SpecFree (LabelValue l intro :> context) m ()
subspec Free (SpecCommand context m) a
next))
  | NodeOptions -> Bool
nodeOptionsCreateFolder NodeOptions
no = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context m) a
next
  | Bool
otherwise = SpecFree (LabelValue l intro :> context) m () -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren SpecFree (LabelValue l intro :> context) m ()
subspec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren Free (SpecCommand context m) a
next
countImmediateFolderChildren (Free SpecCommand context m (Free (SpecCommand context m) a)
node)
  | NodeOptions -> Bool
nodeOptionsCreateFolder (SpecCommand context m (Free (SpecCommand context m) a)
-> NodeOptions
forall context (m :: * -> *) next.
SpecCommand context m next -> NodeOptions
nodeOptions SpecCommand context m (Free (SpecCommand context m) a)
node) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren (SpecCommand context m (Free (SpecCommand context m) a)
-> Free (SpecCommand context m) a
forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) a)
node)
  | Bool
otherwise = Free (SpecCommand context m) () -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren (SpecCommand context m (Free (SpecCommand context m) a)
-> Free (SpecCommand context m) ()
forall context (m :: * -> *) next.
SpecCommand context m next -> SpecFree context m ()
subspec SpecCommand context m (Free (SpecCommand context m) a)
node) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Free (SpecCommand context m) a -> Int
forall context (m :: * -> *) a.
Free (SpecCommand context m) a -> Int
countImmediateFolderChildren (SpecCommand context m (Free (SpecCommand context m) a)
-> Free (SpecCommand context m) a
forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) a)
node)
countImmediateFolderChildren (Pure a
_) = Int
0

maxFileNameLength :: Int
maxFileNameLength :: Int
maxFileNameLength = Int
150

nodeToFolderName :: String -> Int -> Int -> String
nodeToFolderName :: String -> Int -> Int -> String
nodeToFolderName String
name Int
1 Int
0 = Int -> String -> String
truncateFileNameToLength Int
maxFileNameLength (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
fixupName String
name
nodeToFolderName String
name Int
numSiblings Int
indexInParent = String
padding String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
truncateFileNameToLength (Int
maxFileNameLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
padding)) (String -> String
fixupName String
name)
  where
    paddingNeeded :: Int
paddingNeeded
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int
1
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 = Int
2
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000 = Int
3
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10000 = Int
4
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100000 = Int
5
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000 = Int
6
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10000000 = Int
7
      | Int
numSiblings Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100000000 = Int
8
      | Bool
otherwise = Int
15

    paddedNumber :: String
paddedNumber = String -> Int -> String
forall r. PrintfType r => String -> r
printf [i|%0#{paddingNeeded :: Int}d|] Int
indexInParent

    padding :: String
padding = if | Int
numSiblings Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> String
""
                 | Bool
otherwise -> String
paddedNumber String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_"

fixupName :: String -> String
fixupName = Char -> Char -> String -> String
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
'/' Char
'_'

replace :: Eq a => a -> a -> [a] -> [a]
replace :: a -> a -> [a] -> [a]
replace a
a a
b = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a) -> [a] -> [a]) -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ \a
c -> if a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a then a
b else a
c

truncateFileNameToLength :: Int -> String -> String
truncateFileNameToLength :: Int -> String -> String
truncateFileNameToLength Int
len String
x | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len = String
x
truncateFileNameToLength Int
len String
x = String
"..." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> String -> String
forall a. Int -> [a] -> [a]
takeEnd (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) String
x)

takeEnd :: Int -> [a] -> [a]
takeEnd :: Int -> [a] -> [a]
takeEnd Int
j [a]
xs = [a] -> [a] -> [a]
forall a a. [a] -> [a] -> [a]
f [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop Int
j [a]
xs)
  where f :: [a] -> [a] -> [a]
f (a
_:[a]
zs) (a
_:[a]
ys) = [a] -> [a] -> [a]
f [a]
zs [a]
ys
        f [a]
zs [a]
_ = [a]
zs