Introduce ListToken and start using it for concat instead of append
This commit is contained in:
		@@ -104,6 +104,9 @@ class TokenableTo t s | s -> t where
 | 
			
		||||
instance TokenableTo a (Token a) where
 | 
			
		||||
  toToken = pure
 | 
			
		||||
 | 
			
		||||
instance TokenableTo [a] [Token a] where
 | 
			
		||||
  toToken = pure . ListToken
 | 
			
		||||
 | 
			
		||||
instance TokenableTo a (DepGenM' a) where
 | 
			
		||||
  toToken = id
 | 
			
		||||
 | 
			
		||||
@@ -164,14 +167,14 @@ unzipFstDepGenM t = do
 | 
			
		||||
  t' <- toToken t
 | 
			
		||||
  case t' of
 | 
			
		||||
    ZipToken a _ -> pure a
 | 
			
		||||
    Token _ -> genDependency (makeDependency t' UnzipFst)
 | 
			
		||||
    _ -> genDependency (makeDependency t' UnzipFst)
 | 
			
		||||
 | 
			
		||||
unzipSndDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [b])
 | 
			
		||||
unzipSndDepGenM t = do
 | 
			
		||||
  t' <- toToken t
 | 
			
		||||
  case t' of
 | 
			
		||||
    ZipToken _ b -> pure b
 | 
			
		||||
    Token _ -> genDependency (makeDependency t' UnzipSnd)
 | 
			
		||||
    _ -> genDependency (makeDependency t' UnzipSnd)
 | 
			
		||||
 | 
			
		||||
unzipDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a], Token [b])
 | 
			
		||||
unzipDepGenM t = do
 | 
			
		||||
 
 | 
			
		||||
@@ -50,6 +50,9 @@ getTokenValue = \case
 | 
			
		||||
        pure $ List $ zipWith (curry Tuple) as bs
 | 
			
		||||
      _ ->
 | 
			
		||||
        error "unexpected"
 | 
			
		||||
  UListToken ts -> do
 | 
			
		||||
    vs <- mapM getTokenValue ts
 | 
			
		||||
    pure $ List vs
 | 
			
		||||
  UNoToken ->
 | 
			
		||||
    pure Empty
 | 
			
		||||
 | 
			
		||||
 
 | 
			
		||||
@@ -11,8 +11,8 @@ import Data.Text (Text)
 | 
			
		||||
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
 | 
			
		||||
thumbnailImageFilename filename = do
 | 
			
		||||
  (base, ext) <- untupleDepGenM $ fileComponents filename
 | 
			
		||||
  appendStrings base
 | 
			
		||||
    $ appendStrings (inject "-thumbnail.") ext
 | 
			
		||||
  suffix <- inject "-thumbnail."
 | 
			
		||||
  concatStrings [ base, suffix, ext ]
 | 
			
		||||
 | 
			
		||||
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' Text
 | 
			
		||||
makeImageHTML t = do
 | 
			
		||||
 
 | 
			
		||||
@@ -32,6 +32,7 @@ data Action = Function Function
 | 
			
		||||
data UToken = UToken Int
 | 
			
		||||
            | UTupleToken UToken UToken
 | 
			
		||||
            | UZipToken UToken UToken
 | 
			
		||||
            | UListToken [UToken]
 | 
			
		||||
            | UNoToken
 | 
			
		||||
  deriving (Show, Lift)
 | 
			
		||||
 | 
			
		||||
@@ -46,6 +47,7 @@ makeUToken = \case
 | 
			
		||||
  Token i -> UToken i
 | 
			
		||||
  TupleToken a b -> UTupleToken (makeUToken a) (makeUToken b)
 | 
			
		||||
  ZipToken a b -> UZipToken (makeUToken a) (makeUToken b)
 | 
			
		||||
  ListToken ts -> UListToken (map makeUToken ts)
 | 
			
		||||
  NoToken -> UNoToken
 | 
			
		||||
 | 
			
		||||
formatDependencyTrees :: [Dependency] -> Text
 | 
			
		||||
@@ -78,6 +80,11 @@ formatDependencyTrees = T.concat . (formatDependencyTrees' "")
 | 
			
		||||
                   , formatUToken b
 | 
			
		||||
                   , [ ")" ]
 | 
			
		||||
                   ]
 | 
			
		||||
          UListToken ts ->
 | 
			
		||||
            [ "["
 | 
			
		||||
            , T.intercalate ", " (map (T.concat . formatUToken) ts)
 | 
			
		||||
            , "]"
 | 
			
		||||
            ]
 | 
			
		||||
          UNoToken ->
 | 
			
		||||
            [ "--" ]
 | 
			
		||||
 | 
			
		||||
 
 | 
			
		||||
@@ -9,6 +9,7 @@ data Token a where
 | 
			
		||||
  Token :: Int -> Token a
 | 
			
		||||
  TupleToken :: Token a -> Token b -> Token (a, b)
 | 
			
		||||
  ZipToken :: Token [a] -> Token [b] -> Token [(a, b)]
 | 
			
		||||
  ListToken :: [Token a] -> Token [a]
 | 
			
		||||
  NoToken :: Token ()
 | 
			
		||||
 | 
			
		||||
deriving instance Show (Token a)
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user